libsim Versione 7.2.1
|
◆ 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
1247IMPLICIT NONE
1248
1254 INTEGER :: level1
1255 INTEGER :: l1
1256 INTEGER :: level2
1257 INTEGER :: l2
1259
1262
1267 MODULE PROCEDURE vol7d_level_init
1268END INTERFACE
1269
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
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
1347 MODULE PROCEDURE display_level
1348END INTERFACE
1349
1352 MODULE PROCEDURE to_char_level
1353END INTERFACE
1354
1357 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1359
1362 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1364
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
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
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: "//&
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
Distruttore per la classe vol7d_level. Definition: vol7d_level_class.F90:242 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 |