libsim Versione 7.1.11

◆ 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 964 del file vol7d_level_class.F90.

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