libsim Versione 7.1.11

◆ 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 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
1172MODULE vol7d_level_class
1173USE kinds
1176IMPLICIT NONE
1177
1182TYPE vol7d_level
1183 INTEGER :: level1
1184 INTEGER :: l1
1185 INTEGER :: level2
1186 INTEGER :: l2
1187END TYPE vol7d_level
1188
1190TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
1191
1195INTERFACE init
1196 MODULE PROCEDURE vol7d_level_init
1197END INTERFACE
1198
1201INTERFACE delete
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
1265INTERFACE c_e
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
1275INTERFACE display
1276 MODULE PROCEDURE display_level
1277END INTERFACE
1278
1280INTERFACE to_char
1281 MODULE PROCEDURE to_char_level
1282END INTERFACE
1283
1285INTERFACE vol7d_level_to_var
1286 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1287END INTERFACE vol7d_level_to_var
1288
1291 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1292END INTERFACE vol7d_level_to_var_factor
1293
1296 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1297END INTERFACE vol7d_level_to_var_log10
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
1343CALL init(this, level1, l1, level2, l2)
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: "//&
1422 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1423 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
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
1455IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1456 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1457 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1458 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
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
1620END 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:251
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.