libsim Versione 7.2.6
|
◆ conv_func_compute()
Apply the conversion function this to values. The numerical conversion (only linear at the moment) defined by the conv_func object this is applied to the values argument; the converted result is stored in place; missing values remain missing; if the conversion function is undefined (conv_func_miss) the values are unchanged. The method is
Definizione alla linea 1455 del file volgrid6d_var_class.F90. 1456! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1457! authors:
1458! Davide Cesari <dcesari@arpa.emr.it>
1459! Paolo Patruno <ppatruno@arpa.emr.it>
1460
1461! This program is free software; you can redistribute it and/or
1462! modify it under the terms of the GNU General Public License as
1463! published by the Free Software Foundation; either version 2 of
1464! the License, or (at your option) any later version.
1465
1466! This program is distributed in the hope that it will be useful,
1467! but WITHOUT ANY WARRANTY; without even the implied warranty of
1468! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1469! GNU General Public License for more details.
1470
1471! You should have received a copy of the GNU General Public License
1472! along with this program. If not, see <http://www.gnu.org/licenses/>.
1473#include "config.h"
1474
1475!> Class for managing physical variables in a grib 1/2 fashion.
1476!! This module defines a class which can represent Earth-science
1477!! related physical variables, following the classification scheme
1478!! adopted by WMO for grib1 and grib2 parameter definition. It also
1479!! defines some methods for mapping \a volgrid6d_var variables and
1480!! converting the corresponding fields to a matching \a vol7d_var
1481!! object defined in \a vol7d_var_class module, which, unlike the
1482!! variables defined here, defines univocally a physical quantity.
1483!!
1484!! \ingroup volgrid6d
1492
1493IMPLICIT NONE
1494
1495!> Definition of a physical variable in grib coding style.
1496!! \a volgrid6d_var members are public, thus they can be freely
1497!! altered, but it is advisable to set them through the
1498!! volgrid6d_var_class::init constructor.
1500 integer :: centre !< centre
1501 integer :: category !< grib2: category / grib1: grib table version number
1502 integer :: number !< parameter number
1503 integer :: discipline !< grib2: discipline / grib1: 255
1504 CHARACTER(len=65) :: description !< optional textual description of the variable
1505 CHARACTER(len=24) :: unit !< optional textual description of the variable's unit
1507
1508TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1510
1511TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1514 /)
1515
1516TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1521/)
1522!/), (/2,2/)) ! bug in gfortran
1523
1524!> Class defining a real conversion function between units. It is
1525!! used to numerically convert a value expressed as a \a volgrid6d_var
1526!! variable in a value expressed as a \a vol7d_var variable and
1527!! vice-versa. At the moment only a linear conversion is
1528!! supported. Objects of this class are returned only by the \a
1529!! vargrib2varbufr \a varbufr2vargrib, and \a convert methods and are
1530!! used in the \a convert and \a compute methods defined in this
1531!! MODULE.
1533 PRIVATE
1534 REAL :: a, b
1536
1539
1540TYPE vg6d_v7d_var_conv
1541 TYPE(volgrid6d_var) :: vg6d_var
1542 TYPE(vol7d_var) :: v7d_var
1543 TYPE(conv_func) :: c_func
1544! aggiungere informazioni ad es. su rotazione del vento
1545END TYPE vg6d_v7d_var_conv
1546
1547TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1548 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1549
1550TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1551
1552!> Initialize a \a volgrid6d_var object with the optional arguments provided.
1553!! If an argument is not provided, the corresponding object member and
1554!! those depending on it will be set to missing. For grib1-style
1555!! variables, the \a discipline argument must be omitted, it will be
1556!! set to 255 (grib missing value).
1557!!
1558!! \param this TYPE(volgrid6d_var),INTENT(INOUT) object to be initialized
1559!! \param centre INTEGER,INTENT(in),OPTIONAL centre
1560!! \param category INTEGER,INTENT(in),OPTIONAL grib2: category / grib1: grib table version number
1561!! \param number INTEGER,INTENT(in),OPTIONAL parameter number
1562!! \param discipline INTEGER,INTENT(in),OPTIONAL grib2: discipline / grib1: 255
1563!! \param description CHARACTER(len=*),INTENT(in),OPTIONAL optional textual description of the variable
1564!! \param unit CHARACTER(len=*),INTENT(in),OPTIONAL optional textual description of the variable's unit
1566 MODULE PROCEDURE volgrid6d_var_init
1567END INTERFACE
1568
1569!> Destructor for the corresponding object, it assigns it to a missing value.
1570!! \param this TYPE(volgrid6d_var) object to be destroyed
1572 MODULE PROCEDURE volgrid6d_var_delete
1573END INTERFACE
1574
1575INTERFACE c_e
1576 MODULE PROCEDURE volgrid6d_var_c_e
1577END INTERFACE
1578
1579
1580!> Logical equality operators for objects of the classes \a
1581!! volgrid6d_var and \a conv_func.
1582!! They are all defined as \c ELEMENTAL thus work also on arrays of
1583!! any shape.
1584INTERFACE OPERATOR (==)
1585 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1586END INTERFACE
1587
1588!> Logical inequality operators for objects of the classes \a
1589!! volgrid6d_var and \a conv_func.
1590!! They are all defined as \c ELEMENTAL thus work also on arrays of
1591!! any shape.
1592INTERFACE OPERATOR (/=)
1593 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1594END INTERFACE
1595
1596#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1597#define VOL7D_POLY_TYPES _var6d
1598#include "array_utilities_pre.F90"
1599
1600!> Display on the screen a brief content of object
1602 MODULE PROCEDURE display_volgrid6d_var
1603END INTERFACE
1604
1605!> Compose two conversions into a single one.
1606!! Unlike scalar multiplication (and like matrix multiplication) here
1607!! a*b /= b*a. By convention, the second factor is applied first in
1608!! the result.
1609INTERFACE OPERATOR (*)
1610 MODULE PROCEDURE conv_func_mult
1611END INTERFACE OPERATOR (*)
1612
1613!> Apply the conversion function \a this to \a values.
1614!! function version
1616 MODULE PROCEDURE conv_func_compute
1617END INTERFACE
1618
1619!> Apply the conversion function \a this to \a values.
1620!! subroutine version
1622 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1623 conv_func_convert
1624END INTERFACE
1625
1626PRIVATE
1628 c_e, volgrid6d_var_normalize, &
1629 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1630 count_distinct, pack_distinct, count_and_pack_distinct, &
1631 map_distinct, map_inv_distinct, &
1633 vargrib2varbufr, varbufr2vargrib, &
1635 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1636
1637
1638CONTAINS
1639
1640
1641ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1642 discipline, description, unit) RESULT(this)
1643integer,INTENT(in),OPTIONAL :: centre !< centre
1644integer,INTENT(in),OPTIONAL :: category !< grib2: category / grib1: grib table version number
1645integer,INTENT(in),OPTIONAL :: number !< parameter number
1646integer,INTENT(in),OPTIONAL :: discipline !< grib2: discipline
1647CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< textual description of the variable
1648CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< textual description of the variable's unit
1649
1650TYPE(volgrid6d_var) :: this !< object to be initialised
1651
1653
1654END FUNCTION volgrid6d_var_new
1655
1656
1657! documented in the interface
1658ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1659TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1660INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1661INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1662INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1663INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1664CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1665CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1666
1667IF (PRESENT(centre)) THEN
1668 this%centre = centre
1669ELSE
1670 this%centre = imiss
1671 this%category = imiss
1672 this%number = imiss
1673 this%discipline = imiss
1674 RETURN
1675ENDIF
1676
1677IF (PRESENT(category)) THEN
1678 this%category = category
1679ELSE
1680 this%category = imiss
1681 this%number = imiss
1682 this%discipline = imiss
1683 RETURN
1684ENDIF
1685
1686
1687IF (PRESENT(number)) THEN
1688 this%number = number
1689ELSE
1690 this%number = imiss
1691 this%discipline = imiss
1692 RETURN
1693ENDIF
1694
1695! se sono arrivato fino a qui ho impostato centre, category e number
1696!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1697
1698IF (PRESENT(discipline)) THEN
1699 this%discipline = discipline
1700ELSE
1701 this%discipline = 255
1702ENDIF
1703
1704IF (PRESENT(description)) THEN
1705 this%description = description
1706ELSE
1707 this%description = cmiss
1708ENDIF
1709
1710IF (PRESENT(unit)) THEN
1711 this%unit = unit
1712ELSE
1713 this%unit = cmiss
1714ENDIF
1715
1716
1717
1718END SUBROUTINE volgrid6d_var_init
1719
1720
1721! documented in the interface
1722SUBROUTINE volgrid6d_var_delete(this)
1723TYPE(volgrid6d_var),INTENT(INOUT) :: this
1724
1725this%centre = imiss
1726this%category = imiss
1727this%number = imiss
1728this%discipline = imiss
1729this%description = cmiss
1730this%unit = cmiss
1731
1732END SUBROUTINE volgrid6d_var_delete
1733
1734
1735ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1736TYPE(volgrid6d_var),INTENT(IN) :: this
1737LOGICAL :: c_e
1738c_e = this /= volgrid6d_var_miss
1739END FUNCTION volgrid6d_var_c_e
1740
1741
1742ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1743TYPE(volgrid6d_var),INTENT(IN) :: this, that
1744LOGICAL :: res
1745
1746IF (this%discipline == that%discipline) THEN
1747
1748 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1749 res = ((this%category == that%category) .OR. &
1750 (this%category >= 1 .AND. this%category <=3 .AND. &
1751 that%category >= 1 .AND. that%category <=3)) .AND. &
1752 this%number == that%number
1753
1754 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1755 (this%number >= 128 .AND. this%number <= 254)) THEN
1756 res = res .AND. this%centre == that%centre ! local definition, centre matters
1757 ENDIF
1758
1759 ELSE ! grib2
1760 res = this%category == that%category .AND. &
1761 this%number == that%number
1762
1763 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1764 (this%category >= 192 .AND. this%category <= 254) .OR. &
1765 (this%number >= 192 .AND. this%number <= 254)) THEN
1766 res = res .AND. this%centre == that%centre ! local definition, centre matters
1767 ENDIF
1768 ENDIF
1769
1770ELSE ! different edition or different discipline
1771 res = .false.
1772ENDIF
1773
1774END FUNCTION volgrid6d_var_eq
1775
1776
1777ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1778TYPE(volgrid6d_var),INTENT(IN) :: this, that
1779LOGICAL :: res
1780
1781res = .NOT.(this == that)
1782
1783END FUNCTION volgrid6d_var_ne
1784
1785
1786#include "array_utilities_inc.F90"
1787
1788
1789!> Display on the screen a brief content of \a volgrid6d_var object.
1790SUBROUTINE display_volgrid6d_var(this)
1791TYPE(volgrid6d_var),INTENT(in) :: this !< volgrid6d_var object to display
1792
1793print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1794
1795END SUBROUTINE display_volgrid6d_var
1796
1797
1798!> Convert a \a volgrid6d_var array object into a physically equivalent
1799!! \a vol7d_var array object. This method converts a grib-like array
1800!! of physical variables \a vargrib, to an array of unique, physically
1801!! based, bufr-like variables \a varbufr. The output array must have
1802!! enough room for the converted variables. The method additionally
1803!! allocates a \a conv_func array object of the same size, which can
1804!! successively be used to convert the numerical values of the fields
1805!! associated to \a vargrib to the corresponding fields in the \a
1806!! bufr-like representation. \a c_func will have to be deallocated by
1807!! the calling procedure. If a conversion is not successful, the
1808!! corresponding output variable is set to \a vol7d_var_miss and the
1809!! conversion function to \a conv_func_miss.
1810SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1811TYPE(volgrid6d_var),INTENT(in) :: vargrib(:) !< array of input grib-like variables
1812TYPE(vol7d_var),INTENT(out) :: varbufr(:) !< array of output bufr-like variables
1813TYPE(conv_func),POINTER :: c_func(:) !< pointer to an array of the corresponding \a conv_func objects, allocated in the method
1814
1815INTEGER :: i, n, stallo
1816
1817n = min(SIZE(varbufr), SIZE(vargrib))
1818ALLOCATE(c_func(n),stat=stallo)
1819IF (stallo /= 0) THEN
1820 call l4f_log(l4f_fatal,"allocating memory")
1821 call raise_fatal_error()
1822ENDIF
1823
1824DO i = 1, n
1825 varbufr(i) = convert(vargrib(i), c_func(i))
1826ENDDO
1827
1828END SUBROUTINE vargrib2varbufr
1829
1830
1831!> Convert a \a volgrid6d_var object into a physically equivalent
1832!! \a vol7d_var object. This method returns a physically based,
1833!! bufr-like representation of type \a vol7d_var of the grib-like
1834!! input physical variable \a vargrib. The method optionally returns
1835!! a \a conv_func object which can successively be used to convert the
1836!! numerical values of the field associated to \a vargrib to the
1837!! corresponding fields in the bufr-like representation. If the
1838!! conversion is not successful, the output variable is
1839!! set to \a vol7d_var_miss and the conversion function to \a
1840!! conv_func_miss.
1841FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1842TYPE(volgrid6d_var),INTENT(in) :: vargrib !< input grib-like variable
1843TYPE(conv_func),INTENT(out),OPTIONAL :: c_func !< corresponding \a conv_func object
1844TYPE(vol7d_var) :: convert
1845
1846INTEGER :: i
1847
1848IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1849
1850DO i = 1, SIZE(conv_fwd)
1851 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1852 convert = conv_fwd(i)%v7d_var
1853 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1854 RETURN
1855 ENDIF
1856ENDDO
1857! not found
1858convert = vol7d_var_miss
1859IF (PRESENT(c_func)) c_func = conv_func_miss
1860
1861! set hint for backwards conversion
1862convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1863 vargrib%discipline/)
1864
1865CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1866 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1867 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1868 ' not found in table')
1869
1870END FUNCTION vargrib2varbufr_convert
1871
1872
1873!> Convert a \a vol7d_var array object into a physically equivalent
1874!! \a volgrid6d_var array object. This method converts a bufr-like
1875!! array of physical variables \a vargrib, to an array of grib-like
1876!! variables \a varbufr. Unlike the opposite method \a
1877!! vargrib2varbufr, in this case the conversion is not uniqe and at
1878!! the moment the first matching grib-like variable is chosen, without
1879!! any control over the choice process. The output array must have
1880!! enough room for the converted variables. The method additionally
1881!! allocates a \a conv_func array object of the same size, which can
1882!! successively be used to convert the numerical values of the fields
1883!! associated to \a varbufr to the corresponding fields in the \a
1884!! grib-like representation. \a c_func will have to be deallocated by
1885!! the calling procedure. If a conversion is not successful, the
1886!! corresponding output variable is set to \a volgrid6d_var_miss and
1887!! the conversion function to \a conv_func_miss.
1888SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1889TYPE(vol7d_var),INTENT(in) :: varbufr(:) !< array of input bufr-like variables
1890TYPE(volgrid6d_var),INTENT(out) :: vargrib(:) !< array of output grib-like variables
1891TYPE(conv_func),POINTER :: c_func(:) !< pointer to an array of the corresponding \a conv_func objects, allocated in the method
1892TYPE(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
1893
1894INTEGER :: i, n, stallo
1895
1896n = min(SIZE(varbufr), SIZE(vargrib))
1897ALLOCATE(c_func(n),stat=stallo)
1898IF (stallo /= 0) THEN
1899 CALL l4f_log(l4f_fatal,"allocating memory")
1900 CALL raise_fatal_error()
1901ENDIF
1902
1903DO i = 1, n
1904 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1905ENDDO
1906
1907END SUBROUTINE varbufr2vargrib
1908
1909
1910!> Convert a \a vol7d_var object into a physically equivalent
1911!! \a volgrid6d_var object. This method returns a grib-like
1912!! representation of type \a volgrid6d_var of the bufr-like input
1913!! physical variable \a varbufr. Unlike the opposite \a convert
1914!! method, in this case the conversion is not uniqe and at the moment
1915!! the first matching grib-like variable is chosen, without any
1916!! control over the choice process. The method optionally returns a
1917!! \a conv_func object which can successively be used to convert the
1918!! numerical values of the field associated to \a varbufr to the
1919!! corresponding fields in the grib-like representation. If the
1920!! conversion is not successful, the output variable is set to \a
1921!! volgrid6d_var_miss and the conversion function to \a
1922!! conv_func_miss.
1923FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1924TYPE(vol7d_var),INTENT(in) :: varbufr !< input bufr-like variable
1925TYPE(conv_func),INTENT(out),OPTIONAL :: c_func !< corresponding \a conv_func object
1926TYPE(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
1927TYPE(volgrid6d_var) :: convert
1928
1929INTEGER :: i
1930#ifdef HAVE_LIBGRIBAPI
1931INTEGER :: gaid, editionnumber, category, centre
1932#endif
1933
1934IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1935
1936#ifdef HAVE_LIBGRIBAPI
1937editionnumber=255; category=255; centre=255
1938#endif
1939IF (PRESENT(grid_id_template)) THEN
1940#ifdef HAVE_LIBGRIBAPI
1941 gaid = grid_id_get_gaid(grid_id_template)
1942 IF (c_e(gaid)) THEN
1943 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1944 IF (editionnumber == 1) THEN
1945 CALL grib_get(gaid,'gribTablesVersionNo',category)
1946 ENDIF
1947 CALL grib_get(gaid,'centre',centre)
1948 ENDIF
1949#endif
1950ENDIF
1951
1952DO i = 1, SIZE(conv_bwd)
1953 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1954#ifdef HAVE_LIBGRIBAPI
1955 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1956 IF (editionnumber == 1) THEN
1957 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1958 ELSE IF (editionnumber == 2) THEN
1959 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1960 ENDIF
1961 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1962 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1963 ENDIF
1964#endif
1965 convert = conv_bwd(i)%vg6d_var
1966 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1967 RETURN
1968 ENDIF
1969ENDDO
1970! not found
1971convert = volgrid6d_var_miss
1972IF (PRESENT(c_func)) c_func = conv_func_miss
1973
1974! if hint available use it as a fallback
1975IF (any(varbufr%gribhint /= imiss)) THEN
1976 convert%centre = varbufr%gribhint(1)
1977 convert%category = varbufr%gribhint(2)
1978 convert%number = varbufr%gribhint(3)
1979 convert%discipline = varbufr%gribhint(4)
1980ENDIF
1981
1982CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1983 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1984 ' not found in table')
1985
1986END FUNCTION varbufr2vargrib_convert
1987
1988
1989!> Normalize a variable definition converting it to the
1990!! format (grib edition) specified in the (grib) template provided.
1991!! This allows a basic grib1 <-> grib2 conversion provided that
1992!! entries for both grib editions of the related variable are present
1993!! in the static file \a vargrib2ufr.csv. If the \a c_func variable
1994!! returned is not missing (i.e. /= conv_func_miss) the field value
1995!! should be converted as well using the conv_func::compute method .
1996SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1997TYPE(volgrid6d_var),INTENT(inout) :: this !< variable to normalize
1998TYPE(conv_func),INTENT(out) :: c_func !< \a conv_func object to convert data
1999TYPE(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
2000
2001LOGICAL :: eqed, eqcentre
2002INTEGER :: gaid, editionnumber, centre
2003TYPE(volgrid6d_var) :: tmpgrib
2004TYPE(vol7d_var) :: tmpbufr
2005TYPE(conv_func) tmpc_func1, tmpc_func2
2006
2007eqed = .true.
2008eqcentre = .true.
2009c_func = conv_func_miss
2010
2011#ifdef HAVE_LIBGRIBAPI
2012gaid = grid_id_get_gaid(grid_id_template)
2013IF (c_e(gaid)) THEN
2014 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
2015 CALL grib_get(gaid, 'centre', centre)
2016 eqed = editionnumber == 1 .EQV. this%discipline == 255
2017 eqcentre = centre == this%centre
2018ENDIF
2019#endif
2020
2021IF (eqed .AND. eqcentre) RETURN ! nothing to do
2022
2023tmpbufr = convert(this, tmpc_func1)
2024tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
2025
2026IF (tmpgrib /= volgrid6d_var_miss) THEN
2027! conversion back and forth successful, set also conversion function
2028 this = tmpgrib
2029 c_func = tmpc_func1 * tmpc_func2
2030! set to missing in common case to avoid useless computation
2031 IF (c_func == conv_func_identity) c_func = conv_func_miss
2032ELSE IF (.NOT.eqed) THEN
2033! conversion back and forth unsuccessful and grib edition incompatible, set to miss
2034 this = tmpgrib
2035ENDIF
2036
2037END SUBROUTINE volgrid6d_var_normalize
2038
2039
2040! Private subroutine for reading forward and backward conversion tables
2041! todo: better error handling
2042SUBROUTINE vg6d_v7d_var_conv_setup()
2043INTEGER :: un, i, n, stallo
2044
2045! forward, grib to bufr
2046un = open_package_file('vargrib2bufr.csv', filetype_data)
2047n=0
2048DO WHILE(.true.)
2049 READ(un,*,END=100)
2050 n = n + 1
2051ENDDO
2052
2053100 CONTINUE
2054
2055rewind(un)
2056ALLOCATE(conv_fwd(n),stat=stallo)
2057IF (stallo /= 0) THEN
2058 CALL l4f_log(l4f_fatal,"allocating memory")
2059 CALL raise_fatal_error()
2060ENDIF
2061
2062conv_fwd(:) = vg6d_v7d_var_conv_miss
2063CALL import_var_conv(un, conv_fwd)
2064CLOSE(un)
2065
2066! backward, bufr to grib
2067un = open_package_file('vargrib2bufr.csv', filetype_data)
2068! use the same file for now
2069!un = open_package_file('varbufr2grib.csv', filetype_data)
2070n=0
2071DO WHILE(.true.)
2072 READ(un,*,END=300)
2073 n = n + 1
2074ENDDO
2075
2076300 CONTINUE
2077
2078rewind(un)
2079ALLOCATE(conv_bwd(n),stat=stallo)
2080IF (stallo /= 0) THEN
2081 CALL l4f_log(l4f_fatal,"allocating memory")
2082 CALL raise_fatal_error()
2083end if
2084
2085conv_bwd(:) = vg6d_v7d_var_conv_miss
2086CALL import_var_conv(un, conv_bwd)
2087DO i = 1, n
2088 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
2089 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
2090ENDDO
2091CLOSE(un)
2092
2093CONTAINS
2094
2095SUBROUTINE import_var_conv(un, conv_type)
2096INTEGER, INTENT(in) :: un
2097TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
2098
2099INTEGER :: i
2100TYPE(csv_record) :: csv
2101CHARACTER(len=1024) :: line
2102CHARACTER(len=10) :: btable
2103INTEGER :: centre, category, number, discipline
2104
2105DO i = 1, SIZE(conv_type)
2106 READ(un,'(A)',END=200)line
2108 CALL csv_record_getfield(csv, btable)
2109 CALL csv_record_getfield(csv) ! skip fields for description and unit,
2110 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
2112
2113 CALL csv_record_getfield(csv, centre)
2114 CALL csv_record_getfield(csv, category)
2115 CALL csv_record_getfield(csv, number)
2116 CALL csv_record_getfield(csv, discipline)
2118 number=number, discipline=discipline) ! controllare l'ordine
2119
2120 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
2121 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
2123ENDDO
2124
2125200 CONTINUE
2126
2127END SUBROUTINE import_var_conv
2128
2129END SUBROUTINE vg6d_v7d_var_conv_setup
2130
2131
2132ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
2133TYPE(conv_func),INTENT(IN) :: this, that
2134LOGICAL :: res
2135
2136res = this%a == that%a .AND. this%b == that%b
2137
2138END FUNCTION conv_func_eq
2139
2140
2141ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
2142TYPE(conv_func),INTENT(IN) :: this, that
2143LOGICAL :: res
2144
2145res = .NOT.(this == that)
2146
2147END FUNCTION conv_func_ne
2148
2149
2150FUNCTION conv_func_mult(this, that) RESULT(mult)
2151TYPE(conv_func),INTENT(in) :: this
2152TYPE(conv_func),INTENT(in) :: that
2153
2154TYPE(conv_func) :: mult
2155
2156IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
2157 mult = conv_func_miss
2158ELSE
2159 mult%a = this%a*that%a
2160 mult%b = this%a*that%b+this%b
2161ENDIF
2162
2163END FUNCTION conv_func_mult
2164
2165!> Apply the conversion function \a this to \a values.
2166!! The numerical conversion (only linear at the moment) defined by the
2167!! \a conv_func object \a this is applied to the \a values argument;
2168!! the converted result is stored in place; missing values remain
2169!! missing; if the conversion function is undefined (\a
2170!! conv_func_miss) the values are unchanged. The method is \c
2171!! ELEMENTAL, thus \a values can be also an array of any shape.
2172ELEMENTAL SUBROUTINE conv_func_compute(this, values)
2173TYPE(conv_func),INTENT(in) :: this !< object defining the conversion function
2174REAL,INTENT(inout) :: values !< value to be converted in place
2175
2176IF (this /= conv_func_miss) THEN
2177 IF (c_e(values)) values = values*this%a + this%b
2178ELSE
2179 values=rmiss
2180ENDIF
2181
2182END SUBROUTINE conv_func_compute
2183
2184
2185!> Return a copy of \a values converted by applying the conversion
2186!! function \a this. The numerical conversion (only linear at the
2187!! moment) defined by the \a conv_func object \a this is applied to
2188!! the \a values argument and the converted result is returned;
2189!! missing values remain missing; if the conversion function is
2190!! undefined (\a conv_func_miss) the values are unchanged. The method
2191!! is \c ELEMENTAL, thus \a values can be also an array of any shape.
2192ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
2193TYPE(conv_func),intent(in) :: this !< object defining the conversion function
2194REAL,INTENT(in) :: values !< input value to be converted
2195REAL :: convert
2196
2197convert = values
2199
2200END FUNCTION conv_func_convert
2201
2202
2203!> Locate variables which are horizontal components of a vector field.
2204!! This method scans the \a volgrid6d_var array provided and locates
2205!! pairs of variables which are x and y component of the same vector
2206!! field. On exit, the arrays \x xind(:) and \a yind(:) are allocated
2207!! to a size equal to the number of vector fields detected and their
2208!! corresponding elements will point to x and y components of the same
2209!! vector field. If inconsistencies are found, e.g. only one component
2210!! is detected for a field, or more than one input variable define
2211!! the same component, then \a xind and \a xind are nullified, thus an
2212!! error condition can be tested as \c .NOT.ASSOCIATED(xind). If no
2213!! vector fields are found then \a xind and \a xind are allocated to
2214!! zero size. If \a xind and \a yind are \c ASSOCIATED() after return,
2215!! they should be \c DEALLOCATEd by the calling procedure.
2216SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
2217TYPE(volgrid6d_var),INTENT(in) :: this(:) !< array of volgrid6d_var objects (grib variable) to test
2218INTEGER,POINTER :: xind(:), yind(:) !< output arrays of indices pointing to matching horizontal components, allocated by this method
2219
2220TYPE(vol7d_var) :: varbufr(SIZE(this))
2221TYPE(conv_func),POINTER :: c_func(:)
2222INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
2223
2224NULLIFY(xind, yind)
2225counts(:) = 0
2226
2227CALL vargrib2varbufr(this, varbufr, c_func)
2228
2229DO i = 1, SIZE(vol7d_var_horcomp)
2230 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
2231ENDDO
2232
2233IF (any(counts(1::2) > 1)) THEN
2234 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
2235 DEALLOCATE(c_func)
2236 RETURN
2237ENDIF
2238IF (any(counts(2::2) > 1)) THEN
2239 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
2240 DEALLOCATE(c_func)
2241 RETURN
2242ENDIF
2243
2244! check that variables are paired and count pairs
2245nv = 0
2246DO i = 1, SIZE(vol7d_var_horcomp), 2
2247 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
2248 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
2249 ' present but the corresponding x-component '// &
2250 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
2251 RETURN
2252 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
2253 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
2254 ' present but the corresponding y-component '// &
2255 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
2256 RETURN
2257 ENDIF
2258 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
2259ENDDO
2260
2261! repeat the loop storing indices
2262ALLOCATE(xind(nv), yind(nv))
2263nv = 0
2264DO i = 1, SIZE(vol7d_var_horcomp), 2
2265 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
2266 nv = nv + 1
2267 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
2268 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
2269 ENDIF
2270ENDDO
2271DEALLOCATE(c_func)
2272
2273END SUBROUTINE volgrid6d_var_hor_comp_index
2274
2275
2276!> Tests whether a variable is the horizontal component of a vector field.
2277!! Returns \a .TRUE. if the corresponding variable is recognized as an
2278!! horizontal component of a vector field; if it is the case the
2279!! variable may need rotation in case of coordinate change.
2280FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
2281TYPE(volgrid6d_var),INTENT(in) :: this !< volgrid6d_var object (grib variable) to test
2282LOGICAL :: is_hor_comp
2283
2284TYPE(vol7d_var) :: varbufr
2285
2286varbufr = convert(this)
2287is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
2288
2289END FUNCTION volgrid6d_var_is_hor_comp
2290
2291! before unstaggering??
2292
2293!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
2294!
2295!call init(varu,btable="B11003")
2296!call init(varv,btable="B11004")
2297!
2298! test about presence of u and v in standard table
2299!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
2300! call l4f_category_log(this%category,L4F_FATAL, &
2301! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
2302! CALL raise_error()
2303! RETURN
2304!end if
2305!
2306!if (associated(this%var))then
2307! nvar=size(this%var)
2308! allocate(varbufr(nvar),stat=stallo)
2309! if (stallo /=0)then
2310! call l4f_log(L4F_FATAL,"allocating memory")
2311! call raise_fatal_error("allocating memory")
2312! end if
2313!
2314! CALL vargrib2varbufr(this%var, varbufr)
2315!ELSE
2316! CALL l4f_category_log(this%category, L4F_ERROR, &
2317! "trying to destagger an incomplete volgrid6d object")
2318! CALL raise_error()
2319! RETURN
2320!end if
2321!
2322!nvaru=COUNT(varbufr==varu)
2323!nvarv=COUNT(varbufr==varv)
2324!
2325!if (nvaru > 1 )then
2326! call l4f_category_log(this%category,L4F_WARN, &
2327! ">1 variables refer to u wind component, destaggering will not be done ")
2328! DEALLOCATE(varbufr)
2329! RETURN
2330!endif
2331!
2332!if (nvarv > 1 )then
2333! call l4f_category_log(this%category,L4F_WARN, &
2334! ">1 variables refer to v wind component, destaggering will not be done ")
2335! DEALLOCATE(varbufr)
2336! RETURN
2337!endif
2338!
2339!if (nvaru == 0 .and. nvarv == 0) then
2340! call l4f_category_log(this%category,L4F_WARN, &
2341! "no u or v wind component found in volume, nothing to do")
2342! DEALLOCATE(varbufr)
2343! RETURN
2344!endif
2345!
2346!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2347! call l4f_category_log(this%category,L4F_WARN, &
2348! "there are variables different from u and v wind component in C grid")
2349!endif
2350
2351
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 |