libsim Versione 7.2.6
|
◆ vargrib2varbufr_convert()
Convert a volgrid6d_var object into a physically equivalent vol7d_var object. This method returns a physically based, bufr-like representation of type vol7d_var of the grib-like input physical variable vargrib. The method optionally returns a conv_func object which can successively be used to convert the numerical values of the field associated to vargrib to the corresponding fields in the bufr-like representation. If the conversion is not successful, the output variable is set to vol7d_var_miss and the conversion function to conv_func_miss.
Definizione alla linea 1124 del file volgrid6d_var_class.F90. 1125! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1126! authors:
1127! Davide Cesari <dcesari@arpa.emr.it>
1128! Paolo Patruno <ppatruno@arpa.emr.it>
1129
1130! This program is free software; you can redistribute it and/or
1131! modify it under the terms of the GNU General Public License as
1132! published by the Free Software Foundation; either version 2 of
1133! the License, or (at your option) any later version.
1134
1135! This program is distributed in the hope that it will be useful,
1136! but WITHOUT ANY WARRANTY; without even the implied warranty of
1137! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1138! GNU General Public License for more details.
1139
1140! You should have received a copy of the GNU General Public License
1141! along with this program. If not, see <http://www.gnu.org/licenses/>.
1142#include "config.h"
1143
1144!> Class for managing physical variables in a grib 1/2 fashion.
1145!! This module defines a class which can represent Earth-science
1146!! related physical variables, following the classification scheme
1147!! adopted by WMO for grib1 and grib2 parameter definition. It also
1148!! defines some methods for mapping \a volgrid6d_var variables and
1149!! converting the corresponding fields to a matching \a vol7d_var
1150!! object defined in \a vol7d_var_class module, which, unlike the
1151!! variables defined here, defines univocally a physical quantity.
1152!!
1153!! \ingroup volgrid6d
1161
1162IMPLICIT NONE
1163
1164!> Definition of a physical variable in grib coding style.
1165!! \a volgrid6d_var members are public, thus they can be freely
1166!! altered, but it is advisable to set them through the
1167!! volgrid6d_var_class::init constructor.
1169 integer :: centre !< centre
1170 integer :: category !< grib2: category / grib1: grib table version number
1171 integer :: number !< parameter number
1172 integer :: discipline !< grib2: discipline / grib1: 255
1173 CHARACTER(len=65) :: description !< optional textual description of the variable
1174 CHARACTER(len=24) :: unit !< optional textual description of the variable's unit
1176
1177TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1179
1180TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1183 /)
1184
1185TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1190/)
1191!/), (/2,2/)) ! bug in gfortran
1192
1193!> Class defining a real conversion function between units. It is
1194!! used to numerically convert a value expressed as a \a volgrid6d_var
1195!! variable in a value expressed as a \a vol7d_var variable and
1196!! vice-versa. At the moment only a linear conversion is
1197!! supported. Objects of this class are returned only by the \a
1198!! vargrib2varbufr \a varbufr2vargrib, and \a convert methods and are
1199!! used in the \a convert and \a compute methods defined in this
1200!! MODULE.
1202 PRIVATE
1203 REAL :: a, b
1205
1208
1209TYPE vg6d_v7d_var_conv
1210 TYPE(volgrid6d_var) :: vg6d_var
1211 TYPE(vol7d_var) :: v7d_var
1212 TYPE(conv_func) :: c_func
1213! aggiungere informazioni ad es. su rotazione del vento
1214END TYPE vg6d_v7d_var_conv
1215
1216TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1217 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1218
1219TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1220
1221!> Initialize a \a volgrid6d_var object with the optional arguments provided.
1222!! If an argument is not provided, the corresponding object member and
1223!! those depending on it will be set to missing. For grib1-style
1224!! variables, the \a discipline argument must be omitted, it will be
1225!! set to 255 (grib missing value).
1226!!
1227!! \param this TYPE(volgrid6d_var),INTENT(INOUT) object to be initialized
1228!! \param centre INTEGER,INTENT(in),OPTIONAL centre
1229!! \param category INTEGER,INTENT(in),OPTIONAL grib2: category / grib1: grib table version number
1230!! \param number INTEGER,INTENT(in),OPTIONAL parameter number
1231!! \param discipline INTEGER,INTENT(in),OPTIONAL grib2: discipline / grib1: 255
1232!! \param description CHARACTER(len=*),INTENT(in),OPTIONAL optional textual description of the variable
1233!! \param unit CHARACTER(len=*),INTENT(in),OPTIONAL optional textual description of the variable's unit
1235 MODULE PROCEDURE volgrid6d_var_init
1236END INTERFACE
1237
1238!> Destructor for the corresponding object, it assigns it to a missing value.
1239!! \param this TYPE(volgrid6d_var) object to be destroyed
1241 MODULE PROCEDURE volgrid6d_var_delete
1242END INTERFACE
1243
1244INTERFACE c_e
1245 MODULE PROCEDURE volgrid6d_var_c_e
1246END INTERFACE
1247
1248
1249!> Logical equality operators for objects of the classes \a
1250!! volgrid6d_var and \a conv_func.
1251!! They are all defined as \c ELEMENTAL thus work also on arrays of
1252!! any shape.
1253INTERFACE OPERATOR (==)
1254 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1255END INTERFACE
1256
1257!> Logical inequality operators for objects of the classes \a
1258!! volgrid6d_var and \a conv_func.
1259!! They are all defined as \c ELEMENTAL thus work also on arrays of
1260!! any shape.
1261INTERFACE OPERATOR (/=)
1262 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1263END INTERFACE
1264
1265#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1266#define VOL7D_POLY_TYPES _var6d
1267#include "array_utilities_pre.F90"
1268
1269!> Display on the screen a brief content of object
1271 MODULE PROCEDURE display_volgrid6d_var
1272END INTERFACE
1273
1274!> Compose two conversions into a single one.
1275!! Unlike scalar multiplication (and like matrix multiplication) here
1276!! a*b /= b*a. By convention, the second factor is applied first in
1277!! the result.
1278INTERFACE OPERATOR (*)
1279 MODULE PROCEDURE conv_func_mult
1280END INTERFACE OPERATOR (*)
1281
1282!> Apply the conversion function \a this to \a values.
1283!! function version
1285 MODULE PROCEDURE conv_func_compute
1286END INTERFACE
1287
1288!> Apply the conversion function \a this to \a values.
1289!! subroutine version
1291 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1292 conv_func_convert
1293END INTERFACE
1294
1295PRIVATE
1297 c_e, volgrid6d_var_normalize, &
1298 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1299 count_distinct, pack_distinct, count_and_pack_distinct, &
1300 map_distinct, map_inv_distinct, &
1302 vargrib2varbufr, varbufr2vargrib, &
1304 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1305
1306
1307CONTAINS
1308
1309
1310ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1311 discipline, description, unit) RESULT(this)
1312integer,INTENT(in),OPTIONAL :: centre !< centre
1313integer,INTENT(in),OPTIONAL :: category !< grib2: category / grib1: grib table version number
1314integer,INTENT(in),OPTIONAL :: number !< parameter number
1315integer,INTENT(in),OPTIONAL :: discipline !< grib2: discipline
1316CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< textual description of the variable
1317CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< textual description of the variable's unit
1318
1319TYPE(volgrid6d_var) :: this !< object to be initialised
1320
1322
1323END FUNCTION volgrid6d_var_new
1324
1325
1326! documented in the interface
1327ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1328TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1329INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1330INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1331INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1332INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1333CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1334CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1335
1336IF (PRESENT(centre)) THEN
1337 this%centre = centre
1338ELSE
1339 this%centre = imiss
1340 this%category = imiss
1341 this%number = imiss
1342 this%discipline = imiss
1343 RETURN
1344ENDIF
1345
1346IF (PRESENT(category)) THEN
1347 this%category = category
1348ELSE
1349 this%category = imiss
1350 this%number = imiss
1351 this%discipline = imiss
1352 RETURN
1353ENDIF
1354
1355
1356IF (PRESENT(number)) THEN
1357 this%number = number
1358ELSE
1359 this%number = imiss
1360 this%discipline = imiss
1361 RETURN
1362ENDIF
1363
1364! se sono arrivato fino a qui ho impostato centre, category e number
1365!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1366
1367IF (PRESENT(discipline)) THEN
1368 this%discipline = discipline
1369ELSE
1370 this%discipline = 255
1371ENDIF
1372
1373IF (PRESENT(description)) THEN
1374 this%description = description
1375ELSE
1376 this%description = cmiss
1377ENDIF
1378
1379IF (PRESENT(unit)) THEN
1380 this%unit = unit
1381ELSE
1382 this%unit = cmiss
1383ENDIF
1384
1385
1386
1387END SUBROUTINE volgrid6d_var_init
1388
1389
1390! documented in the interface
1391SUBROUTINE volgrid6d_var_delete(this)
1392TYPE(volgrid6d_var),INTENT(INOUT) :: this
1393
1394this%centre = imiss
1395this%category = imiss
1396this%number = imiss
1397this%discipline = imiss
1398this%description = cmiss
1399this%unit = cmiss
1400
1401END SUBROUTINE volgrid6d_var_delete
1402
1403
1404ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1405TYPE(volgrid6d_var),INTENT(IN) :: this
1406LOGICAL :: c_e
1407c_e = this /= volgrid6d_var_miss
1408END FUNCTION volgrid6d_var_c_e
1409
1410
1411ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1412TYPE(volgrid6d_var),INTENT(IN) :: this, that
1413LOGICAL :: res
1414
1415IF (this%discipline == that%discipline) THEN
1416
1417 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1418 res = ((this%category == that%category) .OR. &
1419 (this%category >= 1 .AND. this%category <=3 .AND. &
1420 that%category >= 1 .AND. that%category <=3)) .AND. &
1421 this%number == that%number
1422
1423 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1424 (this%number >= 128 .AND. this%number <= 254)) THEN
1425 res = res .AND. this%centre == that%centre ! local definition, centre matters
1426 ENDIF
1427
1428 ELSE ! grib2
1429 res = this%category == that%category .AND. &
1430 this%number == that%number
1431
1432 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1433 (this%category >= 192 .AND. this%category <= 254) .OR. &
1434 (this%number >= 192 .AND. this%number <= 254)) THEN
1435 res = res .AND. this%centre == that%centre ! local definition, centre matters
1436 ENDIF
1437 ENDIF
1438
1439ELSE ! different edition or different discipline
1440 res = .false.
1441ENDIF
1442
1443END FUNCTION volgrid6d_var_eq
1444
1445
1446ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1447TYPE(volgrid6d_var),INTENT(IN) :: this, that
1448LOGICAL :: res
1449
1450res = .NOT.(this == that)
1451
1452END FUNCTION volgrid6d_var_ne
1453
1454
1455#include "array_utilities_inc.F90"
1456
1457
1458!> Display on the screen a brief content of \a volgrid6d_var object.
1459SUBROUTINE display_volgrid6d_var(this)
1460TYPE(volgrid6d_var),INTENT(in) :: this !< volgrid6d_var object to display
1461
1462print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1463
1464END SUBROUTINE display_volgrid6d_var
1465
1466
1467!> Convert a \a volgrid6d_var array object into a physically equivalent
1468!! \a vol7d_var array object. This method converts a grib-like array
1469!! of physical variables \a vargrib, to an array of unique, physically
1470!! based, bufr-like variables \a varbufr. The output array must have
1471!! enough room for the converted variables. The method additionally
1472!! allocates a \a conv_func array object of the same size, which can
1473!! successively be used to convert the numerical values of the fields
1474!! associated to \a vargrib to the corresponding fields in the \a
1475!! bufr-like representation. \a c_func will have to be deallocated by
1476!! the calling procedure. If a conversion is not successful, the
1477!! corresponding output variable is set to \a vol7d_var_miss and the
1478!! conversion function to \a conv_func_miss.
1479SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1480TYPE(volgrid6d_var),INTENT(in) :: vargrib(:) !< array of input grib-like variables
1481TYPE(vol7d_var),INTENT(out) :: varbufr(:) !< array of output bufr-like variables
1482TYPE(conv_func),POINTER :: c_func(:) !< pointer to an array of the corresponding \a conv_func objects, allocated in the method
1483
1484INTEGER :: i, n, stallo
1485
1486n = min(SIZE(varbufr), SIZE(vargrib))
1487ALLOCATE(c_func(n),stat=stallo)
1488IF (stallo /= 0) THEN
1489 call l4f_log(l4f_fatal,"allocating memory")
1490 call raise_fatal_error()
1491ENDIF
1492
1493DO i = 1, n
1494 varbufr(i) = convert(vargrib(i), c_func(i))
1495ENDDO
1496
1497END SUBROUTINE vargrib2varbufr
1498
1499
1500!> Convert a \a volgrid6d_var object into a physically equivalent
1501!! \a vol7d_var object. This method returns a physically based,
1502!! bufr-like representation of type \a vol7d_var of the grib-like
1503!! input physical variable \a vargrib. The method optionally returns
1504!! a \a conv_func object which can successively be used to convert the
1505!! numerical values of the field associated to \a vargrib to the
1506!! corresponding fields in the bufr-like representation. If the
1507!! conversion is not successful, the output variable is
1508!! set to \a vol7d_var_miss and the conversion function to \a
1509!! conv_func_miss.
1510FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1511TYPE(volgrid6d_var),INTENT(in) :: vargrib !< input grib-like variable
1512TYPE(conv_func),INTENT(out),OPTIONAL :: c_func !< corresponding \a conv_func object
1513TYPE(vol7d_var) :: convert
1514
1515INTEGER :: i
1516
1517IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1518
1519DO i = 1, SIZE(conv_fwd)
1520 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1521 convert = conv_fwd(i)%v7d_var
1522 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1523 RETURN
1524 ENDIF
1525ENDDO
1526! not found
1527convert = vol7d_var_miss
1528IF (PRESENT(c_func)) c_func = conv_func_miss
1529
1530! set hint for backwards conversion
1531convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1532 vargrib%discipline/)
1533
1534CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1535 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1536 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1537 ' not found in table')
1538
1539END FUNCTION vargrib2varbufr_convert
1540
1541
1542!> Convert a \a vol7d_var array object into a physically equivalent
1543!! \a volgrid6d_var array object. This method converts a bufr-like
1544!! array of physical variables \a vargrib, to an array of grib-like
1545!! variables \a varbufr. Unlike the opposite method \a
1546!! vargrib2varbufr, in this case the conversion is not uniqe and at
1547!! the moment the first matching grib-like variable is chosen, without
1548!! any control over the choice process. The output array must have
1549!! enough room for the converted variables. The method additionally
1550!! allocates a \a conv_func array object of the same size, which can
1551!! successively be used to convert the numerical values of the fields
1552!! associated to \a varbufr to the corresponding fields in the \a
1553!! grib-like representation. \a c_func will have to be deallocated by
1554!! the calling procedure. If a conversion is not successful, the
1555!! corresponding output variable is set to \a volgrid6d_var_miss and
1556!! the conversion function to \a conv_func_miss.
1557SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1558TYPE(vol7d_var),INTENT(in) :: varbufr(:) !< array of input bufr-like variables
1559TYPE(volgrid6d_var),INTENT(out) :: vargrib(:) !< array of output grib-like variables
1560TYPE(conv_func),POINTER :: c_func(:) !< pointer to an array of the corresponding \a conv_func objects, allocated in the method
1561TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template !< a template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion
1562
1563INTEGER :: i, n, stallo
1564
1565n = min(SIZE(varbufr), SIZE(vargrib))
1566ALLOCATE(c_func(n),stat=stallo)
1567IF (stallo /= 0) THEN
1568 CALL l4f_log(l4f_fatal,"allocating memory")
1569 CALL raise_fatal_error()
1570ENDIF
1571
1572DO i = 1, n
1573 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1574ENDDO
1575
1576END SUBROUTINE varbufr2vargrib
1577
1578
1579!> Convert a \a vol7d_var object into a physically equivalent
1580!! \a volgrid6d_var object. This method returns a grib-like
1581!! representation of type \a volgrid6d_var of the bufr-like input
1582!! physical variable \a varbufr. Unlike the opposite \a convert
1583!! method, in this case the conversion is not uniqe and at the moment
1584!! the first matching grib-like variable is chosen, without any
1585!! control over the choice process. The method optionally returns a
1586!! \a conv_func object which can successively be used to convert the
1587!! numerical values of the field associated to \a varbufr to the
1588!! corresponding fields in the grib-like representation. If the
1589!! conversion is not successful, the output variable is set to \a
1590!! volgrid6d_var_miss and the conversion function to \a
1591!! conv_func_miss.
1592FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1593TYPE(vol7d_var),INTENT(in) :: varbufr !< input bufr-like variable
1594TYPE(conv_func),INTENT(out),OPTIONAL :: c_func !< corresponding \a conv_func object
1595TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template !< a template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion
1596TYPE(volgrid6d_var) :: convert
1597
1598INTEGER :: i
1599#ifdef HAVE_LIBGRIBAPI
1600INTEGER :: gaid, editionnumber, category, centre
1601#endif
1602
1603IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1604
1605#ifdef HAVE_LIBGRIBAPI
1606editionnumber=255; category=255; centre=255
1607#endif
1608IF (PRESENT(grid_id_template)) THEN
1609#ifdef HAVE_LIBGRIBAPI
1610 gaid = grid_id_get_gaid(grid_id_template)
1611 IF (c_e(gaid)) THEN
1612 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1613 IF (editionnumber == 1) THEN
1614 CALL grib_get(gaid,'gribTablesVersionNo',category)
1615 ENDIF
1616 CALL grib_get(gaid,'centre',centre)
1617 ENDIF
1618#endif
1619ENDIF
1620
1621DO i = 1, SIZE(conv_bwd)
1622 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1623#ifdef HAVE_LIBGRIBAPI
1624 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1625 IF (editionnumber == 1) THEN
1626 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1627 ELSE IF (editionnumber == 2) THEN
1628 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1629 ENDIF
1630 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1631 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1632 ENDIF
1633#endif
1634 convert = conv_bwd(i)%vg6d_var
1635 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1636 RETURN
1637 ENDIF
1638ENDDO
1639! not found
1640convert = volgrid6d_var_miss
1641IF (PRESENT(c_func)) c_func = conv_func_miss
1642
1643! if hint available use it as a fallback
1644IF (any(varbufr%gribhint /= imiss)) THEN
1645 convert%centre = varbufr%gribhint(1)
1646 convert%category = varbufr%gribhint(2)
1647 convert%number = varbufr%gribhint(3)
1648 convert%discipline = varbufr%gribhint(4)
1649ENDIF
1650
1651CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1652 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1653 ' not found in table')
1654
1655END FUNCTION varbufr2vargrib_convert
1656
1657
1658!> Normalize a variable definition converting it to the
1659!! format (grib edition) specified in the (grib) template provided.
1660!! This allows a basic grib1 <-> grib2 conversion provided that
1661!! entries for both grib editions of the related variable are present
1662!! in the static file \a vargrib2ufr.csv. If the \a c_func variable
1663!! returned is not missing (i.e. /= conv_func_miss) the field value
1664!! should be converted as well using the conv_func::compute method .
1665SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1666TYPE(volgrid6d_var),INTENT(inout) :: this !< variable to normalize
1667TYPE(conv_func),INTENT(out) :: c_func !< \a conv_func object to convert data
1668TYPE(grid_id),INTENT(in) :: grid_id_template !< a template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion
1669
1670LOGICAL :: eqed, eqcentre
1671INTEGER :: gaid, editionnumber, centre
1672TYPE(volgrid6d_var) :: tmpgrib
1673TYPE(vol7d_var) :: tmpbufr
1674TYPE(conv_func) tmpc_func1, tmpc_func2
1675
1676eqed = .true.
1677eqcentre = .true.
1678c_func = conv_func_miss
1679
1680#ifdef HAVE_LIBGRIBAPI
1681gaid = grid_id_get_gaid(grid_id_template)
1682IF (c_e(gaid)) THEN
1683 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1684 CALL grib_get(gaid, 'centre', centre)
1685 eqed = editionnumber == 1 .EQV. this%discipline == 255
1686 eqcentre = centre == this%centre
1687ENDIF
1688#endif
1689
1690IF (eqed .AND. eqcentre) RETURN ! nothing to do
1691
1692tmpbufr = convert(this, tmpc_func1)
1693tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1694
1695IF (tmpgrib /= volgrid6d_var_miss) THEN
1696! conversion back and forth successful, set also conversion function
1697 this = tmpgrib
1698 c_func = tmpc_func1 * tmpc_func2
1699! set to missing in common case to avoid useless computation
1700 IF (c_func == conv_func_identity) c_func = conv_func_miss
1701ELSE IF (.NOT.eqed) THEN
1702! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1703 this = tmpgrib
1704ENDIF
1705
1706END SUBROUTINE volgrid6d_var_normalize
1707
1708
1709! Private subroutine for reading forward and backward conversion tables
1710! todo: better error handling
1711SUBROUTINE vg6d_v7d_var_conv_setup()
1712INTEGER :: un, i, n, stallo
1713
1714! forward, grib to bufr
1715un = open_package_file('vargrib2bufr.csv', filetype_data)
1716n=0
1717DO WHILE(.true.)
1718 READ(un,*,END=100)
1719 n = n + 1
1720ENDDO
1721
1722100 CONTINUE
1723
1724rewind(un)
1725ALLOCATE(conv_fwd(n),stat=stallo)
1726IF (stallo /= 0) THEN
1727 CALL l4f_log(l4f_fatal,"allocating memory")
1728 CALL raise_fatal_error()
1729ENDIF
1730
1731conv_fwd(:) = vg6d_v7d_var_conv_miss
1732CALL import_var_conv(un, conv_fwd)
1733CLOSE(un)
1734
1735! backward, bufr to grib
1736un = open_package_file('vargrib2bufr.csv', filetype_data)
1737! use the same file for now
1738!un = open_package_file('varbufr2grib.csv', filetype_data)
1739n=0
1740DO WHILE(.true.)
1741 READ(un,*,END=300)
1742 n = n + 1
1743ENDDO
1744
1745300 CONTINUE
1746
1747rewind(un)
1748ALLOCATE(conv_bwd(n),stat=stallo)
1749IF (stallo /= 0) THEN
1750 CALL l4f_log(l4f_fatal,"allocating memory")
1751 CALL raise_fatal_error()
1752end if
1753
1754conv_bwd(:) = vg6d_v7d_var_conv_miss
1755CALL import_var_conv(un, conv_bwd)
1756DO i = 1, n
1757 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1758 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1759ENDDO
1760CLOSE(un)
1761
1762CONTAINS
1763
1764SUBROUTINE import_var_conv(un, conv_type)
1765INTEGER, INTENT(in) :: un
1766TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1767
1768INTEGER :: i
1769TYPE(csv_record) :: csv
1770CHARACTER(len=1024) :: line
1771CHARACTER(len=10) :: btable
1772INTEGER :: centre, category, number, discipline
1773
1774DO i = 1, SIZE(conv_type)
1775 READ(un,'(A)',END=200)line
1777 CALL csv_record_getfield(csv, btable)
1778 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1779 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1781
1782 CALL csv_record_getfield(csv, centre)
1783 CALL csv_record_getfield(csv, category)
1784 CALL csv_record_getfield(csv, number)
1785 CALL csv_record_getfield(csv, discipline)
1787 number=number, discipline=discipline) ! controllare l'ordine
1788
1789 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1790 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1792ENDDO
1793
1794200 CONTINUE
1795
1796END SUBROUTINE import_var_conv
1797
1798END SUBROUTINE vg6d_v7d_var_conv_setup
1799
1800
1801ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1802TYPE(conv_func),INTENT(IN) :: this, that
1803LOGICAL :: res
1804
1805res = this%a == that%a .AND. this%b == that%b
1806
1807END FUNCTION conv_func_eq
1808
1809
1810ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1811TYPE(conv_func),INTENT(IN) :: this, that
1812LOGICAL :: res
1813
1814res = .NOT.(this == that)
1815
1816END FUNCTION conv_func_ne
1817
1818
1819FUNCTION conv_func_mult(this, that) RESULT(mult)
1820TYPE(conv_func),INTENT(in) :: this
1821TYPE(conv_func),INTENT(in) :: that
1822
1823TYPE(conv_func) :: mult
1824
1825IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1826 mult = conv_func_miss
1827ELSE
1828 mult%a = this%a*that%a
1829 mult%b = this%a*that%b+this%b
1830ENDIF
1831
1832END FUNCTION conv_func_mult
1833
1834!> Apply the conversion function \a this to \a values.
1835!! The numerical conversion (only linear at the moment) defined by the
1836!! \a conv_func object \a this is applied to the \a values argument;
1837!! the converted result is stored in place; missing values remain
1838!! missing; if the conversion function is undefined (\a
1839!! conv_func_miss) the values are unchanged. The method is \c
1840!! ELEMENTAL, thus \a values can be also an array of any shape.
1841ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1842TYPE(conv_func),INTENT(in) :: this !< object defining the conversion function
1843REAL,INTENT(inout) :: values !< value to be converted in place
1844
1845IF (this /= conv_func_miss) THEN
1846 IF (c_e(values)) values = values*this%a + this%b
1847ELSE
1848 values=rmiss
1849ENDIF
1850
1851END SUBROUTINE conv_func_compute
1852
1853
1854!> Return a copy of \a values converted by applying the conversion
1855!! function \a this. The numerical conversion (only linear at the
1856!! moment) defined by the \a conv_func object \a this is applied to
1857!! the \a values argument and the converted result is returned;
1858!! missing values remain missing; if the conversion function is
1859!! undefined (\a conv_func_miss) the values are unchanged. The method
1860!! is \c ELEMENTAL, thus \a values can be also an array of any shape.
1861ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1862TYPE(conv_func),intent(in) :: this !< object defining the conversion function
1863REAL,INTENT(in) :: values !< input value to be converted
1864REAL :: convert
1865
1866convert = values
1868
1869END FUNCTION conv_func_convert
1870
1871
1872!> Locate variables which are horizontal components of a vector field.
1873!! This method scans the \a volgrid6d_var array provided and locates
1874!! pairs of variables which are x and y component of the same vector
1875!! field. On exit, the arrays \x xind(:) and \a yind(:) are allocated
1876!! to a size equal to the number of vector fields detected and their
1877!! corresponding elements will point to x and y components of the same
1878!! vector field. If inconsistencies are found, e.g. only one component
1879!! is detected for a field, or more than one input variable define
1880!! the same component, then \a xind and \a xind are nullified, thus an
1881!! error condition can be tested as \c .NOT.ASSOCIATED(xind). If no
1882!! vector fields are found then \a xind and \a xind are allocated to
1883!! zero size. If \a xind and \a yind are \c ASSOCIATED() after return,
1884!! they should be \c DEALLOCATEd by the calling procedure.
1885SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1886TYPE(volgrid6d_var),INTENT(in) :: this(:) !< array of volgrid6d_var objects (grib variable) to test
1887INTEGER,POINTER :: xind(:), yind(:) !< output arrays of indices pointing to matching horizontal components, allocated by this method
1888
1889TYPE(vol7d_var) :: varbufr(SIZE(this))
1890TYPE(conv_func),POINTER :: c_func(:)
1891INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1892
1893NULLIFY(xind, yind)
1894counts(:) = 0
1895
1896CALL vargrib2varbufr(this, varbufr, c_func)
1897
1898DO i = 1, SIZE(vol7d_var_horcomp)
1899 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1900ENDDO
1901
1902IF (any(counts(1::2) > 1)) THEN
1903 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1904 DEALLOCATE(c_func)
1905 RETURN
1906ENDIF
1907IF (any(counts(2::2) > 1)) THEN
1908 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1909 DEALLOCATE(c_func)
1910 RETURN
1911ENDIF
1912
1913! check that variables are paired and count pairs
1914nv = 0
1915DO i = 1, SIZE(vol7d_var_horcomp), 2
1916 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
1917 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
1918 ' present but the corresponding x-component '// &
1919 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
1920 RETURN
1921 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
1922 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
1923 ' present but the corresponding y-component '// &
1924 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
1925 RETURN
1926 ENDIF
1927 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
1928ENDDO
1929
1930! repeat the loop storing indices
1931ALLOCATE(xind(nv), yind(nv))
1932nv = 0
1933DO i = 1, SIZE(vol7d_var_horcomp), 2
1934 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
1935 nv = nv + 1
1936 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
1937 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
1938 ENDIF
1939ENDDO
1940DEALLOCATE(c_func)
1941
1942END SUBROUTINE volgrid6d_var_hor_comp_index
1943
1944
1945!> Tests whether a variable is the horizontal component of a vector field.
1946!! Returns \a .TRUE. if the corresponding variable is recognized as an
1947!! horizontal component of a vector field; if it is the case the
1948!! variable may need rotation in case of coordinate change.
1949FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
1950TYPE(volgrid6d_var),INTENT(in) :: this !< volgrid6d_var object (grib variable) to test
1951LOGICAL :: is_hor_comp
1952
1953TYPE(vol7d_var) :: varbufr
1954
1955varbufr = convert(this)
1956is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
1957
1958END FUNCTION volgrid6d_var_is_hor_comp
1959
1960! before unstaggering??
1961
1962!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1963!
1964!call init(varu,btable="B11003")
1965!call init(varv,btable="B11004")
1966!
1967! test about presence of u and v in standard table
1968!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
1969! call l4f_category_log(this%category,L4F_FATAL, &
1970! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
1971! CALL raise_error()
1972! RETURN
1973!end if
1974!
1975!if (associated(this%var))then
1976! nvar=size(this%var)
1977! allocate(varbufr(nvar),stat=stallo)
1978! if (stallo /=0)then
1979! call l4f_log(L4F_FATAL,"allocating memory")
1980! call raise_fatal_error("allocating memory")
1981! end if
1982!
1983! CALL vargrib2varbufr(this%var, varbufr)
1984!ELSE
1985! CALL l4f_category_log(this%category, L4F_ERROR, &
1986! "trying to destagger an incomplete volgrid6d object")
1987! CALL raise_error()
1988! RETURN
1989!end if
1990!
1991!nvaru=COUNT(varbufr==varu)
1992!nvarv=COUNT(varbufr==varv)
1993!
1994!if (nvaru > 1 )then
1995! call l4f_category_log(this%category,L4F_WARN, &
1996! ">1 variables refer to u wind component, destaggering will not be done ")
1997! DEALLOCATE(varbufr)
1998! RETURN
1999!endif
2000!
2001!if (nvarv > 1 )then
2002! call l4f_category_log(this%category,L4F_WARN, &
2003! ">1 variables refer to v wind component, destaggering will not be done ")
2004! DEALLOCATE(varbufr)
2005! RETURN
2006!endif
2007!
2008!if (nvaru == 0 .and. nvarv == 0) then
2009! call l4f_category_log(this%category,L4F_WARN, &
2010! "no u or v wind component found in volume, nothing to do")
2011! DEALLOCATE(varbufr)
2012! RETURN
2013!endif
2014!
2015!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2016! call l4f_category_log(this%category,L4F_WARN, &
2017! "there are variables different from u and v wind component in C grid")
2018!endif
2019
2020
Apply the conversion function this to values. Definition volgrid6d_var_class.F90:390 Apply the conversion function this to values. Definition volgrid6d_var_class.F90:396 Destructor for the corresponding object, it assigns it to a missing value. Definition volgrid6d_var_class.F90:304 Display on the screen a brief content of object. Definition volgrid6d_var_class.F90:376 Initialize a volgrid6d_var object with the optional arguments provided. Definition volgrid6d_var_class.F90:298 This module defines an abstract interface to different drivers for access to files containing gridded... Definition grid_id_class.F90:249 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 delle variabili osservate da stazioni meteo e affini. Definition vol7d_var_class.F90:212 Class for managing physical variables in a grib 1/2 fashion. Definition volgrid6d_var_class.F90:218 Definisce una variabile meteorologica osservata o un suo attributo. Definition vol7d_var_class.F90:226 Class defining a real conversion function between units. Definition volgrid6d_var_class.F90:265 Definition of a physical variable in grib coding style. Definition volgrid6d_var_class.F90:232 |