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