libsim Versione 7.2.4

◆ 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
1594USE kinds
1596USE err_handling
1599USE grid_id_class
1600
1601IMPLICIT NONE
1602
1607TYPE volgrid6d_var
1608 integer :: centre
1609 integer :: category
1610 integer :: number
1611 integer :: discipline
1612 CHARACTER(len=65) :: description
1613 CHARACTER(len=24) :: unit
1614END TYPE volgrid6d_var
1615
1616TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1617 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
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
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
1673INTERFACE init
1674 MODULE PROCEDURE volgrid6d_var_init
1675END INTERFACE
1676
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
1692INTERFACE OPERATOR (==)
1693 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1694END INTERFACE
1695
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
1709INTERFACE display
1710 MODULE PROCEDURE display_volgrid6d_var
1711END INTERFACE
1712
1717INTERFACE OPERATOR (*)
1718 MODULE PROCEDURE conv_func_mult
1719END INTERFACE OPERATOR (*)
1720
1723INTERFACE compute
1724 MODULE PROCEDURE conv_func_compute
1725END INTERFACE
1726
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
1752integer,INTENT(in),OPTIONAL :: category
1753integer,INTENT(in),OPTIONAL :: number
1754integer,INTENT(in),OPTIONAL :: discipline
1755CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1756CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1757
1758TYPE(volgrid6d_var) :: this
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
1898SUBROUTINE display_volgrid6d_var(this)
1899TYPE(volgrid6d_var),INTENT(in) :: this
1900
1901print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1902
1903END SUBROUTINE display_volgrid6d_var
1904
1905
1918SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1919TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1920TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1921TYPE(conv_func),POINTER :: c_func(:)
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
1949FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1950TYPE(volgrid6d_var),INTENT(in) :: vargrib
1951TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
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
1996SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1997TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1998TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1999TYPE(conv_func),POINTER :: c_func(:)
2000TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
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
2031FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
2032TYPE(vol7d_var),INTENT(in) :: varbufr
2033TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
2034TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
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
2104SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
2105TYPE(volgrid6d_var),INTENT(inout) :: this
2106TYPE(conv_func),INTENT(out) :: c_func
2107TYPE(grid_id),INTENT(in) :: grid_id_template
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
2280ELEMENTAL SUBROUTINE conv_func_compute(this, values)
2281TYPE(conv_func),INTENT(in) :: this
2282REAL,INTENT(inout) :: values
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
2300ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
2301TYPE(conv_func),intent(in) :: this
2302REAL,INTENT(in) :: values
2303REAL :: convert
2304
2305convert = values
2306CALL compute(this, convert)
2307
2308END FUNCTION conv_func_convert
2309
2310
2324SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
2325TYPE(volgrid6d_var),INTENT(in) :: this(:)
2326INTEGER,POINTER :: xind(:), yind(:)
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
2388FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
2389TYPE(volgrid6d_var),INTENT(in) :: this
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.