libsim Versione 7.1.11
|
◆ map_inv_distinct_level()
map inv distinct Definizione alla linea 1060 del file vol7d_level_class.F90. 1062! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1063! authors:
1064! Davide Cesari <dcesari@arpa.emr.it>
1065! Paolo Patruno <ppatruno@arpa.emr.it>
1066
1067! This program is free software; you can redistribute it and/or
1068! modify it under the terms of the GNU General Public License as
1069! published by the Free Software Foundation; either version 2 of
1070! the License, or (at your option) any later version.
1071
1072! This program is distributed in the hope that it will be useful,
1073! but WITHOUT ANY WARRANTY; without even the implied warranty of
1074! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1075! GNU General Public License for more details.
1076
1077! You should have received a copy of the GNU General Public License
1078! along with this program. If not, see <http://www.gnu.org/licenses/>.
1079#include "config.h"
1080
1090IMPLICIT NONE
1091
1097 INTEGER :: level1
1098 INTEGER :: l1
1099 INTEGER :: level2
1100 INTEGER :: l2
1102
1105
1110 MODULE PROCEDURE vol7d_level_init
1111END INTERFACE
1112
1116 MODULE PROCEDURE vol7d_level_delete
1117END INTERFACE
1118
1122INTERFACE OPERATOR (==)
1123 MODULE PROCEDURE vol7d_level_eq
1124END INTERFACE
1125
1129INTERFACE OPERATOR (/=)
1130 MODULE PROCEDURE vol7d_level_ne
1131END INTERFACE
1132
1138INTERFACE OPERATOR (>)
1139 MODULE PROCEDURE vol7d_level_gt
1140END INTERFACE
1141
1147INTERFACE OPERATOR (<)
1148 MODULE PROCEDURE vol7d_level_lt
1149END INTERFACE
1150
1156INTERFACE OPERATOR (>=)
1157 MODULE PROCEDURE vol7d_level_ge
1158END INTERFACE
1159
1165INTERFACE OPERATOR (<=)
1166 MODULE PROCEDURE vol7d_level_le
1167END INTERFACE
1168
1172INTERFACE OPERATOR (.almosteq.)
1173 MODULE PROCEDURE vol7d_level_almost_eq
1174END INTERFACE
1175
1176
1177! da documentare in inglese assieme al resto
1180 MODULE PROCEDURE vol7d_level_c_e
1181END INTERFACE
1182
1183#define VOL7D_POLY_TYPE TYPE(vol7d_level)
1184#define VOL7D_POLY_TYPES _level
1185#define ENABLE_SORT
1186#include "array_utilities_pre.F90"
1187
1190 MODULE PROCEDURE display_level
1191END INTERFACE
1192
1195 MODULE PROCEDURE to_char_level
1196END INTERFACE
1197
1200 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1202
1205 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1207
1210 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1212
1213type(vol7d_level) :: almost_equal_levels(3)=(/&
1214 vol7d_level( 1,imiss,imiss,imiss),&
1215 vol7d_level(103,imiss,imiss,imiss),&
1216 vol7d_level(106,imiss,imiss,imiss)/)
1217
1218! levels requiring conversion from internal to physical representation
1219INTEGER, PARAMETER :: &
1220 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
1221 thermo_level(3) = (/20,107,235/), & ! 10**-1
1222 sigma_level(2) = (/104,111/) ! 10**-4
1223
1224TYPE level_var
1225 INTEGER :: level
1226 CHARACTER(len=10) :: btable
1227END TYPE level_var
1228
1229! Conversion table from GRIB2 vertical level codes to corresponding
1230! BUFR B table variables
1231TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
1232 level_var(20, 'B12101'), & ! isothermal (K)
1233 level_var(100, 'B10004'), & ! isobaric (Pa)
1234 level_var(102, 'B10007'), & ! height over sea level (m)
1235 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
1236 level_var(107, 'B12192'), & ! isentropical (K)
1237 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
1238 level_var(161, 'B22195') /) ! depth below sea surface
1239
1240PRIVATE level_var, level_var_converter
1241
1242CONTAINS
1243
1249FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1250INTEGER,INTENT(IN),OPTIONAL :: level1
1251INTEGER,INTENT(IN),OPTIONAL :: l1
1252INTEGER,INTENT(IN),OPTIONAL :: level2
1253INTEGER,INTENT(IN),OPTIONAL :: l2
1254
1255TYPE(vol7d_level) :: this
1256
1258
1259END FUNCTION vol7d_level_new
1260
1261
1265SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1266TYPE(vol7d_level),INTENT(INOUT) :: this
1267INTEGER,INTENT(IN),OPTIONAL :: level1
1268INTEGER,INTENT(IN),OPTIONAL :: l1
1269INTEGER,INTENT(IN),OPTIONAL :: level2
1270INTEGER,INTENT(IN),OPTIONAL :: l2
1271
1272this%level1 = imiss
1273this%l1 = imiss
1274this%level2 = imiss
1275this%l2 = imiss
1276
1277IF (PRESENT(level1)) THEN
1278 this%level1 = level1
1279ELSE
1280 RETURN
1281END IF
1282
1283IF (PRESENT(l1)) this%l1 = l1
1284
1285IF (PRESENT(level2)) THEN
1286 this%level2 = level2
1287ELSE
1288 RETURN
1289END IF
1290
1291IF (PRESENT(l2)) this%l2 = l2
1292
1293END SUBROUTINE vol7d_level_init
1294
1295
1297SUBROUTINE vol7d_level_delete(this)
1298TYPE(vol7d_level),INTENT(INOUT) :: this
1299
1300this%level1 = imiss
1301this%l1 = imiss
1302this%level2 = imiss
1303this%l2 = imiss
1304
1305END SUBROUTINE vol7d_level_delete
1306
1307
1308SUBROUTINE display_level(this)
1309TYPE(vol7d_level),INTENT(in) :: this
1310
1311print*,trim(to_char(this))
1312
1313END SUBROUTINE display_level
1314
1315
1316FUNCTION to_char_level(this)
1317#ifdef HAVE_DBALLE
1318USE dballef
1319#endif
1320TYPE(vol7d_level),INTENT(in) :: this
1321CHARACTER(len=255) :: to_char_level
1322
1323#ifdef HAVE_DBALLE
1324INTEGER :: handle, ier
1325
1326handle = 0
1327ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1328ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1329ier = idba_fatto(handle)
1330
1331to_char_level="LEVEL: "//to_char_level
1332
1333#else
1334
1335to_char_level="LEVEL: "//&
1338
1339#endif
1340
1341END FUNCTION to_char_level
1342
1343
1344ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1345TYPE(vol7d_level),INTENT(IN) :: this, that
1346LOGICAL :: res
1347
1348res = &
1349 this%level1 == that%level1 .AND. &
1350 this%level2 == that%level2 .AND. &
1351 this%l1 == that%l1 .AND. this%l2 == that%l2
1352
1353END FUNCTION vol7d_level_eq
1354
1355
1356ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1357TYPE(vol7d_level),INTENT(IN) :: this, that
1358LOGICAL :: res
1359
1360res = .NOT.(this == that)
1361
1362END FUNCTION vol7d_level_ne
1363
1364
1365ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1366TYPE(vol7d_level),INTENT(IN) :: this, that
1367LOGICAL :: res
1368
1373 res = .true.
1374ELSE
1375 res = .false.
1376ENDIF
1377
1378END FUNCTION vol7d_level_almost_eq
1379
1380
1381ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1382TYPE(vol7d_level),INTENT(IN) :: this, that
1383LOGICAL :: res
1384
1385IF (&
1386 this%level1 > that%level1 .OR. &
1387 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1388 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1389 (&
1390 this%level2 > that%level2 .OR. &
1391 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1392 ))) THEN
1393 res = .true.
1394ELSE
1395 res = .false.
1396ENDIF
1397
1398END FUNCTION vol7d_level_gt
1399
1400
1401ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1402TYPE(vol7d_level),INTENT(IN) :: this, that
1403LOGICAL :: res
1404
1405IF (&
1406 this%level1 < that%level1 .OR. &
1407 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1408 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1409 (&
1410 this%level2 < that%level2 .OR. &
1411 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1412 ))) THEN
1413 res = .true.
1414ELSE
1415 res = .false.
1416ENDIF
1417
1418END FUNCTION vol7d_level_lt
1419
1420
1421ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1422TYPE(vol7d_level),INTENT(IN) :: this, that
1423LOGICAL :: res
1424
1425IF (this == that) THEN
1426 res = .true.
1427ELSE IF (this > that) THEN
1428 res = .true.
1429ELSE
1430 res = .false.
1431ENDIF
1432
1433END FUNCTION vol7d_level_ge
1434
1435
1436ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1437TYPE(vol7d_level),INTENT(IN) :: this, that
1438LOGICAL :: res
1439
1440IF (this == that) THEN
1441 res = .true.
1442ELSE IF (this < that) THEN
1443 res = .true.
1444ELSE
1445 res = .false.
1446ENDIF
1447
1448END FUNCTION vol7d_level_le
1449
1450
1451ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1452TYPE(vol7d_level),INTENT(IN) :: this
1453LOGICAL :: c_e
1454c_e = this /= vol7d_level_miss
1455END FUNCTION vol7d_level_c_e
1456
1457
1458#include "array_utilities_inc.F90"
1459
1460
1461FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1462TYPE(vol7d_level),INTENT(in) :: level
1463CHARACTER(len=10) :: btable
1464
1465btable = vol7d_level_to_var_int(level%level1)
1466
1467END FUNCTION vol7d_level_to_var_lev
1468
1469FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1470INTEGER,INTENT(in) :: level
1471CHARACTER(len=10) :: btable
1472
1473INTEGER :: i
1474
1475DO i = 1, SIZE(level_var_converter)
1476 IF (level_var_converter(i)%level == level) THEN
1477 btable = level_var_converter(i)%btable
1478 RETURN
1479 ENDIF
1480ENDDO
1481
1482btable = cmiss
1483
1484END FUNCTION vol7d_level_to_var_int
1485
1486
1487FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1488TYPE(vol7d_level),INTENT(in) :: level
1489REAL :: factor
1490
1491factor = vol7d_level_to_var_factor_int(level%level1)
1492
1493END FUNCTION vol7d_level_to_var_factor_lev
1494
1495FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1496INTEGER,INTENT(in) :: level
1497REAL :: factor
1498
1499factor = 1.
1500IF (any(level == height_level)) THEN
1501 factor = 1.e-3
1502ELSE IF (any(level == thermo_level)) THEN
1503 factor = 1.e-1
1504ELSE IF (any(level == sigma_level)) THEN
1505 factor = 1.e-4
1506ENDIF
1507
1508END FUNCTION vol7d_level_to_var_factor_int
1509
1510
1511FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1512TYPE(vol7d_level),INTENT(in) :: level
1513REAL :: log10
1514
1515log10 = vol7d_level_to_var_log10_int(level%level1)
1516
1517END FUNCTION vol7d_level_to_var_log10_lev
1518
1519FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1520INTEGER,INTENT(in) :: level
1521REAL :: log10
1522
1523log10 = 0.
1524IF (any(level == height_level)) THEN
1525 log10 = -3.
1526ELSE IF (any(level == thermo_level)) THEN
1527 log10 = -1.
1528ELSE IF (any(level == sigma_level)) THEN
1529 log10 = -4.
1530ENDIF
1531
1532END FUNCTION vol7d_level_to_var_log10_int
1533
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 |