libsim Versione 7.2.1
|
◆ 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 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
1600
1601IMPLICIT NONE
1602
1608 integer :: centre
1609 integer :: category
1610 integer :: number
1611 integer :: discipline
1612 CHARACTER(len=65) :: description
1613 CHARACTER(len=24) :: unit
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) = (/ &
1622 /)
1623
1624TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1629/)
1630!/), (/2,2/)) ! bug in gfortran
1631
1641 PRIVATE
1642 REAL :: a, b
1644
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
1674 MODULE PROCEDURE volgrid6d_var_init
1675END INTERFACE
1676
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
1710 MODULE PROCEDURE display_volgrid6d_var
1711END INTERFACE
1712
1717INTERFACE OPERATOR (*)
1718 MODULE PROCEDURE conv_func_mult
1719END INTERFACE OPERATOR (*)
1720
1724 MODULE PROCEDURE conv_func_compute
1725END INTERFACE
1726
1730 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1731 conv_func_convert
1732END INTERFACE
1733
1734PRIVATE
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, &
1741 vargrib2varbufr, varbufr2vargrib, &
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
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
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
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)
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)
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
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
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 |