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