libsim Versione 7.1.11
|
◆ map_distinct_level()
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
993IMPLICIT NONE
994
1000 INTEGER :: level1
1001 INTEGER :: l1
1002 INTEGER :: level2
1003 INTEGER :: l2
1005
1008
1013 MODULE PROCEDURE vol7d_level_init
1014END INTERFACE
1015
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
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
1093 MODULE PROCEDURE display_level
1094END INTERFACE
1095
1098 MODULE PROCEDURE to_char_level
1099END INTERFACE
1100
1103 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1105
1108 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1110
1113 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
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
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: "//&
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
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
Distruttore per la classe vol7d_level. Definition: vol7d_level_class.F90:248 Represent level object in a pretty string. Definition: vol7d_level_class.F90:382 Return the conversion factor for multiplying the level value when converting to variable. Definition: vol7d_level_class.F90:392 Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver... Definition: vol7d_level_class.F90:397 Convert a level type to a physical variable. Definition: vol7d_level_class.F90:387 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. Definition: missing_values.f90:50 Classe per la gestione dei livelli verticali in osservazioni meteo e affini. Definition: vol7d_level_class.F90:219 Definisce il livello verticale di un'osservazione. Definition: vol7d_level_class.F90:229 |