libsim Versione 7.2.4

◆ index_level()

integer function index_level ( type(vol7d_level), dimension(:), intent(in) vect,
type(vol7d_level), intent(in) search,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back,
integer, intent(in), optional cache )

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
1166MODULE vol7d_level_class
1167USE kinds
1170IMPLICIT NONE
1171
1176TYPE vol7d_level
1177 INTEGER :: level1
1178 INTEGER :: l1
1179 INTEGER :: level2
1180 INTEGER :: l2
1181END TYPE vol7d_level
1182
1184TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
1185
1189INTERFACE init
1190 MODULE PROCEDURE vol7d_level_init
1191END INTERFACE
1192
1195INTERFACE delete
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
1259INTERFACE c_e
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
1269INTERFACE display
1270 MODULE PROCEDURE display_level
1271END INTERFACE
1272
1274INTERFACE to_char
1275 MODULE PROCEDURE to_char_level
1276END INTERFACE
1277
1279INTERFACE vol7d_level_to_var
1280 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1281END INTERFACE vol7d_level_to_var
1282
1285 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1286END INTERFACE vol7d_level_to_var_factor
1287
1290 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1291END INTERFACE vol7d_level_to_var_log10
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
1337CALL init(this, level1, l1, level2, l2)
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: "//&
1416 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1417 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
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
1449IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1450 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1451 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1452 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
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
1614END 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.