libsim Versione 7.2.6

◆ map_inv_distinct_level()

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

map inv distinct

Definizione alla linea 1054 del file vol7d_level_class.F90.

1056! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1057! authors:
1058! Davide Cesari <dcesari@arpa.emr.it>
1059! Paolo Patruno <ppatruno@arpa.emr.it>
1060
1061! This program is free software; you can redistribute it and/or
1062! modify it under the terms of the GNU General Public License as
1063! published by the Free Software Foundation; either version 2 of
1064! the License, or (at your option) any later version.
1065
1066! This program is distributed in the hope that it will be useful,
1067! but WITHOUT ANY WARRANTY; without even the implied warranty of
1068! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1069! GNU General Public License for more details.
1070
1071! You should have received a copy of the GNU General Public License
1072! along with this program. If not, see <http://www.gnu.org/licenses/>.
1073#include "config.h"
1074
1075!> Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
1076!! Questo modulo definisce una classe per rappresentare la localizzazione
1077!! verticale di un'osservazione meteorologica, prendendo in prestito
1078!! concetti dal formato grib.
1079!! \ingroup vol7d
1080MODULE vol7d_level_class
1081USE kinds
1084IMPLICIT NONE
1085
1086!> Definisce il livello verticale di un'osservazione.
1087!! I membri di \a vol7d_level sono pubblici e quindi liberamente
1088!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
1089!! il costruttore ::init.
1090TYPE vol7d_level
1091 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)
1092 INTEGER :: l1 !< valore numerico del primo livello, se previsto da \a level1
1093 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)
1094 INTEGER :: l2 !< valore numerico del secondo livello, se previsto da \a level2
1095END TYPE vol7d_level
1096
1097!> Valore mancante per vol7d_level.
1098TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
1099
1100!> Costruttore per la classe vol7d_level.
1101!! Deve essere richiamato
1102!! per tutti gli oggetti di questo tipo definiti in un programma.
1103INTERFACE init
1104 MODULE PROCEDURE vol7d_level_init
1105END INTERFACE
1106
1107!> Distruttore per la classe vol7d_level.
1108!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1109INTERFACE delete
1110 MODULE PROCEDURE vol7d_level_delete
1111END INTERFACE
1112
1113!> Logical equality operator for objects of \a vol7d_level class.
1114!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1115!! of any shape.
1116INTERFACE OPERATOR (==)
1117 MODULE PROCEDURE vol7d_level_eq
1118END INTERFACE
1119
1120!> Logical inequality operator for objects of \a vol7d_level class.
1121!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1122!! of any shape.
1123INTERFACE OPERATOR (/=)
1124 MODULE PROCEDURE vol7d_level_ne
1125END INTERFACE
1126
1127!> Logical greater-than operator for objects of \a vol7d_level class.
1128!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1129!! of any shape.
1130!! Comparison is performed first on \a level, then, then on \l1, then
1131!! on \l2 if defined.
1132INTERFACE OPERATOR (>)
1133 MODULE PROCEDURE vol7d_level_gt
1134END INTERFACE
1135
1136!> Logical less-than operator for objects of \a vol7d_level class.
1137!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1138!! of any shape.
1139!! Comparison is performed first on \a level, then, then on \l1, then
1140!! on \l2 if defined.
1141INTERFACE OPERATOR (<)
1142 MODULE PROCEDURE vol7d_level_lt
1143END INTERFACE
1144
1145!> Logical greater-equal operator for objects of \a vol7d_level class.
1146!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1147!! of any shape.
1148!! Comparison is performed first on \a level, then, then on \l1, then
1149!! on \l2 if defined.
1150INTERFACE OPERATOR (>=)
1151 MODULE PROCEDURE vol7d_level_ge
1152END INTERFACE
1153
1154!> Logical less-equal operator for objects of \a vol7d_level class.
1155!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1156!! of any shape.
1157!! Comparison is performed first on \a level, then, then on \l1, then
1158!! on \l2 if defined.
1159INTERFACE OPERATOR (<=)
1160 MODULE PROCEDURE vol7d_level_le
1161END INTERFACE
1162
1163!> Logical almost equality operators for objects of the class \a
1164!! vol7d_level
1165!! If one component is missing it is not used in comparison
1166INTERFACE OPERATOR (.almosteq.)
1167 MODULE PROCEDURE vol7d_level_almost_eq
1168END INTERFACE
1169
1170
1171! da documentare in inglese assieme al resto
1172!> to be documented
1173INTERFACE c_e
1174 MODULE PROCEDURE vol7d_level_c_e
1175END INTERFACE
1176
1177#define VOL7D_POLY_TYPE TYPE(vol7d_level)
1178#define VOL7D_POLY_TYPES _level
1179#define ENABLE_SORT
1180#include "array_utilities_pre.F90"
1181
1182!>Print object
1183INTERFACE display
1184 MODULE PROCEDURE display_level
1185END INTERFACE
1186
1187!>Represent level object in a pretty string
1188INTERFACE to_char
1189 MODULE PROCEDURE to_char_level
1190END INTERFACE
1191
1192!> Convert a level type to a physical variable
1193INTERFACE vol7d_level_to_var
1194 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1195END INTERFACE vol7d_level_to_var
1196
1197!> Return the conversion factor for multiplying the level value when converting to variable
1199 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1200END INTERFACE vol7d_level_to_var_factor
1201
1202!> Return the scale value (base 10 log of conversion factor) for multiplying the level value when converting to variable
1204 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1205END INTERFACE vol7d_level_to_var_log10
1206
1207type(vol7d_level) :: almost_equal_levels(3)=(/&
1208 vol7d_level( 1,imiss,imiss,imiss),&
1209 vol7d_level(103,imiss,imiss,imiss),&
1210 vol7d_level(106,imiss,imiss,imiss)/)
1211
1212! levels requiring conversion from internal to physical representation
1213INTEGER, PARAMETER :: &
1214 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
1215 thermo_level(3) = (/20,107,235/), & ! 10**-1
1216 sigma_level(2) = (/104,111/) ! 10**-4
1217
1218TYPE level_var
1219 INTEGER :: level
1220 CHARACTER(len=10) :: btable
1221END TYPE level_var
1222
1223! Conversion table from GRIB2 vertical level codes to corresponding
1224! BUFR B table variables
1225TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
1226 level_var(20, 'B12101'), & ! isothermal (K)
1227 level_var(100, 'B10004'), & ! isobaric (Pa)
1228 level_var(102, 'B10007'), & ! height over sea level (m)
1229 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
1230 level_var(107, 'B12192'), & ! isentropical (K)
1231 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
1232 level_var(161, 'B22195') /) ! depth below sea surface
1233
1234PRIVATE level_var, level_var_converter
1235
1236CONTAINS
1237
1238!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
1239!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
1240!! rispetto alla versione \c SUBROUTINE \c init.
1241!! Se non viene passato nessun parametro opzionale l'oggetto è
1242!! inizializzato a valore mancante.
1243FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1244INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
1245INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
1246INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
1247INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
1248
1249TYPE(vol7d_level) :: this !< object to initialize
1250
1251CALL init(this, level1, l1, level2, l2)
1252
1253END FUNCTION vol7d_level_new
1254
1255
1256!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
1257!! Se non viene passato nessun parametro opzionale l'oggetto è
1258!! inizializzato a valore mancante.
1259SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1260TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da inizializzare
1261INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
1262INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
1263INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
1264INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
1265
1266this%level1 = imiss
1267this%l1 = imiss
1268this%level2 = imiss
1269this%l2 = imiss
1270
1271IF (PRESENT(level1)) THEN
1272 this%level1 = level1
1273ELSE
1274 RETURN
1275END IF
1276
1277IF (PRESENT(l1)) this%l1 = l1
1278
1279IF (PRESENT(level2)) THEN
1280 this%level2 = level2
1281ELSE
1282 RETURN
1283END IF
1284
1285IF (PRESENT(l2)) this%l2 = l2
1286
1287END SUBROUTINE vol7d_level_init
1288
1289
1290!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1291SUBROUTINE vol7d_level_delete(this)
1292TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da distruggre
1293
1294this%level1 = imiss
1295this%l1 = imiss
1296this%level2 = imiss
1297this%l2 = imiss
1298
1299END SUBROUTINE vol7d_level_delete
1300
1301
1302SUBROUTINE display_level(this)
1303TYPE(vol7d_level),INTENT(in) :: this
1304
1305print*,trim(to_char(this))
1306
1307END SUBROUTINE display_level
1308
1309
1310FUNCTION to_char_level(this)
1311#ifdef HAVE_DBALLE
1312USE dballef
1313#endif
1314TYPE(vol7d_level),INTENT(in) :: this
1315CHARACTER(len=255) :: to_char_level
1316
1317#ifdef HAVE_DBALLE
1318INTEGER :: handle, ier
1319
1320handle = 0
1321ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1322ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1323ier = idba_fatto(handle)
1324
1325to_char_level="LEVEL: "//to_char_level
1326
1327#else
1328
1329to_char_level="LEVEL: "//&
1330 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1331 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
1332
1333#endif
1334
1335END FUNCTION to_char_level
1336
1337
1338ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1339TYPE(vol7d_level),INTENT(IN) :: this, that
1340LOGICAL :: res
1341
1342res = &
1343 this%level1 == that%level1 .AND. &
1344 this%level2 == that%level2 .AND. &
1345 this%l1 == that%l1 .AND. this%l2 == that%l2
1346
1347END FUNCTION vol7d_level_eq
1348
1349
1350ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1351TYPE(vol7d_level),INTENT(IN) :: this, that
1352LOGICAL :: res
1353
1354res = .NOT.(this == that)
1355
1356END FUNCTION vol7d_level_ne
1357
1358
1359ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1360TYPE(vol7d_level),INTENT(IN) :: this, that
1361LOGICAL :: res
1362
1363IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1364 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1365 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1366 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
1367 res = .true.
1368ELSE
1369 res = .false.
1370ENDIF
1371
1372END FUNCTION vol7d_level_almost_eq
1373
1374
1375ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1376TYPE(vol7d_level),INTENT(IN) :: this, that
1377LOGICAL :: res
1378
1379IF (&
1380 this%level1 > that%level1 .OR. &
1381 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1382 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1383 (&
1384 this%level2 > that%level2 .OR. &
1385 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1386 ))) THEN
1387 res = .true.
1388ELSE
1389 res = .false.
1390ENDIF
1391
1392END FUNCTION vol7d_level_gt
1393
1394
1395ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1396TYPE(vol7d_level),INTENT(IN) :: this, that
1397LOGICAL :: res
1398
1399IF (&
1400 this%level1 < that%level1 .OR. &
1401 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1402 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1403 (&
1404 this%level2 < that%level2 .OR. &
1405 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1406 ))) THEN
1407 res = .true.
1408ELSE
1409 res = .false.
1410ENDIF
1411
1412END FUNCTION vol7d_level_lt
1413
1414
1415ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1416TYPE(vol7d_level),INTENT(IN) :: this, that
1417LOGICAL :: res
1418
1419IF (this == that) THEN
1420 res = .true.
1421ELSE IF (this > that) THEN
1422 res = .true.
1423ELSE
1424 res = .false.
1425ENDIF
1426
1427END FUNCTION vol7d_level_ge
1428
1429
1430ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1431TYPE(vol7d_level),INTENT(IN) :: this, that
1432LOGICAL :: res
1433
1434IF (this == that) THEN
1435 res = .true.
1436ELSE IF (this < that) THEN
1437 res = .true.
1438ELSE
1439 res = .false.
1440ENDIF
1441
1442END FUNCTION vol7d_level_le
1443
1444
1445ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1446TYPE(vol7d_level),INTENT(IN) :: this
1447LOGICAL :: c_e
1448c_e = this /= vol7d_level_miss
1449END FUNCTION vol7d_level_c_e
1450
1451
1452#include "array_utilities_inc.F90"
1453
1454
1455FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1456TYPE(vol7d_level),INTENT(in) :: level
1457CHARACTER(len=10) :: btable
1458
1459btable = vol7d_level_to_var_int(level%level1)
1460
1461END FUNCTION vol7d_level_to_var_lev
1462
1463FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1464INTEGER,INTENT(in) :: level
1465CHARACTER(len=10) :: btable
1466
1467INTEGER :: i
1468
1469DO i = 1, SIZE(level_var_converter)
1470 IF (level_var_converter(i)%level == level) THEN
1471 btable = level_var_converter(i)%btable
1472 RETURN
1473 ENDIF
1474ENDDO
1475
1476btable = cmiss
1477
1478END FUNCTION vol7d_level_to_var_int
1479
1480
1481FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1482TYPE(vol7d_level),INTENT(in) :: level
1483REAL :: factor
1484
1485factor = vol7d_level_to_var_factor_int(level%level1)
1486
1487END FUNCTION vol7d_level_to_var_factor_lev
1488
1489FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1490INTEGER,INTENT(in) :: level
1491REAL :: factor
1492
1493factor = 1.
1494IF (any(level == height_level)) THEN
1495 factor = 1.e-3
1496ELSE IF (any(level == thermo_level)) THEN
1497 factor = 1.e-1
1498ELSE IF (any(level == sigma_level)) THEN
1499 factor = 1.e-4
1500ENDIF
1501
1502END FUNCTION vol7d_level_to_var_factor_int
1503
1504
1505FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1506TYPE(vol7d_level),INTENT(in) :: level
1507REAL :: log10
1508
1509log10 = vol7d_level_to_var_log10_int(level%level1)
1510
1511END FUNCTION vol7d_level_to_var_log10_lev
1512
1513FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1514INTEGER,INTENT(in) :: level
1515REAL :: log10
1516
1517log10 = 0.
1518IF (any(level == height_level)) THEN
1519 log10 = -3.
1520ELSE IF (any(level == thermo_level)) THEN
1521 log10 = -1.
1522ELSE IF (any(level == sigma_level)) THEN
1523 log10 = -4.
1524ENDIF
1525
1526END FUNCTION vol7d_level_to_var_log10_int
1527
1528END 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.