libsim Versione 7.2.1

◆ map_inv_distinct_level()

integer function, dimension(dim) map_inv_distinct_level ( type(vol7d_level), dimension(:), intent(in)  vect,
integer, intent(in)  dim,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back 
)

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
1080MODULE vol7d_level_class
1081USE kinds
1084IMPLICIT NONE
1085
1090TYPE vol7d_level
1091 INTEGER :: level1
1092 INTEGER :: l1
1093 INTEGER :: level2
1094 INTEGER :: l2
1095END TYPE vol7d_level
1096
1098TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
1099
1103INTERFACE init
1104 MODULE PROCEDURE vol7d_level_init
1105END INTERFACE
1106
1109INTERFACE delete
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
1173INTERFACE c_e
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
1183INTERFACE display
1184 MODULE PROCEDURE display_level
1185END INTERFACE
1186
1188INTERFACE to_char
1189 MODULE PROCEDURE to_char_level
1190END INTERFACE
1191
1193INTERFACE vol7d_level_to_var
1194 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1195END INTERFACE vol7d_level_to_var
1196
1199 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1200END INTERFACE vol7d_level_to_var_factor
1201
1204 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1205END INTERFACE vol7d_level_to_var_log10
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
1251CALL init(this, level1, l1, level2, l2)
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: "//&
1330 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1331 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
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
1363IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1364 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1365 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1366 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
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
1528END 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.