libsim Versione 7.2.6

◆ volgrid6d_var_is_hor_comp()

logical function, public volgrid6d_var_is_hor_comp ( type(volgrid6d_var), intent(in) this)

Tests whether a variable is the horizontal component of a vector field.

Returns .TRUE. if the corresponding variable is recognized as an horizontal component of a vector field; if it is the case the variable may need rotation in case of coordinate change.

Parametri
[in]thisvolgrid6d_var object (grib variable) to test

Definizione alla linea 1563 del file volgrid6d_var_class.F90.

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