libsim Versione 7.2.6
|
◆ 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
978!> Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
979!! Questo modulo definisce una classe per rappresentare la localizzazione
980!! verticale di un'osservazione meteorologica, prendendo in prestito
981!! concetti dal formato grib.
982!! \ingroup vol7d
987IMPLICIT NONE
988
989!> Definisce il livello verticale di un'osservazione.
990!! I membri di \a vol7d_level sono pubblici e quindi liberamente
991!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
992!! il costruttore ::init.
994 INTEGER :: level1 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
995 INTEGER :: l1 !< valore numerico del primo livello, se previsto da \a level1
996 INTEGER :: level2 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
997 INTEGER :: l2 !< valore numerico del secondo livello, se previsto da \a level2
999
1000!> Valore mancante per vol7d_level.
1002
1003!> Costruttore per la classe vol7d_level.
1004!! Deve essere richiamato
1005!! per tutti gli oggetti di questo tipo definiti in un programma.
1007 MODULE PROCEDURE vol7d_level_init
1008END INTERFACE
1009
1010!> Distruttore per la classe vol7d_level.
1011!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1013 MODULE PROCEDURE vol7d_level_delete
1014END INTERFACE
1015
1016!> Logical equality operator for objects of \a vol7d_level class.
1017!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1018!! of any shape.
1019INTERFACE OPERATOR (==)
1020 MODULE PROCEDURE vol7d_level_eq
1021END INTERFACE
1022
1023!> Logical inequality operator for objects of \a vol7d_level class.
1024!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1025!! of any shape.
1026INTERFACE OPERATOR (/=)
1027 MODULE PROCEDURE vol7d_level_ne
1028END INTERFACE
1029
1030!> Logical greater-than operator for objects of \a vol7d_level class.
1031!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1032!! of any shape.
1033!! Comparison is performed first on \a level, then, then on \l1, then
1034!! on \l2 if defined.
1035INTERFACE OPERATOR (>)
1036 MODULE PROCEDURE vol7d_level_gt
1037END INTERFACE
1038
1039!> Logical less-than operator for objects of \a vol7d_level class.
1040!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1041!! of any shape.
1042!! Comparison is performed first on \a level, then, then on \l1, then
1043!! on \l2 if defined.
1044INTERFACE OPERATOR (<)
1045 MODULE PROCEDURE vol7d_level_lt
1046END INTERFACE
1047
1048!> Logical greater-equal operator for objects of \a vol7d_level class.
1049!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1050!! of any shape.
1051!! Comparison is performed first on \a level, then, then on \l1, then
1052!! on \l2 if defined.
1053INTERFACE OPERATOR (>=)
1054 MODULE PROCEDURE vol7d_level_ge
1055END INTERFACE
1056
1057!> Logical less-equal operator for objects of \a vol7d_level class.
1058!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1059!! of any shape.
1060!! Comparison is performed first on \a level, then, then on \l1, then
1061!! on \l2 if defined.
1062INTERFACE OPERATOR (<=)
1063 MODULE PROCEDURE vol7d_level_le
1064END INTERFACE
1065
1066!> Logical almost equality operators for objects of the class \a
1067!! vol7d_level
1068!! If one component is missing it is not used in comparison
1069INTERFACE OPERATOR (.almosteq.)
1070 MODULE PROCEDURE vol7d_level_almost_eq
1071END INTERFACE
1072
1073
1074! da documentare in inglese assieme al resto
1075!> to be documented
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
1085!>Print object
1087 MODULE PROCEDURE display_level
1088END INTERFACE
1089
1090!>Represent level object in a pretty string
1092 MODULE PROCEDURE to_char_level
1093END INTERFACE
1094
1095!> Convert a level type to a physical variable
1097 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1099
1100!> Return the conversion factor for multiplying the level value when converting to variable
1102 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1104
1105!> Return the scale value (base 10 log of conversion factor) for multiplying the level value when converting to variable
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
1141!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
1142!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
1143!! rispetto alla versione \c SUBROUTINE \c init.
1144!! Se non viene passato nessun parametro opzionale l'oggetto è
1145!! inizializzato a valore mancante.
1146FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1147INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
1148INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
1149INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
1150INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
1151
1152TYPE(vol7d_level) :: this !< object to initialize
1153
1155
1156END FUNCTION vol7d_level_new
1157
1158
1159!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
1160!! Se non viene passato nessun parametro opzionale l'oggetto è
1161!! inizializzato a valore mancante.
1162SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1163TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da inizializzare
1164INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
1165INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
1166INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
1167INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
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
1193!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1194SUBROUTINE vol7d_level_delete(this)
1195TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da distruggre
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
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 |