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