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