libsim Versione 7.1.11
|
◆ volgrid6d_var_is_hor_comp()
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.
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
1606
1607IMPLICIT NONE
1608
1614 integer :: centre
1615 integer :: category
1616 integer :: number
1617 integer :: discipline
1618 CHARACTER(len=65) :: description
1619 CHARACTER(len=24) :: unit
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) = (/ &
1628 /)
1629
1630TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1635/)
1636!/), (/2,2/)) ! bug in gfortran
1637
1647 PRIVATE
1648 REAL :: a, b
1650
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
1680 MODULE PROCEDURE volgrid6d_var_init
1681END INTERFACE
1682
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
1716 MODULE PROCEDURE display_volgrid6d_var
1717END INTERFACE
1718
1723INTERFACE OPERATOR (*)
1724 MODULE PROCEDURE conv_func_mult
1725END INTERFACE OPERATOR (*)
1726
1730 MODULE PROCEDURE conv_func_compute
1731END INTERFACE
1732
1736 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1737 conv_func_convert
1738END INTERFACE
1739
1740PRIVATE
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, &
1747 vargrib2varbufr, varbufr2vargrib, &
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
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
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
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)
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)
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
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
Apply the conversion function this to values. Definition: volgrid6d_var_class.F90:396 Apply the conversion function this to values. Definition: volgrid6d_var_class.F90:402 Destructor for the corresponding object, it assigns it to a missing value. Definition: volgrid6d_var_class.F90:310 Display on the screen a brief content of object. Definition: volgrid6d_var_class.F90:382 Initialize a volgrid6d_var object with the optional arguments provided. Definition: volgrid6d_var_class.F90:304 This module defines an abstract interface to different drivers for access to files containing gridded... Definition: grid_id_class.F90:255 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. Definition: missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition: vol7d_var_class.F90:218 Class for managing physical variables in a grib 1/2 fashion. Definition: volgrid6d_var_class.F90:224 Definisce una variabile meteorologica osservata o un suo attributo. Definition: vol7d_var_class.F90:232 Class defining a real conversion function between units. Definition: volgrid6d_var_class.F90:271 Definition of a physical variable in grib coding style. Definition: volgrid6d_var_class.F90:238 |