libsim Versione 7.2.6

◆ conv_func_convert()

elemental real function conv_func_convert ( type(conv_func), intent(in) this,
real, intent(in) values )

Return a copy of values converted by applying the conversion function this.

The numerical conversion (only linear at the moment) defined by the conv_func object this is applied to the values argument and the converted result is returned; missing values remain missing; if the conversion function is undefined (conv_func_miss) the values are unchanged. The method is ELEMENTAL, thus values can be also an array of any shape.

Parametri
[in]thisobject defining the conversion function
[in]valuesinput value to be converted

Definizione alla linea 1475 del file volgrid6d_var_class.F90.

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

Generated with Doxygen.