libsim Versione 7.1.11
|
◆ index_level()
Cerca l'indice del primo o ultimo elemento di vect uguale a search. Definizione alla linea 1146 del file vol7d_level_class.F90. 1148! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1149! authors:
1150! Davide Cesari <dcesari@arpa.emr.it>
1151! Paolo Patruno <ppatruno@arpa.emr.it>
1152
1153! This program is free software; you can redistribute it and/or
1154! modify it under the terms of the GNU General Public License as
1155! published by the Free Software Foundation; either version 2 of
1156! the License, or (at your option) any later version.
1157
1158! This program is distributed in the hope that it will be useful,
1159! but WITHOUT ANY WARRANTY; without even the implied warranty of
1160! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1161! GNU General Public License for more details.
1162
1163! You should have received a copy of the GNU General Public License
1164! along with this program. If not, see <http://www.gnu.org/licenses/>.
1165#include "config.h"
1166
1176IMPLICIT NONE
1177
1183 INTEGER :: level1
1184 INTEGER :: l1
1185 INTEGER :: level2
1186 INTEGER :: l2
1188
1191
1196 MODULE PROCEDURE vol7d_level_init
1197END INTERFACE
1198
1202 MODULE PROCEDURE vol7d_level_delete
1203END INTERFACE
1204
1208INTERFACE OPERATOR (==)
1209 MODULE PROCEDURE vol7d_level_eq
1210END INTERFACE
1211
1215INTERFACE OPERATOR (/=)
1216 MODULE PROCEDURE vol7d_level_ne
1217END INTERFACE
1218
1224INTERFACE OPERATOR (>)
1225 MODULE PROCEDURE vol7d_level_gt
1226END INTERFACE
1227
1233INTERFACE OPERATOR (<)
1234 MODULE PROCEDURE vol7d_level_lt
1235END INTERFACE
1236
1242INTERFACE OPERATOR (>=)
1243 MODULE PROCEDURE vol7d_level_ge
1244END INTERFACE
1245
1251INTERFACE OPERATOR (<=)
1252 MODULE PROCEDURE vol7d_level_le
1253END INTERFACE
1254
1258INTERFACE OPERATOR (.almosteq.)
1259 MODULE PROCEDURE vol7d_level_almost_eq
1260END INTERFACE
1261
1262
1263! da documentare in inglese assieme al resto
1266 MODULE PROCEDURE vol7d_level_c_e
1267END INTERFACE
1268
1269#define VOL7D_POLY_TYPE TYPE(vol7d_level)
1270#define VOL7D_POLY_TYPES _level
1271#define ENABLE_SORT
1272#include "array_utilities_pre.F90"
1273
1276 MODULE PROCEDURE display_level
1277END INTERFACE
1278
1281 MODULE PROCEDURE to_char_level
1282END INTERFACE
1283
1286 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1288
1291 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1293
1296 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1298
1299type(vol7d_level) :: almost_equal_levels(3)=(/&
1300 vol7d_level( 1,imiss,imiss,imiss),&
1301 vol7d_level(103,imiss,imiss,imiss),&
1302 vol7d_level(106,imiss,imiss,imiss)/)
1303
1304! levels requiring conversion from internal to physical representation
1305INTEGER, PARAMETER :: &
1306 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
1307 thermo_level(3) = (/20,107,235/), & ! 10**-1
1308 sigma_level(2) = (/104,111/) ! 10**-4
1309
1310TYPE level_var
1311 INTEGER :: level
1312 CHARACTER(len=10) :: btable
1313END TYPE level_var
1314
1315! Conversion table from GRIB2 vertical level codes to corresponding
1316! BUFR B table variables
1317TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
1318 level_var(20, 'B12101'), & ! isothermal (K)
1319 level_var(100, 'B10004'), & ! isobaric (Pa)
1320 level_var(102, 'B10007'), & ! height over sea level (m)
1321 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
1322 level_var(107, 'B12192'), & ! isentropical (K)
1323 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
1324 level_var(161, 'B22195') /) ! depth below sea surface
1325
1326PRIVATE level_var, level_var_converter
1327
1328CONTAINS
1329
1335FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1336INTEGER,INTENT(IN),OPTIONAL :: level1
1337INTEGER,INTENT(IN),OPTIONAL :: l1
1338INTEGER,INTENT(IN),OPTIONAL :: level2
1339INTEGER,INTENT(IN),OPTIONAL :: l2
1340
1341TYPE(vol7d_level) :: this
1342
1344
1345END FUNCTION vol7d_level_new
1346
1347
1351SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1352TYPE(vol7d_level),INTENT(INOUT) :: this
1353INTEGER,INTENT(IN),OPTIONAL :: level1
1354INTEGER,INTENT(IN),OPTIONAL :: l1
1355INTEGER,INTENT(IN),OPTIONAL :: level2
1356INTEGER,INTENT(IN),OPTIONAL :: l2
1357
1358this%level1 = imiss
1359this%l1 = imiss
1360this%level2 = imiss
1361this%l2 = imiss
1362
1363IF (PRESENT(level1)) THEN
1364 this%level1 = level1
1365ELSE
1366 RETURN
1367END IF
1368
1369IF (PRESENT(l1)) this%l1 = l1
1370
1371IF (PRESENT(level2)) THEN
1372 this%level2 = level2
1373ELSE
1374 RETURN
1375END IF
1376
1377IF (PRESENT(l2)) this%l2 = l2
1378
1379END SUBROUTINE vol7d_level_init
1380
1381
1383SUBROUTINE vol7d_level_delete(this)
1384TYPE(vol7d_level),INTENT(INOUT) :: this
1385
1386this%level1 = imiss
1387this%l1 = imiss
1388this%level2 = imiss
1389this%l2 = imiss
1390
1391END SUBROUTINE vol7d_level_delete
1392
1393
1394SUBROUTINE display_level(this)
1395TYPE(vol7d_level),INTENT(in) :: this
1396
1397print*,trim(to_char(this))
1398
1399END SUBROUTINE display_level
1400
1401
1402FUNCTION to_char_level(this)
1403#ifdef HAVE_DBALLE
1404USE dballef
1405#endif
1406TYPE(vol7d_level),INTENT(in) :: this
1407CHARACTER(len=255) :: to_char_level
1408
1409#ifdef HAVE_DBALLE
1410INTEGER :: handle, ier
1411
1412handle = 0
1413ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1414ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1415ier = idba_fatto(handle)
1416
1417to_char_level="LEVEL: "//to_char_level
1418
1419#else
1420
1421to_char_level="LEVEL: "//&
1424
1425#endif
1426
1427END FUNCTION to_char_level
1428
1429
1430ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1431TYPE(vol7d_level),INTENT(IN) :: this, that
1432LOGICAL :: res
1433
1434res = &
1435 this%level1 == that%level1 .AND. &
1436 this%level2 == that%level2 .AND. &
1437 this%l1 == that%l1 .AND. this%l2 == that%l2
1438
1439END FUNCTION vol7d_level_eq
1440
1441
1442ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1443TYPE(vol7d_level),INTENT(IN) :: this, that
1444LOGICAL :: res
1445
1446res = .NOT.(this == that)
1447
1448END FUNCTION vol7d_level_ne
1449
1450
1451ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1452TYPE(vol7d_level),INTENT(IN) :: this, that
1453LOGICAL :: res
1454
1459 res = .true.
1460ELSE
1461 res = .false.
1462ENDIF
1463
1464END FUNCTION vol7d_level_almost_eq
1465
1466
1467ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1468TYPE(vol7d_level),INTENT(IN) :: this, that
1469LOGICAL :: res
1470
1471IF (&
1472 this%level1 > that%level1 .OR. &
1473 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1474 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1475 (&
1476 this%level2 > that%level2 .OR. &
1477 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1478 ))) THEN
1479 res = .true.
1480ELSE
1481 res = .false.
1482ENDIF
1483
1484END FUNCTION vol7d_level_gt
1485
1486
1487ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1488TYPE(vol7d_level),INTENT(IN) :: this, that
1489LOGICAL :: res
1490
1491IF (&
1492 this%level1 < that%level1 .OR. &
1493 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1494 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1495 (&
1496 this%level2 < that%level2 .OR. &
1497 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1498 ))) THEN
1499 res = .true.
1500ELSE
1501 res = .false.
1502ENDIF
1503
1504END FUNCTION vol7d_level_lt
1505
1506
1507ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1508TYPE(vol7d_level),INTENT(IN) :: this, that
1509LOGICAL :: res
1510
1511IF (this == that) THEN
1512 res = .true.
1513ELSE IF (this > that) THEN
1514 res = .true.
1515ELSE
1516 res = .false.
1517ENDIF
1518
1519END FUNCTION vol7d_level_ge
1520
1521
1522ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1523TYPE(vol7d_level),INTENT(IN) :: this, that
1524LOGICAL :: res
1525
1526IF (this == that) THEN
1527 res = .true.
1528ELSE IF (this < that) THEN
1529 res = .true.
1530ELSE
1531 res = .false.
1532ENDIF
1533
1534END FUNCTION vol7d_level_le
1535
1536
1537ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1538TYPE(vol7d_level),INTENT(IN) :: this
1539LOGICAL :: c_e
1540c_e = this /= vol7d_level_miss
1541END FUNCTION vol7d_level_c_e
1542
1543
1544#include "array_utilities_inc.F90"
1545
1546
1547FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1548TYPE(vol7d_level),INTENT(in) :: level
1549CHARACTER(len=10) :: btable
1550
1551btable = vol7d_level_to_var_int(level%level1)
1552
1553END FUNCTION vol7d_level_to_var_lev
1554
1555FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1556INTEGER,INTENT(in) :: level
1557CHARACTER(len=10) :: btable
1558
1559INTEGER :: i
1560
1561DO i = 1, SIZE(level_var_converter)
1562 IF (level_var_converter(i)%level == level) THEN
1563 btable = level_var_converter(i)%btable
1564 RETURN
1565 ENDIF
1566ENDDO
1567
1568btable = cmiss
1569
1570END FUNCTION vol7d_level_to_var_int
1571
1572
1573FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1574TYPE(vol7d_level),INTENT(in) :: level
1575REAL :: factor
1576
1577factor = vol7d_level_to_var_factor_int(level%level1)
1578
1579END FUNCTION vol7d_level_to_var_factor_lev
1580
1581FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1582INTEGER,INTENT(in) :: level
1583REAL :: factor
1584
1585factor = 1.
1586IF (any(level == height_level)) THEN
1587 factor = 1.e-3
1588ELSE IF (any(level == thermo_level)) THEN
1589 factor = 1.e-1
1590ELSE IF (any(level == sigma_level)) THEN
1591 factor = 1.e-4
1592ENDIF
1593
1594END FUNCTION vol7d_level_to_var_factor_int
1595
1596
1597FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1598TYPE(vol7d_level),INTENT(in) :: level
1599REAL :: log10
1600
1601log10 = vol7d_level_to_var_log10_int(level%level1)
1602
1603END FUNCTION vol7d_level_to_var_log10_lev
1604
1605FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1606INTEGER,INTENT(in) :: level
1607REAL :: log10
1608
1609log10 = 0.
1610IF (any(level == height_level)) THEN
1611 log10 = -3.
1612ELSE IF (any(level == thermo_level)) THEN
1613 log10 = -1.
1614ELSE IF (any(level == sigma_level)) THEN
1615 log10 = -4.
1616ENDIF
1617
1618END FUNCTION vol7d_level_to_var_log10_int
1619
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 |