libsim Versione 7.1.11
|
◆ index_sorted_level()
Cerca l'indice del primo o ultimo elemento di vect uguale a search. Definizione alla linea 1223 del file vol7d_level_class.F90. 1225! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1226! authors:
1227! Davide Cesari <dcesari@arpa.emr.it>
1228! Paolo Patruno <ppatruno@arpa.emr.it>
1229
1230! This program is free software; you can redistribute it and/or
1231! modify it under the terms of the GNU General Public License as
1232! published by the Free Software Foundation; either version 2 of
1233! the License, or (at your option) any later version.
1234
1235! This program is distributed in the hope that it will be useful,
1236! but WITHOUT ANY WARRANTY; without even the implied warranty of
1237! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1238! GNU General Public License for more details.
1239
1240! You should have received a copy of the GNU General Public License
1241! along with this program. If not, see <http://www.gnu.org/licenses/>.
1242#include "config.h"
1243
1253IMPLICIT NONE
1254
1260 INTEGER :: level1
1261 INTEGER :: l1
1262 INTEGER :: level2
1263 INTEGER :: l2
1265
1268
1273 MODULE PROCEDURE vol7d_level_init
1274END INTERFACE
1275
1279 MODULE PROCEDURE vol7d_level_delete
1280END INTERFACE
1281
1285INTERFACE OPERATOR (==)
1286 MODULE PROCEDURE vol7d_level_eq
1287END INTERFACE
1288
1292INTERFACE OPERATOR (/=)
1293 MODULE PROCEDURE vol7d_level_ne
1294END INTERFACE
1295
1301INTERFACE OPERATOR (>)
1302 MODULE PROCEDURE vol7d_level_gt
1303END INTERFACE
1304
1310INTERFACE OPERATOR (<)
1311 MODULE PROCEDURE vol7d_level_lt
1312END INTERFACE
1313
1319INTERFACE OPERATOR (>=)
1320 MODULE PROCEDURE vol7d_level_ge
1321END INTERFACE
1322
1328INTERFACE OPERATOR (<=)
1329 MODULE PROCEDURE vol7d_level_le
1330END INTERFACE
1331
1335INTERFACE OPERATOR (.almosteq.)
1336 MODULE PROCEDURE vol7d_level_almost_eq
1337END INTERFACE
1338
1339
1340! da documentare in inglese assieme al resto
1343 MODULE PROCEDURE vol7d_level_c_e
1344END INTERFACE
1345
1346#define VOL7D_POLY_TYPE TYPE(vol7d_level)
1347#define VOL7D_POLY_TYPES _level
1348#define ENABLE_SORT
1349#include "array_utilities_pre.F90"
1350
1353 MODULE PROCEDURE display_level
1354END INTERFACE
1355
1358 MODULE PROCEDURE to_char_level
1359END INTERFACE
1360
1363 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1365
1368 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1370
1373 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1375
1376type(vol7d_level) :: almost_equal_levels(3)=(/&
1377 vol7d_level( 1,imiss,imiss,imiss),&
1378 vol7d_level(103,imiss,imiss,imiss),&
1379 vol7d_level(106,imiss,imiss,imiss)/)
1380
1381! levels requiring conversion from internal to physical representation
1382INTEGER, PARAMETER :: &
1383 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
1384 thermo_level(3) = (/20,107,235/), & ! 10**-1
1385 sigma_level(2) = (/104,111/) ! 10**-4
1386
1387TYPE level_var
1388 INTEGER :: level
1389 CHARACTER(len=10) :: btable
1390END TYPE level_var
1391
1392! Conversion table from GRIB2 vertical level codes to corresponding
1393! BUFR B table variables
1394TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
1395 level_var(20, 'B12101'), & ! isothermal (K)
1396 level_var(100, 'B10004'), & ! isobaric (Pa)
1397 level_var(102, 'B10007'), & ! height over sea level (m)
1398 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
1399 level_var(107, 'B12192'), & ! isentropical (K)
1400 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
1401 level_var(161, 'B22195') /) ! depth below sea surface
1402
1403PRIVATE level_var, level_var_converter
1404
1405CONTAINS
1406
1412FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1413INTEGER,INTENT(IN),OPTIONAL :: level1
1414INTEGER,INTENT(IN),OPTIONAL :: l1
1415INTEGER,INTENT(IN),OPTIONAL :: level2
1416INTEGER,INTENT(IN),OPTIONAL :: l2
1417
1418TYPE(vol7d_level) :: this
1419
1421
1422END FUNCTION vol7d_level_new
1423
1424
1428SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1429TYPE(vol7d_level),INTENT(INOUT) :: this
1430INTEGER,INTENT(IN),OPTIONAL :: level1
1431INTEGER,INTENT(IN),OPTIONAL :: l1
1432INTEGER,INTENT(IN),OPTIONAL :: level2
1433INTEGER,INTENT(IN),OPTIONAL :: l2
1434
1435this%level1 = imiss
1436this%l1 = imiss
1437this%level2 = imiss
1438this%l2 = imiss
1439
1440IF (PRESENT(level1)) THEN
1441 this%level1 = level1
1442ELSE
1443 RETURN
1444END IF
1445
1446IF (PRESENT(l1)) this%l1 = l1
1447
1448IF (PRESENT(level2)) THEN
1449 this%level2 = level2
1450ELSE
1451 RETURN
1452END IF
1453
1454IF (PRESENT(l2)) this%l2 = l2
1455
1456END SUBROUTINE vol7d_level_init
1457
1458
1460SUBROUTINE vol7d_level_delete(this)
1461TYPE(vol7d_level),INTENT(INOUT) :: this
1462
1463this%level1 = imiss
1464this%l1 = imiss
1465this%level2 = imiss
1466this%l2 = imiss
1467
1468END SUBROUTINE vol7d_level_delete
1469
1470
1471SUBROUTINE display_level(this)
1472TYPE(vol7d_level),INTENT(in) :: this
1473
1474print*,trim(to_char(this))
1475
1476END SUBROUTINE display_level
1477
1478
1479FUNCTION to_char_level(this)
1480#ifdef HAVE_DBALLE
1481USE dballef
1482#endif
1483TYPE(vol7d_level),INTENT(in) :: this
1484CHARACTER(len=255) :: to_char_level
1485
1486#ifdef HAVE_DBALLE
1487INTEGER :: handle, ier
1488
1489handle = 0
1490ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1491ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1492ier = idba_fatto(handle)
1493
1494to_char_level="LEVEL: "//to_char_level
1495
1496#else
1497
1498to_char_level="LEVEL: "//&
1501
1502#endif
1503
1504END FUNCTION to_char_level
1505
1506
1507ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1508TYPE(vol7d_level),INTENT(IN) :: this, that
1509LOGICAL :: res
1510
1511res = &
1512 this%level1 == that%level1 .AND. &
1513 this%level2 == that%level2 .AND. &
1514 this%l1 == that%l1 .AND. this%l2 == that%l2
1515
1516END FUNCTION vol7d_level_eq
1517
1518
1519ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1520TYPE(vol7d_level),INTENT(IN) :: this, that
1521LOGICAL :: res
1522
1523res = .NOT.(this == that)
1524
1525END FUNCTION vol7d_level_ne
1526
1527
1528ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1529TYPE(vol7d_level),INTENT(IN) :: this, that
1530LOGICAL :: res
1531
1536 res = .true.
1537ELSE
1538 res = .false.
1539ENDIF
1540
1541END FUNCTION vol7d_level_almost_eq
1542
1543
1544ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1545TYPE(vol7d_level),INTENT(IN) :: this, that
1546LOGICAL :: res
1547
1548IF (&
1549 this%level1 > that%level1 .OR. &
1550 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1551 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1552 (&
1553 this%level2 > that%level2 .OR. &
1554 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1555 ))) THEN
1556 res = .true.
1557ELSE
1558 res = .false.
1559ENDIF
1560
1561END FUNCTION vol7d_level_gt
1562
1563
1564ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1565TYPE(vol7d_level),INTENT(IN) :: this, that
1566LOGICAL :: res
1567
1568IF (&
1569 this%level1 < that%level1 .OR. &
1570 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1571 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1572 (&
1573 this%level2 < that%level2 .OR. &
1574 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1575 ))) THEN
1576 res = .true.
1577ELSE
1578 res = .false.
1579ENDIF
1580
1581END FUNCTION vol7d_level_lt
1582
1583
1584ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1585TYPE(vol7d_level),INTENT(IN) :: this, that
1586LOGICAL :: res
1587
1588IF (this == that) THEN
1589 res = .true.
1590ELSE IF (this > that) THEN
1591 res = .true.
1592ELSE
1593 res = .false.
1594ENDIF
1595
1596END FUNCTION vol7d_level_ge
1597
1598
1599ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1600TYPE(vol7d_level),INTENT(IN) :: this, that
1601LOGICAL :: res
1602
1603IF (this == that) THEN
1604 res = .true.
1605ELSE IF (this < that) THEN
1606 res = .true.
1607ELSE
1608 res = .false.
1609ENDIF
1610
1611END FUNCTION vol7d_level_le
1612
1613
1614ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1615TYPE(vol7d_level),INTENT(IN) :: this
1616LOGICAL :: c_e
1617c_e = this /= vol7d_level_miss
1618END FUNCTION vol7d_level_c_e
1619
1620
1621#include "array_utilities_inc.F90"
1622
1623
1624FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1625TYPE(vol7d_level),INTENT(in) :: level
1626CHARACTER(len=10) :: btable
1627
1628btable = vol7d_level_to_var_int(level%level1)
1629
1630END FUNCTION vol7d_level_to_var_lev
1631
1632FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1633INTEGER,INTENT(in) :: level
1634CHARACTER(len=10) :: btable
1635
1636INTEGER :: i
1637
1638DO i = 1, SIZE(level_var_converter)
1639 IF (level_var_converter(i)%level == level) THEN
1640 btable = level_var_converter(i)%btable
1641 RETURN
1642 ENDIF
1643ENDDO
1644
1645btable = cmiss
1646
1647END FUNCTION vol7d_level_to_var_int
1648
1649
1650FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1651TYPE(vol7d_level),INTENT(in) :: level
1652REAL :: factor
1653
1654factor = vol7d_level_to_var_factor_int(level%level1)
1655
1656END FUNCTION vol7d_level_to_var_factor_lev
1657
1658FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1659INTEGER,INTENT(in) :: level
1660REAL :: factor
1661
1662factor = 1.
1663IF (any(level == height_level)) THEN
1664 factor = 1.e-3
1665ELSE IF (any(level == thermo_level)) THEN
1666 factor = 1.e-1
1667ELSE IF (any(level == sigma_level)) THEN
1668 factor = 1.e-4
1669ENDIF
1670
1671END FUNCTION vol7d_level_to_var_factor_int
1672
1673
1674FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1675TYPE(vol7d_level),INTENT(in) :: level
1676REAL :: log10
1677
1678log10 = vol7d_level_to_var_log10_int(level%level1)
1679
1680END FUNCTION vol7d_level_to_var_log10_lev
1681
1682FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1683INTEGER,INTENT(in) :: level
1684REAL :: log10
1685
1686log10 = 0.
1687IF (any(level == height_level)) THEN
1688 log10 = -3.
1689ELSE IF (any(level == thermo_level)) THEN
1690 log10 = -1.
1691ELSE IF (any(level == sigma_level)) THEN
1692 log10 = -4.
1693ENDIF
1694
1695END FUNCTION vol7d_level_to_var_log10_int
1696
Distruttore per la classe vol7d_level. Definition: vol7d_level_class.F90:248 Represent level object in a pretty string. Definition: vol7d_level_class.F90:382 Return the conversion factor for multiplying the level value when converting to variable. Definition: vol7d_level_class.F90:392 Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver... Definition: vol7d_level_class.F90:397 Convert a level type to a physical variable. Definition: vol7d_level_class.F90:387 Definition of constants to be used for declaring variables of a desired type. Definition: kinds.F90:251 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:219 Definisce il livello verticale di un'osservazione. Definition: vol7d_level_class.F90:229 |