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