libsim Versione 7.2.6
|
◆ index_level()
Cerca l'indice del primo o ultimo elemento di vect uguale a search. Definizione alla linea 1140 del file vol7d_level_class.F90. 1142! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1143! authors:
1144! Davide Cesari <dcesari@arpa.emr.it>
1145! Paolo Patruno <ppatruno@arpa.emr.it>
1146
1147! This program is free software; you can redistribute it and/or
1148! modify it under the terms of the GNU General Public License as
1149! published by the Free Software Foundation; either version 2 of
1150! the License, or (at your option) any later version.
1151
1152! This program is distributed in the hope that it will be useful,
1153! but WITHOUT ANY WARRANTY; without even the implied warranty of
1154! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1155! GNU General Public License for more details.
1156
1157! You should have received a copy of the GNU General Public License
1158! along with this program. If not, see <http://www.gnu.org/licenses/>.
1159#include "config.h"
1160
1161!> Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
1162!! Questo modulo definisce una classe per rappresentare la localizzazione
1163!! verticale di un'osservazione meteorologica, prendendo in prestito
1164!! concetti dal formato grib.
1165!! \ingroup vol7d
1170IMPLICIT NONE
1171
1172!> Definisce il livello verticale di un'osservazione.
1173!! I membri di \a vol7d_level sono pubblici e quindi liberamente
1174!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
1175!! il costruttore ::init.
1177 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)
1178 INTEGER :: l1 !< valore numerico del primo livello, se previsto da \a level1
1179 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)
1180 INTEGER :: l2 !< valore numerico del secondo livello, se previsto da \a level2
1182
1183!> Valore mancante per vol7d_level.
1185
1186!> Costruttore per la classe vol7d_level.
1187!! Deve essere richiamato
1188!! per tutti gli oggetti di questo tipo definiti in un programma.
1190 MODULE PROCEDURE vol7d_level_init
1191END INTERFACE
1192
1193!> Distruttore per la classe vol7d_level.
1194!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1196 MODULE PROCEDURE vol7d_level_delete
1197END INTERFACE
1198
1199!> Logical equality operator for objects of \a vol7d_level class.
1200!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1201!! of any shape.
1202INTERFACE OPERATOR (==)
1203 MODULE PROCEDURE vol7d_level_eq
1204END INTERFACE
1205
1206!> Logical inequality operator for objects of \a vol7d_level class.
1207!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1208!! of any shape.
1209INTERFACE OPERATOR (/=)
1210 MODULE PROCEDURE vol7d_level_ne
1211END INTERFACE
1212
1213!> Logical greater-than operator for objects of \a vol7d_level class.
1214!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1215!! of any shape.
1216!! Comparison is performed first on \a level, then, then on \l1, then
1217!! on \l2 if defined.
1218INTERFACE OPERATOR (>)
1219 MODULE PROCEDURE vol7d_level_gt
1220END INTERFACE
1221
1222!> Logical less-than operator for objects of \a vol7d_level class.
1223!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1224!! of any shape.
1225!! Comparison is performed first on \a level, then, then on \l1, then
1226!! on \l2 if defined.
1227INTERFACE OPERATOR (<)
1228 MODULE PROCEDURE vol7d_level_lt
1229END INTERFACE
1230
1231!> Logical greater-equal operator for objects of \a vol7d_level class.
1232!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1233!! of any shape.
1234!! Comparison is performed first on \a level, then, then on \l1, then
1235!! on \l2 if defined.
1236INTERFACE OPERATOR (>=)
1237 MODULE PROCEDURE vol7d_level_ge
1238END INTERFACE
1239
1240!> Logical less-equal operator for objects of \a vol7d_level class.
1241!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1242!! of any shape.
1243!! Comparison is performed first on \a level, then, then on \l1, then
1244!! on \l2 if defined.
1245INTERFACE OPERATOR (<=)
1246 MODULE PROCEDURE vol7d_level_le
1247END INTERFACE
1248
1249!> Logical almost equality operators for objects of the class \a
1250!! vol7d_level
1251!! If one component is missing it is not used in comparison
1252INTERFACE OPERATOR (.almosteq.)
1253 MODULE PROCEDURE vol7d_level_almost_eq
1254END INTERFACE
1255
1256
1257! da documentare in inglese assieme al resto
1258!> to be documented
1260 MODULE PROCEDURE vol7d_level_c_e
1261END INTERFACE
1262
1263#define VOL7D_POLY_TYPE TYPE(vol7d_level)
1264#define VOL7D_POLY_TYPES _level
1265#define ENABLE_SORT
1266#include "array_utilities_pre.F90"
1267
1268!>Print object
1270 MODULE PROCEDURE display_level
1271END INTERFACE
1272
1273!>Represent level object in a pretty string
1275 MODULE PROCEDURE to_char_level
1276END INTERFACE
1277
1278!> Convert a level type to a physical variable
1280 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1282
1283!> Return the conversion factor for multiplying the level value when converting to variable
1285 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1287
1288!> Return the scale value (base 10 log of conversion factor) for multiplying the level value when converting to variable
1290 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1292
1293type(vol7d_level) :: almost_equal_levels(3)=(/&
1294 vol7d_level( 1,imiss,imiss,imiss),&
1295 vol7d_level(103,imiss,imiss,imiss),&
1296 vol7d_level(106,imiss,imiss,imiss)/)
1297
1298! levels requiring conversion from internal to physical representation
1299INTEGER, PARAMETER :: &
1300 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
1301 thermo_level(3) = (/20,107,235/), & ! 10**-1
1302 sigma_level(2) = (/104,111/) ! 10**-4
1303
1304TYPE level_var
1305 INTEGER :: level
1306 CHARACTER(len=10) :: btable
1307END TYPE level_var
1308
1309! Conversion table from GRIB2 vertical level codes to corresponding
1310! BUFR B table variables
1311TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
1312 level_var(20, 'B12101'), & ! isothermal (K)
1313 level_var(100, 'B10004'), & ! isobaric (Pa)
1314 level_var(102, 'B10007'), & ! height over sea level (m)
1315 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
1316 level_var(107, 'B12192'), & ! isentropical (K)
1317 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
1318 level_var(161, 'B22195') /) ! depth below sea surface
1319
1320PRIVATE level_var, level_var_converter
1321
1322CONTAINS
1323
1324!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
1325!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
1326!! rispetto alla versione \c SUBROUTINE \c init.
1327!! Se non viene passato nessun parametro opzionale l'oggetto è
1328!! inizializzato a valore mancante.
1329FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1330INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
1331INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
1332INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
1333INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
1334
1335TYPE(vol7d_level) :: this !< object to initialize
1336
1338
1339END FUNCTION vol7d_level_new
1340
1341
1342!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
1343!! Se non viene passato nessun parametro opzionale l'oggetto è
1344!! inizializzato a valore mancante.
1345SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1346TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da inizializzare
1347INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
1348INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
1349INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
1350INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
1351
1352this%level1 = imiss
1353this%l1 = imiss
1354this%level2 = imiss
1355this%l2 = imiss
1356
1357IF (PRESENT(level1)) THEN
1358 this%level1 = level1
1359ELSE
1360 RETURN
1361END IF
1362
1363IF (PRESENT(l1)) this%l1 = l1
1364
1365IF (PRESENT(level2)) THEN
1366 this%level2 = level2
1367ELSE
1368 RETURN
1369END IF
1370
1371IF (PRESENT(l2)) this%l2 = l2
1372
1373END SUBROUTINE vol7d_level_init
1374
1375
1376!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1377SUBROUTINE vol7d_level_delete(this)
1378TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da distruggre
1379
1380this%level1 = imiss
1381this%l1 = imiss
1382this%level2 = imiss
1383this%l2 = imiss
1384
1385END SUBROUTINE vol7d_level_delete
1386
1387
1388SUBROUTINE display_level(this)
1389TYPE(vol7d_level),INTENT(in) :: this
1390
1391print*,trim(to_char(this))
1392
1393END SUBROUTINE display_level
1394
1395
1396FUNCTION to_char_level(this)
1397#ifdef HAVE_DBALLE
1398USE dballef
1399#endif
1400TYPE(vol7d_level),INTENT(in) :: this
1401CHARACTER(len=255) :: to_char_level
1402
1403#ifdef HAVE_DBALLE
1404INTEGER :: handle, ier
1405
1406handle = 0
1407ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1408ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1409ier = idba_fatto(handle)
1410
1411to_char_level="LEVEL: "//to_char_level
1412
1413#else
1414
1415to_char_level="LEVEL: "//&
1418
1419#endif
1420
1421END FUNCTION to_char_level
1422
1423
1424ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1425TYPE(vol7d_level),INTENT(IN) :: this, that
1426LOGICAL :: res
1427
1428res = &
1429 this%level1 == that%level1 .AND. &
1430 this%level2 == that%level2 .AND. &
1431 this%l1 == that%l1 .AND. this%l2 == that%l2
1432
1433END FUNCTION vol7d_level_eq
1434
1435
1436ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1437TYPE(vol7d_level),INTENT(IN) :: this, that
1438LOGICAL :: res
1439
1440res = .NOT.(this == that)
1441
1442END FUNCTION vol7d_level_ne
1443
1444
1445ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1446TYPE(vol7d_level),INTENT(IN) :: this, that
1447LOGICAL :: res
1448
1453 res = .true.
1454ELSE
1455 res = .false.
1456ENDIF
1457
1458END FUNCTION vol7d_level_almost_eq
1459
1460
1461ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1462TYPE(vol7d_level),INTENT(IN) :: this, that
1463LOGICAL :: res
1464
1465IF (&
1466 this%level1 > that%level1 .OR. &
1467 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1468 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1469 (&
1470 this%level2 > that%level2 .OR. &
1471 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1472 ))) THEN
1473 res = .true.
1474ELSE
1475 res = .false.
1476ENDIF
1477
1478END FUNCTION vol7d_level_gt
1479
1480
1481ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1482TYPE(vol7d_level),INTENT(IN) :: this, that
1483LOGICAL :: res
1484
1485IF (&
1486 this%level1 < that%level1 .OR. &
1487 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1488 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1489 (&
1490 this%level2 < that%level2 .OR. &
1491 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1492 ))) THEN
1493 res = .true.
1494ELSE
1495 res = .false.
1496ENDIF
1497
1498END FUNCTION vol7d_level_lt
1499
1500
1501ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1502TYPE(vol7d_level),INTENT(IN) :: this, that
1503LOGICAL :: res
1504
1505IF (this == that) THEN
1506 res = .true.
1507ELSE IF (this > that) THEN
1508 res = .true.
1509ELSE
1510 res = .false.
1511ENDIF
1512
1513END FUNCTION vol7d_level_ge
1514
1515
1516ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1517TYPE(vol7d_level),INTENT(IN) :: this, that
1518LOGICAL :: res
1519
1520IF (this == that) THEN
1521 res = .true.
1522ELSE IF (this < that) THEN
1523 res = .true.
1524ELSE
1525 res = .false.
1526ENDIF
1527
1528END FUNCTION vol7d_level_le
1529
1530
1531ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1532TYPE(vol7d_level),INTENT(IN) :: this
1533LOGICAL :: c_e
1534c_e = this /= vol7d_level_miss
1535END FUNCTION vol7d_level_c_e
1536
1537
1538#include "array_utilities_inc.F90"
1539
1540
1541FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1542TYPE(vol7d_level),INTENT(in) :: level
1543CHARACTER(len=10) :: btable
1544
1545btable = vol7d_level_to_var_int(level%level1)
1546
1547END FUNCTION vol7d_level_to_var_lev
1548
1549FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1550INTEGER,INTENT(in) :: level
1551CHARACTER(len=10) :: btable
1552
1553INTEGER :: i
1554
1555DO i = 1, SIZE(level_var_converter)
1556 IF (level_var_converter(i)%level == level) THEN
1557 btable = level_var_converter(i)%btable
1558 RETURN
1559 ENDIF
1560ENDDO
1561
1562btable = cmiss
1563
1564END FUNCTION vol7d_level_to_var_int
1565
1566
1567FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1568TYPE(vol7d_level),INTENT(in) :: level
1569REAL :: factor
1570
1571factor = vol7d_level_to_var_factor_int(level%level1)
1572
1573END FUNCTION vol7d_level_to_var_factor_lev
1574
1575FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1576INTEGER,INTENT(in) :: level
1577REAL :: factor
1578
1579factor = 1.
1580IF (any(level == height_level)) THEN
1581 factor = 1.e-3
1582ELSE IF (any(level == thermo_level)) THEN
1583 factor = 1.e-1
1584ELSE IF (any(level == sigma_level)) THEN
1585 factor = 1.e-4
1586ENDIF
1587
1588END FUNCTION vol7d_level_to_var_factor_int
1589
1590
1591FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1592TYPE(vol7d_level),INTENT(in) :: level
1593REAL :: log10
1594
1595log10 = vol7d_level_to_var_log10_int(level%level1)
1596
1597END FUNCTION vol7d_level_to_var_log10_lev
1598
1599FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1600INTEGER,INTENT(in) :: level
1601REAL :: log10
1602
1603log10 = 0.
1604IF (any(level == height_level)) THEN
1605 log10 = -3.
1606ELSE IF (any(level == thermo_level)) THEN
1607 log10 = -1.
1608ELSE IF (any(level == sigma_level)) THEN
1609 log10 = -4.
1610ENDIF
1611
1612END FUNCTION vol7d_level_to_var_log10_int
1613
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 |