libsim Versione 7.2.4

◆ map_distinct_level()

integer function, dimension(size(vect)) map_distinct_level ( type(vol7d_level), dimension(:), intent(in) vect,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back )

map distinct

Definizione alla linea 958 del file vol7d_level_class.F90.

959! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
960! authors:
961! Davide Cesari <dcesari@arpa.emr.it>
962! Paolo Patruno <ppatruno@arpa.emr.it>
963
964! This program is free software; you can redistribute it and/or
965! modify it under the terms of the GNU General Public License as
966! published by the Free Software Foundation; either version 2 of
967! the License, or (at your option) any later version.
968
969! This program is distributed in the hope that it will be useful,
970! but WITHOUT ANY WARRANTY; without even the implied warranty of
971! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
972! GNU General Public License for more details.
973
974! You should have received a copy of the GNU General Public License
975! along with this program. If not, see <http://www.gnu.org/licenses/>.
976#include "config.h"
977
984USE kinds
987IMPLICIT NONE
988
993TYPE vol7d_level
994 INTEGER :: level1
995 INTEGER :: l1
996 INTEGER :: level2
997 INTEGER :: l2
998END TYPE vol7d_level
999
1001TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
1002
1006INTERFACE init
1007 MODULE PROCEDURE vol7d_level_init
1008END INTERFACE
1009
1012INTERFACE delete
1013 MODULE PROCEDURE vol7d_level_delete
1014END INTERFACE
1015
1019INTERFACE OPERATOR (==)
1020 MODULE PROCEDURE vol7d_level_eq
1021END INTERFACE
1022
1026INTERFACE OPERATOR (/=)
1027 MODULE PROCEDURE vol7d_level_ne
1028END INTERFACE
1029
1035INTERFACE OPERATOR (>)
1036 MODULE PROCEDURE vol7d_level_gt
1037END INTERFACE
1038
1044INTERFACE OPERATOR (<)
1045 MODULE PROCEDURE vol7d_level_lt
1046END INTERFACE
1047
1053INTERFACE OPERATOR (>=)
1054 MODULE PROCEDURE vol7d_level_ge
1055END INTERFACE
1056
1062INTERFACE OPERATOR (<=)
1063 MODULE PROCEDURE vol7d_level_le
1064END INTERFACE
1065
1069INTERFACE OPERATOR (.almosteq.)
1070 MODULE PROCEDURE vol7d_level_almost_eq
1071END INTERFACE
1072
1073
1074! da documentare in inglese assieme al resto
1076INTERFACE c_e
1077 MODULE PROCEDURE vol7d_level_c_e
1078END INTERFACE
1079
1080#define VOL7D_POLY_TYPE TYPE(vol7d_level)
1081#define VOL7D_POLY_TYPES _level
1082#define ENABLE_SORT
1083#include "array_utilities_pre.F90"
1084
1086INTERFACE display
1087 MODULE PROCEDURE display_level
1088END INTERFACE
1089
1091INTERFACE to_char
1092 MODULE PROCEDURE to_char_level
1093END INTERFACE
1094
1096INTERFACE vol7d_level_to_var
1097 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1098END INTERFACE vol7d_level_to_var
1099
1102 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1103END INTERFACE vol7d_level_to_var_factor
1104
1107 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1108END INTERFACE vol7d_level_to_var_log10
1109
1110type(vol7d_level) :: almost_equal_levels(3)=(/&
1111 vol7d_level( 1,imiss,imiss,imiss),&
1112 vol7d_level(103,imiss,imiss,imiss),&
1113 vol7d_level(106,imiss,imiss,imiss)/)
1114
1115! levels requiring conversion from internal to physical representation
1116INTEGER, PARAMETER :: &
1117 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
1118 thermo_level(3) = (/20,107,235/), & ! 10**-1
1119 sigma_level(2) = (/104,111/) ! 10**-4
1120
1121TYPE level_var
1122 INTEGER :: level
1123 CHARACTER(len=10) :: btable
1124END TYPE level_var
1125
1126! Conversion table from GRIB2 vertical level codes to corresponding
1127! BUFR B table variables
1128TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
1129 level_var(20, 'B12101'), & ! isothermal (K)
1130 level_var(100, 'B10004'), & ! isobaric (Pa)
1131 level_var(102, 'B10007'), & ! height over sea level (m)
1132 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
1133 level_var(107, 'B12192'), & ! isentropical (K)
1134 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
1135 level_var(161, 'B22195') /) ! depth below sea surface
1136
1137PRIVATE level_var, level_var_converter
1138
1139CONTAINS
1140
1146FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1147INTEGER,INTENT(IN),OPTIONAL :: level1
1148INTEGER,INTENT(IN),OPTIONAL :: l1
1149INTEGER,INTENT(IN),OPTIONAL :: level2
1150INTEGER,INTENT(IN),OPTIONAL :: l2
1151
1152TYPE(vol7d_level) :: this
1153
1154CALL init(this, level1, l1, level2, l2)
1155
1156END FUNCTION vol7d_level_new
1157
1158
1162SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1163TYPE(vol7d_level),INTENT(INOUT) :: this
1164INTEGER,INTENT(IN),OPTIONAL :: level1
1165INTEGER,INTENT(IN),OPTIONAL :: l1
1166INTEGER,INTENT(IN),OPTIONAL :: level2
1167INTEGER,INTENT(IN),OPTIONAL :: l2
1168
1169this%level1 = imiss
1170this%l1 = imiss
1171this%level2 = imiss
1172this%l2 = imiss
1173
1174IF (PRESENT(level1)) THEN
1175 this%level1 = level1
1176ELSE
1177 RETURN
1178END IF
1179
1180IF (PRESENT(l1)) this%l1 = l1
1181
1182IF (PRESENT(level2)) THEN
1183 this%level2 = level2
1184ELSE
1185 RETURN
1186END IF
1187
1188IF (PRESENT(l2)) this%l2 = l2
1189
1190END SUBROUTINE vol7d_level_init
1191
1192
1194SUBROUTINE vol7d_level_delete(this)
1195TYPE(vol7d_level),INTENT(INOUT) :: this
1196
1197this%level1 = imiss
1198this%l1 = imiss
1199this%level2 = imiss
1200this%l2 = imiss
1201
1202END SUBROUTINE vol7d_level_delete
1203
1204
1205SUBROUTINE display_level(this)
1206TYPE(vol7d_level),INTENT(in) :: this
1207
1208print*,trim(to_char(this))
1209
1210END SUBROUTINE display_level
1211
1212
1213FUNCTION to_char_level(this)
1214#ifdef HAVE_DBALLE
1215USE dballef
1216#endif
1217TYPE(vol7d_level),INTENT(in) :: this
1218CHARACTER(len=255) :: to_char_level
1219
1220#ifdef HAVE_DBALLE
1221INTEGER :: handle, ier
1222
1223handle = 0
1224ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1225ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1226ier = idba_fatto(handle)
1227
1228to_char_level="LEVEL: "//to_char_level
1229
1230#else
1231
1232to_char_level="LEVEL: "//&
1233 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1234 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
1235
1236#endif
1237
1238END FUNCTION to_char_level
1239
1240
1241ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1242TYPE(vol7d_level),INTENT(IN) :: this, that
1243LOGICAL :: res
1244
1245res = &
1246 this%level1 == that%level1 .AND. &
1247 this%level2 == that%level2 .AND. &
1248 this%l1 == that%l1 .AND. this%l2 == that%l2
1249
1250END FUNCTION vol7d_level_eq
1251
1252
1253ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1254TYPE(vol7d_level),INTENT(IN) :: this, that
1255LOGICAL :: res
1256
1257res = .NOT.(this == that)
1258
1259END FUNCTION vol7d_level_ne
1260
1261
1262ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1263TYPE(vol7d_level),INTENT(IN) :: this, that
1264LOGICAL :: res
1265
1266IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1267 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1268 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1269 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
1270 res = .true.
1271ELSE
1272 res = .false.
1273ENDIF
1274
1275END FUNCTION vol7d_level_almost_eq
1276
1277
1278ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1279TYPE(vol7d_level),INTENT(IN) :: this, that
1280LOGICAL :: res
1281
1282IF (&
1283 this%level1 > that%level1 .OR. &
1284 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1285 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1286 (&
1287 this%level2 > that%level2 .OR. &
1288 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1289 ))) THEN
1290 res = .true.
1291ELSE
1292 res = .false.
1293ENDIF
1294
1295END FUNCTION vol7d_level_gt
1296
1297
1298ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1299TYPE(vol7d_level),INTENT(IN) :: this, that
1300LOGICAL :: res
1301
1302IF (&
1303 this%level1 < that%level1 .OR. &
1304 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1305 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1306 (&
1307 this%level2 < that%level2 .OR. &
1308 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1309 ))) THEN
1310 res = .true.
1311ELSE
1312 res = .false.
1313ENDIF
1314
1315END FUNCTION vol7d_level_lt
1316
1317
1318ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1319TYPE(vol7d_level),INTENT(IN) :: this, that
1320LOGICAL :: res
1321
1322IF (this == that) THEN
1323 res = .true.
1324ELSE IF (this > that) THEN
1325 res = .true.
1326ELSE
1327 res = .false.
1328ENDIF
1329
1330END FUNCTION vol7d_level_ge
1331
1332
1333ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1334TYPE(vol7d_level),INTENT(IN) :: this, that
1335LOGICAL :: res
1336
1337IF (this == that) THEN
1338 res = .true.
1339ELSE IF (this < that) THEN
1340 res = .true.
1341ELSE
1342 res = .false.
1343ENDIF
1344
1345END FUNCTION vol7d_level_le
1346
1347
1348ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1349TYPE(vol7d_level),INTENT(IN) :: this
1350LOGICAL :: c_e
1351c_e = this /= vol7d_level_miss
1352END FUNCTION vol7d_level_c_e
1353
1354
1355#include "array_utilities_inc.F90"
1356
1357
1358FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1359TYPE(vol7d_level),INTENT(in) :: level
1360CHARACTER(len=10) :: btable
1361
1362btable = vol7d_level_to_var_int(level%level1)
1363
1364END FUNCTION vol7d_level_to_var_lev
1365
1366FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1367INTEGER,INTENT(in) :: level
1368CHARACTER(len=10) :: btable
1369
1370INTEGER :: i
1371
1372DO i = 1, SIZE(level_var_converter)
1373 IF (level_var_converter(i)%level == level) THEN
1374 btable = level_var_converter(i)%btable
1375 RETURN
1376 ENDIF
1377ENDDO
1378
1379btable = cmiss
1380
1381END FUNCTION vol7d_level_to_var_int
1382
1383
1384FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1385TYPE(vol7d_level),INTENT(in) :: level
1386REAL :: factor
1387
1388factor = vol7d_level_to_var_factor_int(level%level1)
1389
1390END FUNCTION vol7d_level_to_var_factor_lev
1391
1392FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1393INTEGER,INTENT(in) :: level
1394REAL :: factor
1395
1396factor = 1.
1397IF (any(level == height_level)) THEN
1398 factor = 1.e-3
1399ELSE IF (any(level == thermo_level)) THEN
1400 factor = 1.e-1
1401ELSE IF (any(level == sigma_level)) THEN
1402 factor = 1.e-4
1403ENDIF
1404
1405END FUNCTION vol7d_level_to_var_factor_int
1406
1407
1408FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1409TYPE(vol7d_level),INTENT(in) :: level
1410REAL :: log10
1411
1412log10 = vol7d_level_to_var_log10_int(level%level1)
1413
1414END FUNCTION vol7d_level_to_var_log10_lev
1415
1416FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1417INTEGER,INTENT(in) :: level
1418REAL :: log10
1419
1420log10 = 0.
1421IF (any(level == height_level)) THEN
1422 log10 = -3.
1423ELSE IF (any(level == thermo_level)) THEN
1424 log10 = -1.
1425ELSE IF (any(level == sigma_level)) THEN
1426 log10 = -4.
1427ENDIF
1428
1429END FUNCTION vol7d_level_to_var_log10_int
1430
1431END MODULE vol7d_level_class
Distruttore per la classe vol7d_level.
Costruttore per la classe vol7d_level.
Represent level object in a pretty string.
Return the conversion factor for multiplying the level value when converting to variable.
Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver...
Convert a level type to a physical variable.
Utilities for CHARACTER variables.
Definition of constants to be used for declaring variables of a desired type.
Definition kinds.F90:245
Definitions of constants and functions for working with missing values.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Definisce il livello verticale di un'osservazione.

Generated with Doxygen.