libsim Versione 7.1.11

◆ index_sorted_level()

recursive integer function index_sorted_level ( type(vol7d_level), dimension(:), intent(in)  vect,
type(vol7d_level), intent(in)  search 
)

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
1249MODULE vol7d_level_class
1250USE kinds
1253IMPLICIT NONE
1254
1259TYPE vol7d_level
1260 INTEGER :: level1
1261 INTEGER :: l1
1262 INTEGER :: level2
1263 INTEGER :: l2
1264END TYPE vol7d_level
1265
1267TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
1268
1272INTERFACE init
1273 MODULE PROCEDURE vol7d_level_init
1274END INTERFACE
1275
1278INTERFACE delete
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
1342INTERFACE c_e
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
1352INTERFACE display
1353 MODULE PROCEDURE display_level
1354END INTERFACE
1355
1357INTERFACE to_char
1358 MODULE PROCEDURE to_char_level
1359END INTERFACE
1360
1362INTERFACE vol7d_level_to_var
1363 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1364END INTERFACE vol7d_level_to_var
1365
1368 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1369END INTERFACE vol7d_level_to_var_factor
1370
1373 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1374END INTERFACE vol7d_level_to_var_log10
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
1420CALL init(this, level1, l1, level2, l2)
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: "//&
1499 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1500 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
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
1532IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1533 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1534 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1535 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
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
1697END 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:251
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.