libsim Versione 7.2.0
|
◆ map_distinct_level()
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
987IMPLICIT NONE
988
994 INTEGER :: level1
995 INTEGER :: l1
996 INTEGER :: level2
997 INTEGER :: l2
999
1002
1007 MODULE PROCEDURE vol7d_level_init
1008END INTERFACE
1009
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
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
1087 MODULE PROCEDURE display_level
1088END INTERFACE
1089
1092 MODULE PROCEDURE to_char_level
1093END INTERFACE
1094
1097 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1099
1102 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1104
1107 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
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
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: "//&
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
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
Distruttore per la classe vol7d_level. Definition: vol7d_level_class.F90:242 Represent level object in a pretty string. Definition: vol7d_level_class.F90:376 Return the conversion factor for multiplying the level value when converting to variable. Definition: vol7d_level_class.F90:386 Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver... Definition: vol7d_level_class.F90:391 Convert a level type to a physical variable. Definition: vol7d_level_class.F90:381 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. Definition: missing_values.f90:50 Classe per la gestione dei livelli verticali in osservazioni meteo e affini. Definition: vol7d_level_class.F90:213 Definisce il livello verticale di un'osservazione. Definition: vol7d_level_class.F90:223 |