libsim Versione 7.2.4

◆ 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 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
1243MODULE vol7d_level_class
1244USE kinds
1247IMPLICIT NONE
1248
1253TYPE vol7d_level
1254 INTEGER :: level1
1255 INTEGER :: l1
1256 INTEGER :: level2
1257 INTEGER :: l2
1258END TYPE vol7d_level
1259
1261TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
1262
1266INTERFACE init
1267 MODULE PROCEDURE vol7d_level_init
1268END INTERFACE
1269
1272INTERFACE delete
1273 MODULE PROCEDURE vol7d_level_delete
1274END INTERFACE
1275
1279INTERFACE OPERATOR (==)
1280 MODULE PROCEDURE vol7d_level_eq
1281END INTERFACE
1282
1286INTERFACE OPERATOR (/=)
1287 MODULE PROCEDURE vol7d_level_ne
1288END INTERFACE
1289
1295INTERFACE OPERATOR (>)
1296 MODULE PROCEDURE vol7d_level_gt
1297END INTERFACE
1298
1304INTERFACE OPERATOR (<)
1305 MODULE PROCEDURE vol7d_level_lt
1306END INTERFACE
1307
1313INTERFACE OPERATOR (>=)
1314 MODULE PROCEDURE vol7d_level_ge
1315END INTERFACE
1316
1322INTERFACE OPERATOR (<=)
1323 MODULE PROCEDURE vol7d_level_le
1324END INTERFACE
1325
1329INTERFACE OPERATOR (.almosteq.)
1330 MODULE PROCEDURE vol7d_level_almost_eq
1331END INTERFACE
1332
1333
1334! da documentare in inglese assieme al resto
1336INTERFACE c_e
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
1346INTERFACE display
1347 MODULE PROCEDURE display_level
1348END INTERFACE
1349
1351INTERFACE to_char
1352 MODULE PROCEDURE to_char_level
1353END INTERFACE
1354
1356INTERFACE vol7d_level_to_var
1357 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1358END INTERFACE vol7d_level_to_var
1359
1362 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1363END INTERFACE vol7d_level_to_var_factor
1364
1367 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1368END INTERFACE vol7d_level_to_var_log10
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
1406FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1407INTEGER,INTENT(IN),OPTIONAL :: level1
1408INTEGER,INTENT(IN),OPTIONAL :: l1
1409INTEGER,INTENT(IN),OPTIONAL :: level2
1410INTEGER,INTENT(IN),OPTIONAL :: l2
1411
1412TYPE(vol7d_level) :: this
1413
1414CALL init(this, level1, l1, level2, l2)
1415
1416END FUNCTION vol7d_level_new
1417
1418
1422SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1423TYPE(vol7d_level),INTENT(INOUT) :: this
1424INTEGER,INTENT(IN),OPTIONAL :: level1
1425INTEGER,INTENT(IN),OPTIONAL :: l1
1426INTEGER,INTENT(IN),OPTIONAL :: level2
1427INTEGER,INTENT(IN),OPTIONAL :: l2
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
1454SUBROUTINE vol7d_level_delete(this)
1455TYPE(vol7d_level),INTENT(INOUT) :: this
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: "//&
1493 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1494 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
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
1526IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1527 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1528 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1529 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
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
1691END 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.