libsim Versione 7.1.11

◆ 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 1569 del file volgrid6d_var_class.F90.

1570! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1571! authors:
1572! Davide Cesari <dcesari@arpa.emr.it>
1573! Paolo Patruno <ppatruno@arpa.emr.it>
1574
1575! This program is free software; you can redistribute it and/or
1576! modify it under the terms of the GNU General Public License as
1577! published by the Free Software Foundation; either version 2 of
1578! the License, or (at your option) any later version.
1579
1580! This program is distributed in the hope that it will be useful,
1581! but WITHOUT ANY WARRANTY; without even the implied warranty of
1582! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1583! GNU General Public License for more details.
1584
1585! You should have received a copy of the GNU General Public License
1586! along with this program. If not, see <http://www.gnu.org/licenses/>.
1587#include "config.h"
1588
1600USE kinds
1602USE err_handling
1605USE grid_id_class
1606
1607IMPLICIT NONE
1608
1613TYPE volgrid6d_var
1614 integer :: centre
1615 integer :: category
1616 integer :: number
1617 integer :: discipline
1618 CHARACTER(len=65) :: description
1619 CHARACTER(len=24) :: unit
1620END TYPE volgrid6d_var
1621
1622TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1623 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1624
1625TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1626 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1627 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
1628 /)
1629
1630TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1631 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1632 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
1633 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
1634 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
1635/)
1636!/), (/2,2/)) ! bug in gfortran
1637
1646TYPE conv_func
1647 PRIVATE
1648 REAL :: a, b
1649END TYPE conv_func
1650
1651TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
1652TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
1653
1654TYPE vg6d_v7d_var_conv
1655 TYPE(volgrid6d_var) :: vg6d_var
1656 TYPE(vol7d_var) :: v7d_var
1657 TYPE(conv_func) :: c_func
1658! aggiungere informazioni ad es. su rotazione del vento
1659END TYPE vg6d_v7d_var_conv
1660
1661TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1662 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1663
1664TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1665
1679INTERFACE init
1680 MODULE PROCEDURE volgrid6d_var_init
1681END INTERFACE
1682
1685INTERFACE delete
1686 MODULE PROCEDURE volgrid6d_var_delete
1687END INTERFACE
1688
1689INTERFACE c_e
1690 MODULE PROCEDURE volgrid6d_var_c_e
1691END INTERFACE
1692
1693
1698INTERFACE OPERATOR (==)
1699 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1700END INTERFACE
1701
1706INTERFACE OPERATOR (/=)
1707 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1708END INTERFACE
1709
1710#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1711#define VOL7D_POLY_TYPES _var6d
1712#include "array_utilities_pre.F90"
1713
1715INTERFACE display
1716 MODULE PROCEDURE display_volgrid6d_var
1717END INTERFACE
1718
1723INTERFACE OPERATOR (*)
1724 MODULE PROCEDURE conv_func_mult
1725END INTERFACE OPERATOR (*)
1726
1729INTERFACE compute
1730 MODULE PROCEDURE conv_func_compute
1731END INTERFACE
1732
1735INTERFACE convert
1736 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1737 conv_func_convert
1738END INTERFACE
1739
1740PRIVATE
1741PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
1742 c_e, volgrid6d_var_normalize, &
1743 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1744 count_distinct, pack_distinct, count_and_pack_distinct, &
1745 map_distinct, map_inv_distinct, &
1746 index, display, &
1747 vargrib2varbufr, varbufr2vargrib, &
1748 conv_func, conv_func_miss, compute, convert, &
1749 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1750
1751
1752CONTAINS
1753
1754
1755ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1756 discipline, description, unit) RESULT(this)
1757integer,INTENT(in),OPTIONAL :: centre
1758integer,INTENT(in),OPTIONAL :: category
1759integer,INTENT(in),OPTIONAL :: number
1760integer,INTENT(in),OPTIONAL :: discipline
1761CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1762CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1763
1764TYPE(volgrid6d_var) :: this
1765
1766CALL init(this, centre, category, number, discipline, description, unit)
1767
1768END FUNCTION volgrid6d_var_new
1769
1770
1771! documented in the interface
1772ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1773TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1774INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1775INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1776INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1777INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1778CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1779CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1780
1781IF (PRESENT(centre)) THEN
1782 this%centre = centre
1783ELSE
1784 this%centre = imiss
1785 this%category = imiss
1786 this%number = imiss
1787 this%discipline = imiss
1788 RETURN
1789ENDIF
1790
1791IF (PRESENT(category)) THEN
1792 this%category = category
1793ELSE
1794 this%category = imiss
1795 this%number = imiss
1796 this%discipline = imiss
1797 RETURN
1798ENDIF
1799
1800
1801IF (PRESENT(number)) THEN
1802 this%number = number
1803ELSE
1804 this%number = imiss
1805 this%discipline = imiss
1806 RETURN
1807ENDIF
1808
1809! se sono arrivato fino a qui ho impostato centre, category e number
1810!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1811
1812IF (PRESENT(discipline)) THEN
1813 this%discipline = discipline
1814ELSE
1815 this%discipline = 255
1816ENDIF
1817
1818IF (PRESENT(description)) THEN
1819 this%description = description
1820ELSE
1821 this%description = cmiss
1822ENDIF
1823
1824IF (PRESENT(unit)) THEN
1825 this%unit = unit
1826ELSE
1827 this%unit = cmiss
1828ENDIF
1829
1830
1831
1832END SUBROUTINE volgrid6d_var_init
1833
1834
1835! documented in the interface
1836SUBROUTINE volgrid6d_var_delete(this)
1837TYPE(volgrid6d_var),INTENT(INOUT) :: this
1838
1839this%centre = imiss
1840this%category = imiss
1841this%number = imiss
1842this%discipline = imiss
1843this%description = cmiss
1844this%unit = cmiss
1845
1846END SUBROUTINE volgrid6d_var_delete
1847
1848
1849ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1850TYPE(volgrid6d_var),INTENT(IN) :: this
1851LOGICAL :: c_e
1852c_e = this /= volgrid6d_var_miss
1853END FUNCTION volgrid6d_var_c_e
1854
1855
1856ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1857TYPE(volgrid6d_var),INTENT(IN) :: this, that
1858LOGICAL :: res
1859
1860IF (this%discipline == that%discipline) THEN
1861
1862 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1863 res = ((this%category == that%category) .OR. &
1864 (this%category >= 1 .AND. this%category <=3 .AND. &
1865 that%category >= 1 .AND. that%category <=3)) .AND. &
1866 this%number == that%number
1867
1868 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1869 (this%number >= 128 .AND. this%number <= 254)) THEN
1870 res = res .AND. this%centre == that%centre ! local definition, centre matters
1871 ENDIF
1872
1873 ELSE ! grib2
1874 res = this%category == that%category .AND. &
1875 this%number == that%number
1876
1877 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1878 (this%category >= 192 .AND. this%category <= 254) .OR. &
1879 (this%number >= 192 .AND. this%number <= 254)) THEN
1880 res = res .AND. this%centre == that%centre ! local definition, centre matters
1881 ENDIF
1882 ENDIF
1883
1884ELSE ! different edition or different discipline
1885 res = .false.
1886ENDIF
1887
1888END FUNCTION volgrid6d_var_eq
1889
1890
1891ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1892TYPE(volgrid6d_var),INTENT(IN) :: this, that
1893LOGICAL :: res
1894
1895res = .NOT.(this == that)
1896
1897END FUNCTION volgrid6d_var_ne
1898
1899
1900#include "array_utilities_inc.F90"
1901
1902
1904SUBROUTINE display_volgrid6d_var(this)
1905TYPE(volgrid6d_var),INTENT(in) :: this
1906
1907print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1908
1909END SUBROUTINE display_volgrid6d_var
1910
1911
1924SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1925TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1926TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1927TYPE(conv_func),POINTER :: c_func(:)
1928
1929INTEGER :: i, n, stallo
1930
1931n = min(SIZE(varbufr), SIZE(vargrib))
1932ALLOCATE(c_func(n),stat=stallo)
1933IF (stallo /= 0) THEN
1934 call l4f_log(l4f_fatal,"allocating memory")
1935 call raise_fatal_error()
1936ENDIF
1937
1938DO i = 1, n
1939 varbufr(i) = convert(vargrib(i), c_func(i))
1940ENDDO
1941
1942END SUBROUTINE vargrib2varbufr
1943
1944
1955FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1956TYPE(volgrid6d_var),INTENT(in) :: vargrib
1957TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1958TYPE(vol7d_var) :: convert
1959
1960INTEGER :: i
1961
1962IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1963
1964DO i = 1, SIZE(conv_fwd)
1965 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1966 convert = conv_fwd(i)%v7d_var
1967 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1968 RETURN
1969 ENDIF
1970ENDDO
1971! not found
1972convert = vol7d_var_miss
1973IF (PRESENT(c_func)) c_func = conv_func_miss
1974
1975! set hint for backwards conversion
1976convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1977 vargrib%discipline/)
1978
1979CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1980 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1981 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1982 ' not found in table')
1983
1984END FUNCTION vargrib2varbufr_convert
1985
1986
2002SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
2003TYPE(vol7d_var),INTENT(in) :: varbufr(:)
2004TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
2005TYPE(conv_func),POINTER :: c_func(:)
2006TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
2007
2008INTEGER :: i, n, stallo
2009
2010n = min(SIZE(varbufr), SIZE(vargrib))
2011ALLOCATE(c_func(n),stat=stallo)
2012IF (stallo /= 0) THEN
2013 CALL l4f_log(l4f_fatal,"allocating memory")
2014 CALL raise_fatal_error()
2015ENDIF
2016
2017DO i = 1, n
2018 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
2019ENDDO
2020
2021END SUBROUTINE varbufr2vargrib
2022
2023
2037FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
2038TYPE(vol7d_var),INTENT(in) :: varbufr
2039TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
2040TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
2041TYPE(volgrid6d_var) :: convert
2042
2043INTEGER :: i
2044#ifdef HAVE_LIBGRIBAPI
2045INTEGER :: gaid, editionnumber, category, centre
2046#endif
2047
2048IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
2049
2050#ifdef HAVE_LIBGRIBAPI
2051editionnumber=255; category=255; centre=255
2052#endif
2053IF (PRESENT(grid_id_template)) THEN
2054#ifdef HAVE_LIBGRIBAPI
2055 gaid = grid_id_get_gaid(grid_id_template)
2056 IF (c_e(gaid)) THEN
2057 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
2058 IF (editionnumber == 1) THEN
2059 CALL grib_get(gaid,'gribTablesVersionNo',category)
2060 ENDIF
2061 CALL grib_get(gaid,'centre',centre)
2062 ENDIF
2063#endif
2064ENDIF
2065
2066DO i = 1, SIZE(conv_bwd)
2067 IF (varbufr == conv_bwd(i)%v7d_var) THEN
2068#ifdef HAVE_LIBGRIBAPI
2069 IF (editionnumber /= 255) THEN ! further check required (gaid present)
2070 IF (editionnumber == 1) THEN
2071 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
2072 ELSE IF (editionnumber == 2) THEN
2073 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
2074 ENDIF
2075 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
2076 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
2077 ENDIF
2078#endif
2079 convert = conv_bwd(i)%vg6d_var
2080 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
2081 RETURN
2082 ENDIF
2083ENDDO
2084! not found
2085convert = volgrid6d_var_miss
2086IF (PRESENT(c_func)) c_func = conv_func_miss
2087
2088! if hint available use it as a fallback
2089IF (any(varbufr%gribhint /= imiss)) THEN
2090 convert%centre = varbufr%gribhint(1)
2091 convert%category = varbufr%gribhint(2)
2092 convert%number = varbufr%gribhint(3)
2093 convert%discipline = varbufr%gribhint(4)
2094ENDIF
2095
2096CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
2097 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
2098 ' not found in table')
2099
2100END FUNCTION varbufr2vargrib_convert
2101
2102
2110SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
2111TYPE(volgrid6d_var),INTENT(inout) :: this
2112TYPE(conv_func),INTENT(out) :: c_func
2113TYPE(grid_id),INTENT(in) :: grid_id_template
2114
2115LOGICAL :: eqed, eqcentre
2116INTEGER :: gaid, editionnumber, centre
2117TYPE(volgrid6d_var) :: tmpgrib
2118TYPE(vol7d_var) :: tmpbufr
2119TYPE(conv_func) tmpc_func1, tmpc_func2
2120
2121eqed = .true.
2122eqcentre = .true.
2123c_func = conv_func_miss
2124
2125#ifdef HAVE_LIBGRIBAPI
2126gaid = grid_id_get_gaid(grid_id_template)
2127IF (c_e(gaid)) THEN
2128 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
2129 CALL grib_get(gaid, 'centre', centre)
2130 eqed = editionnumber == 1 .EQV. this%discipline == 255
2131 eqcentre = centre == this%centre
2132ENDIF
2133#endif
2134
2135IF (eqed .AND. eqcentre) RETURN ! nothing to do
2136
2137tmpbufr = convert(this, tmpc_func1)
2138tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
2139
2140IF (tmpgrib /= volgrid6d_var_miss) THEN
2141! conversion back and forth successful, set also conversion function
2142 this = tmpgrib
2143 c_func = tmpc_func1 * tmpc_func2
2144! set to missing in common case to avoid useless computation
2145 IF (c_func == conv_func_identity) c_func = conv_func_miss
2146ELSE IF (.NOT.eqed) THEN
2147! conversion back and forth unsuccessful and grib edition incompatible, set to miss
2148 this = tmpgrib
2149ENDIF
2150
2151END SUBROUTINE volgrid6d_var_normalize
2152
2153
2154! Private subroutine for reading forward and backward conversion tables
2155! todo: better error handling
2156SUBROUTINE vg6d_v7d_var_conv_setup()
2157INTEGER :: un, i, n, stallo
2158
2159! forward, grib to bufr
2160un = open_package_file('vargrib2bufr.csv', filetype_data)
2161n=0
2162DO WHILE(.true.)
2163 READ(un,*,END=100)
2164 n = n + 1
2165ENDDO
2166
2167100 CONTINUE
2168
2169rewind(un)
2170ALLOCATE(conv_fwd(n),stat=stallo)
2171IF (stallo /= 0) THEN
2172 CALL l4f_log(l4f_fatal,"allocating memory")
2173 CALL raise_fatal_error()
2174ENDIF
2175
2176conv_fwd(:) = vg6d_v7d_var_conv_miss
2177CALL import_var_conv(un, conv_fwd)
2178CLOSE(un)
2179
2180! backward, bufr to grib
2181un = open_package_file('vargrib2bufr.csv', filetype_data)
2182! use the same file for now
2183!un = open_package_file('varbufr2grib.csv', filetype_data)
2184n=0
2185DO WHILE(.true.)
2186 READ(un,*,END=300)
2187 n = n + 1
2188ENDDO
2189
2190300 CONTINUE
2191
2192rewind(un)
2193ALLOCATE(conv_bwd(n),stat=stallo)
2194IF (stallo /= 0) THEN
2195 CALL l4f_log(l4f_fatal,"allocating memory")
2196 CALL raise_fatal_error()
2197end if
2198
2199conv_bwd(:) = vg6d_v7d_var_conv_miss
2200CALL import_var_conv(un, conv_bwd)
2201DO i = 1, n
2202 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
2203 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
2204ENDDO
2205CLOSE(un)
2206
2207CONTAINS
2208
2209SUBROUTINE import_var_conv(un, conv_type)
2210INTEGER, INTENT(in) :: un
2211TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
2212
2213INTEGER :: i
2214TYPE(csv_record) :: csv
2215CHARACTER(len=1024) :: line
2216CHARACTER(len=10) :: btable
2217INTEGER :: centre, category, number, discipline
2218
2219DO i = 1, SIZE(conv_type)
2220 READ(un,'(A)',END=200)line
2221 CALL init(csv, line)
2222 CALL csv_record_getfield(csv, btable)
2223 CALL csv_record_getfield(csv) ! skip fields for description and unit,
2224 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
2225 CALL init(conv_type(i)%v7d_var, btable=btable)
2226
2227 CALL csv_record_getfield(csv, centre)
2228 CALL csv_record_getfield(csv, category)
2229 CALL csv_record_getfield(csv, number)
2230 CALL csv_record_getfield(csv, discipline)
2231 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
2232 number=number, discipline=discipline) ! controllare l'ordine
2233
2234 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
2235 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
2236 CALL delete(csv)
2237ENDDO
2238
2239200 CONTINUE
2240
2241END SUBROUTINE import_var_conv
2242
2243END SUBROUTINE vg6d_v7d_var_conv_setup
2244
2245
2246ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
2247TYPE(conv_func),INTENT(IN) :: this, that
2248LOGICAL :: res
2249
2250res = this%a == that%a .AND. this%b == that%b
2251
2252END FUNCTION conv_func_eq
2253
2254
2255ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
2256TYPE(conv_func),INTENT(IN) :: this, that
2257LOGICAL :: res
2258
2259res = .NOT.(this == that)
2260
2261END FUNCTION conv_func_ne
2262
2263
2264FUNCTION conv_func_mult(this, that) RESULT(mult)
2265TYPE(conv_func),INTENT(in) :: this
2266TYPE(conv_func),INTENT(in) :: that
2267
2268TYPE(conv_func) :: mult
2269
2270IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
2271 mult = conv_func_miss
2272ELSE
2273 mult%a = this%a*that%a
2274 mult%b = this%a*that%b+this%b
2275ENDIF
2276
2277END FUNCTION conv_func_mult
2278
2286ELEMENTAL SUBROUTINE conv_func_compute(this, values)
2287TYPE(conv_func),INTENT(in) :: this
2288REAL,INTENT(inout) :: values
2289
2290IF (this /= conv_func_miss) THEN
2291 IF (c_e(values)) values = values*this%a + this%b
2292ELSE
2293 values=rmiss
2294ENDIF
2295
2296END SUBROUTINE conv_func_compute
2297
2298
2306ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
2307TYPE(conv_func),intent(in) :: this
2308REAL,INTENT(in) :: values
2309REAL :: convert
2310
2311convert = values
2312CALL compute(this, convert)
2313
2314END FUNCTION conv_func_convert
2315
2316
2330SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
2331TYPE(volgrid6d_var),INTENT(in) :: this(:)
2332INTEGER,POINTER :: xind(:), yind(:)
2333
2334TYPE(vol7d_var) :: varbufr(SIZE(this))
2335TYPE(conv_func),POINTER :: c_func(:)
2336INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
2337
2338NULLIFY(xind, yind)
2339counts(:) = 0
2340
2341CALL vargrib2varbufr(this, varbufr, c_func)
2342
2343DO i = 1, SIZE(vol7d_var_horcomp)
2344 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
2345ENDDO
2346
2347IF (any(counts(1::2) > 1)) THEN
2348 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
2349 DEALLOCATE(c_func)
2350 RETURN
2351ENDIF
2352IF (any(counts(2::2) > 1)) THEN
2353 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
2354 DEALLOCATE(c_func)
2355 RETURN
2356ENDIF
2357
2358! check that variables are paired and count pairs
2359nv = 0
2360DO i = 1, SIZE(vol7d_var_horcomp), 2
2361 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
2362 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
2363 ' present but the corresponding x-component '// &
2364 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
2365 RETURN
2366 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
2367 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
2368 ' present but the corresponding y-component '// &
2369 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
2370 RETURN
2371 ENDIF
2372 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
2373ENDDO
2374
2375! repeat the loop storing indices
2376ALLOCATE(xind(nv), yind(nv))
2377nv = 0
2378DO i = 1, SIZE(vol7d_var_horcomp), 2
2379 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
2380 nv = nv + 1
2381 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
2382 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
2383 ENDIF
2384ENDDO
2385DEALLOCATE(c_func)
2386
2387END SUBROUTINE volgrid6d_var_hor_comp_index
2388
2389
2394FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
2395TYPE(volgrid6d_var),INTENT(in) :: this
2396LOGICAL :: is_hor_comp
2397
2398TYPE(vol7d_var) :: varbufr
2399
2400varbufr = convert(this)
2401is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
2402
2403END FUNCTION volgrid6d_var_is_hor_comp
2404
2405! before unstaggering??
2406
2407!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
2408!
2409!call init(varu,btable="B11003")
2410!call init(varv,btable="B11004")
2411!
2412! test about presence of u and v in standard table
2413!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
2414! call l4f_category_log(this%category,L4F_FATAL, &
2415! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
2416! CALL raise_error()
2417! RETURN
2418!end if
2419!
2420!if (associated(this%var))then
2421! nvar=size(this%var)
2422! allocate(varbufr(nvar),stat=stallo)
2423! if (stallo /=0)then
2424! call l4f_log(L4F_FATAL,"allocating memory")
2425! call raise_fatal_error("allocating memory")
2426! end if
2427!
2428! CALL vargrib2varbufr(this%var, varbufr)
2429!ELSE
2430! CALL l4f_category_log(this%category, L4F_ERROR, &
2431! "trying to destagger an incomplete volgrid6d object")
2432! CALL raise_error()
2433! RETURN
2434!end if
2435!
2436!nvaru=COUNT(varbufr==varu)
2437!nvarv=COUNT(varbufr==varv)
2438!
2439!if (nvaru > 1 )then
2440! call l4f_category_log(this%category,L4F_WARN, &
2441! ">1 variables refer to u wind component, destaggering will not be done ")
2442! DEALLOCATE(varbufr)
2443! RETURN
2444!endif
2445!
2446!if (nvarv > 1 )then
2447! call l4f_category_log(this%category,L4F_WARN, &
2448! ">1 variables refer to v wind component, destaggering will not be done ")
2449! DEALLOCATE(varbufr)
2450! RETURN
2451!endif
2452!
2453!if (nvaru == 0 .and. nvarv == 0) then
2454! call l4f_category_log(this%category,L4F_WARN, &
2455! "no u or v wind component found in volume, nothing to do")
2456! DEALLOCATE(varbufr)
2457! RETURN
2458!endif
2459!
2460!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2461! call l4f_category_log(this%category,L4F_WARN, &
2462! "there are variables different from u and v wind component in C grid")
2463!endif
2464
2465
2466END 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:251
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.