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