libsim Versione 7.1.11
|
◆ volgrid6d_var_hor_comp_index()
Locate variables which are horizontal components of a vector field. This method scans the volgrid6d_var array provided and locates pairs of variables which are x and y component of the same vector field. On exit, the arrays \x xind(:) and yind(:) are allocated to a size equal to the number of vector fields detected and their corresponding elements will point to x and y components of the same vector field. If inconsistencies are found, e.g. only one component is detected for a field, or more than one input variable define the same component, then xind and xind are nullified, thus an error condition can be tested as
Definizione alla linea 1505 del file volgrid6d_var_class.F90. 1506! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1507! authors:
1508! Davide Cesari <dcesari@arpa.emr.it>
1509! Paolo Patruno <ppatruno@arpa.emr.it>
1510
1511! This program is free software; you can redistribute it and/or
1512! modify it under the terms of the GNU General Public License as
1513! published by the Free Software Foundation; either version 2 of
1514! the License, or (at your option) any later version.
1515
1516! This program is distributed in the hope that it will be useful,
1517! but WITHOUT ANY WARRANTY; without even the implied warranty of
1518! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1519! GNU General Public License for more details.
1520
1521! You should have received a copy of the GNU General Public License
1522! along with this program. If not, see <http://www.gnu.org/licenses/>.
1523#include "config.h"
1524
1542
1543IMPLICIT NONE
1544
1550 integer :: centre
1551 integer :: category
1552 integer :: number
1553 integer :: discipline
1554 CHARACTER(len=65) :: description
1555 CHARACTER(len=24) :: unit
1557
1558TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1559 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1560
1561TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1564 /)
1565
1566TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1571/)
1572!/), (/2,2/)) ! bug in gfortran
1573
1583 PRIVATE
1584 REAL :: a, b
1586
1589
1590TYPE vg6d_v7d_var_conv
1591 TYPE(volgrid6d_var) :: vg6d_var
1592 TYPE(vol7d_var) :: v7d_var
1593 TYPE(conv_func) :: c_func
1594! aggiungere informazioni ad es. su rotazione del vento
1595END TYPE vg6d_v7d_var_conv
1596
1597TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1598 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1599
1600TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1601
1616 MODULE PROCEDURE volgrid6d_var_init
1617END INTERFACE
1618
1622 MODULE PROCEDURE volgrid6d_var_delete
1623END INTERFACE
1624
1625INTERFACE c_e
1626 MODULE PROCEDURE volgrid6d_var_c_e
1627END INTERFACE
1628
1629
1634INTERFACE OPERATOR (==)
1635 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1636END INTERFACE
1637
1642INTERFACE OPERATOR (/=)
1643 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1644END INTERFACE
1645
1646#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1647#define VOL7D_POLY_TYPES _var6d
1648#include "array_utilities_pre.F90"
1649
1652 MODULE PROCEDURE display_volgrid6d_var
1653END INTERFACE
1654
1659INTERFACE OPERATOR (*)
1660 MODULE PROCEDURE conv_func_mult
1661END INTERFACE OPERATOR (*)
1662
1666 MODULE PROCEDURE conv_func_compute
1667END INTERFACE
1668
1672 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1673 conv_func_convert
1674END INTERFACE
1675
1676PRIVATE
1678 c_e, volgrid6d_var_normalize, &
1679 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1680 count_distinct, pack_distinct, count_and_pack_distinct, &
1681 map_distinct, map_inv_distinct, &
1683 vargrib2varbufr, varbufr2vargrib, &
1685 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1686
1687
1688CONTAINS
1689
1690
1691ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1692 discipline, description, unit) RESULT(this)
1693integer,INTENT(in),OPTIONAL :: centre
1694integer,INTENT(in),OPTIONAL :: category
1695integer,INTENT(in),OPTIONAL :: number
1696integer,INTENT(in),OPTIONAL :: discipline
1697CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1698CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1699
1700TYPE(volgrid6d_var) :: this
1701
1703
1704END FUNCTION volgrid6d_var_new
1705
1706
1707! documented in the interface
1708ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1709TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1710INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1711INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1712INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1713INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1714CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1715CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1716
1717IF (PRESENT(centre)) THEN
1718 this%centre = centre
1719ELSE
1720 this%centre = imiss
1721 this%category = imiss
1722 this%number = imiss
1723 this%discipline = imiss
1724 RETURN
1725ENDIF
1726
1727IF (PRESENT(category)) THEN
1728 this%category = category
1729ELSE
1730 this%category = imiss
1731 this%number = imiss
1732 this%discipline = imiss
1733 RETURN
1734ENDIF
1735
1736
1737IF (PRESENT(number)) THEN
1738 this%number = number
1739ELSE
1740 this%number = imiss
1741 this%discipline = imiss
1742 RETURN
1743ENDIF
1744
1745! se sono arrivato fino a qui ho impostato centre, category e number
1746!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1747
1748IF (PRESENT(discipline)) THEN
1749 this%discipline = discipline
1750ELSE
1751 this%discipline = 255
1752ENDIF
1753
1754IF (PRESENT(description)) THEN
1755 this%description = description
1756ELSE
1757 this%description = cmiss
1758ENDIF
1759
1760IF (PRESENT(unit)) THEN
1761 this%unit = unit
1762ELSE
1763 this%unit = cmiss
1764ENDIF
1765
1766
1767
1768END SUBROUTINE volgrid6d_var_init
1769
1770
1771! documented in the interface
1772SUBROUTINE volgrid6d_var_delete(this)
1773TYPE(volgrid6d_var),INTENT(INOUT) :: this
1774
1775this%centre = imiss
1776this%category = imiss
1777this%number = imiss
1778this%discipline = imiss
1779this%description = cmiss
1780this%unit = cmiss
1781
1782END SUBROUTINE volgrid6d_var_delete
1783
1784
1785ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1786TYPE(volgrid6d_var),INTENT(IN) :: this
1787LOGICAL :: c_e
1788c_e = this /= volgrid6d_var_miss
1789END FUNCTION volgrid6d_var_c_e
1790
1791
1792ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1793TYPE(volgrid6d_var),INTENT(IN) :: this, that
1794LOGICAL :: res
1795
1796IF (this%discipline == that%discipline) THEN
1797
1798 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1799 res = ((this%category == that%category) .OR. &
1800 (this%category >= 1 .AND. this%category <=3 .AND. &
1801 that%category >= 1 .AND. that%category <=3)) .AND. &
1802 this%number == that%number
1803
1804 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1805 (this%number >= 128 .AND. this%number <= 254)) THEN
1806 res = res .AND. this%centre == that%centre ! local definition, centre matters
1807 ENDIF
1808
1809 ELSE ! grib2
1810 res = this%category == that%category .AND. &
1811 this%number == that%number
1812
1813 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1814 (this%category >= 192 .AND. this%category <= 254) .OR. &
1815 (this%number >= 192 .AND. this%number <= 254)) THEN
1816 res = res .AND. this%centre == that%centre ! local definition, centre matters
1817 ENDIF
1818 ENDIF
1819
1820ELSE ! different edition or different discipline
1821 res = .false.
1822ENDIF
1823
1824END FUNCTION volgrid6d_var_eq
1825
1826
1827ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1828TYPE(volgrid6d_var),INTENT(IN) :: this, that
1829LOGICAL :: res
1830
1831res = .NOT.(this == that)
1832
1833END FUNCTION volgrid6d_var_ne
1834
1835
1836#include "array_utilities_inc.F90"
1837
1838
1840SUBROUTINE display_volgrid6d_var(this)
1841TYPE(volgrid6d_var),INTENT(in) :: this
1842
1843print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1844
1845END SUBROUTINE display_volgrid6d_var
1846
1847
1860SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1861TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1862TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1863TYPE(conv_func),POINTER :: c_func(:)
1864
1865INTEGER :: i, n, stallo
1866
1867n = min(SIZE(varbufr), SIZE(vargrib))
1868ALLOCATE(c_func(n),stat=stallo)
1869IF (stallo /= 0) THEN
1870 call l4f_log(l4f_fatal,"allocating memory")
1871 call raise_fatal_error()
1872ENDIF
1873
1874DO i = 1, n
1875 varbufr(i) = convert(vargrib(i), c_func(i))
1876ENDDO
1877
1878END SUBROUTINE vargrib2varbufr
1879
1880
1891FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1892TYPE(volgrid6d_var),INTENT(in) :: vargrib
1893TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1894TYPE(vol7d_var) :: convert
1895
1896INTEGER :: i
1897
1898IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1899
1900DO i = 1, SIZE(conv_fwd)
1901 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1902 convert = conv_fwd(i)%v7d_var
1903 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1904 RETURN
1905 ENDIF
1906ENDDO
1907! not found
1908convert = vol7d_var_miss
1909IF (PRESENT(c_func)) c_func = conv_func_miss
1910
1911! set hint for backwards conversion
1912convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1913 vargrib%discipline/)
1914
1915CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1916 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1917 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1918 ' not found in table')
1919
1920END FUNCTION vargrib2varbufr_convert
1921
1922
1938SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1939TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1940TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1941TYPE(conv_func),POINTER :: c_func(:)
1942TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1943
1944INTEGER :: i, n, stallo
1945
1946n = min(SIZE(varbufr), SIZE(vargrib))
1947ALLOCATE(c_func(n),stat=stallo)
1948IF (stallo /= 0) THEN
1949 CALL l4f_log(l4f_fatal,"allocating memory")
1950 CALL raise_fatal_error()
1951ENDIF
1952
1953DO i = 1, n
1954 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1955ENDDO
1956
1957END SUBROUTINE varbufr2vargrib
1958
1959
1973FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1974TYPE(vol7d_var),INTENT(in) :: varbufr
1975TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1976TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1977TYPE(volgrid6d_var) :: convert
1978
1979INTEGER :: i
1980#ifdef HAVE_LIBGRIBAPI
1981INTEGER :: gaid, editionnumber, category, centre
1982#endif
1983
1984IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1985
1986#ifdef HAVE_LIBGRIBAPI
1987editionnumber=255; category=255; centre=255
1988#endif
1989IF (PRESENT(grid_id_template)) THEN
1990#ifdef HAVE_LIBGRIBAPI
1991 gaid = grid_id_get_gaid(grid_id_template)
1992 IF (c_e(gaid)) THEN
1993 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1994 IF (editionnumber == 1) THEN
1995 CALL grib_get(gaid,'gribTablesVersionNo',category)
1996 ENDIF
1997 CALL grib_get(gaid,'centre',centre)
1998 ENDIF
1999#endif
2000ENDIF
2001
2002DO i = 1, SIZE(conv_bwd)
2003 IF (varbufr == conv_bwd(i)%v7d_var) THEN
2004#ifdef HAVE_LIBGRIBAPI
2005 IF (editionnumber /= 255) THEN ! further check required (gaid present)
2006 IF (editionnumber == 1) THEN
2007 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
2008 ELSE IF (editionnumber == 2) THEN
2009 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
2010 ENDIF
2011 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
2012 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
2013 ENDIF
2014#endif
2015 convert = conv_bwd(i)%vg6d_var
2016 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
2017 RETURN
2018 ENDIF
2019ENDDO
2020! not found
2021convert = volgrid6d_var_miss
2022IF (PRESENT(c_func)) c_func = conv_func_miss
2023
2024! if hint available use it as a fallback
2025IF (any(varbufr%gribhint /= imiss)) THEN
2026 convert%centre = varbufr%gribhint(1)
2027 convert%category = varbufr%gribhint(2)
2028 convert%number = varbufr%gribhint(3)
2029 convert%discipline = varbufr%gribhint(4)
2030ENDIF
2031
2032CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
2033 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
2034 ' not found in table')
2035
2036END FUNCTION varbufr2vargrib_convert
2037
2038
2046SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
2047TYPE(volgrid6d_var),INTENT(inout) :: this
2048TYPE(conv_func),INTENT(out) :: c_func
2049TYPE(grid_id),INTENT(in) :: grid_id_template
2050
2051LOGICAL :: eqed, eqcentre
2052INTEGER :: gaid, editionnumber, centre
2053TYPE(volgrid6d_var) :: tmpgrib
2054TYPE(vol7d_var) :: tmpbufr
2055TYPE(conv_func) tmpc_func1, tmpc_func2
2056
2057eqed = .true.
2058eqcentre = .true.
2059c_func = conv_func_miss
2060
2061#ifdef HAVE_LIBGRIBAPI
2062gaid = grid_id_get_gaid(grid_id_template)
2063IF (c_e(gaid)) THEN
2064 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
2065 CALL grib_get(gaid, 'centre', centre)
2066 eqed = editionnumber == 1 .EQV. this%discipline == 255
2067 eqcentre = centre == this%centre
2068ENDIF
2069#endif
2070
2071IF (eqed .AND. eqcentre) RETURN ! nothing to do
2072
2073tmpbufr = convert(this, tmpc_func1)
2074tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
2075
2076IF (tmpgrib /= volgrid6d_var_miss) THEN
2077! conversion back and forth successful, set also conversion function
2078 this = tmpgrib
2079 c_func = tmpc_func1 * tmpc_func2
2080! set to missing in common case to avoid useless computation
2081 IF (c_func == conv_func_identity) c_func = conv_func_miss
2082ELSE IF (.NOT.eqed) THEN
2083! conversion back and forth unsuccessful and grib edition incompatible, set to miss
2084 this = tmpgrib
2085ENDIF
2086
2087END SUBROUTINE volgrid6d_var_normalize
2088
2089
2090! Private subroutine for reading forward and backward conversion tables
2091! todo: better error handling
2092SUBROUTINE vg6d_v7d_var_conv_setup()
2093INTEGER :: un, i, n, stallo
2094
2095! forward, grib to bufr
2096un = open_package_file('vargrib2bufr.csv', filetype_data)
2097n=0
2098DO WHILE(.true.)
2099 READ(un,*,END=100)
2100 n = n + 1
2101ENDDO
2102
2103100 CONTINUE
2104
2105rewind(un)
2106ALLOCATE(conv_fwd(n),stat=stallo)
2107IF (stallo /= 0) THEN
2108 CALL l4f_log(l4f_fatal,"allocating memory")
2109 CALL raise_fatal_error()
2110ENDIF
2111
2112conv_fwd(:) = vg6d_v7d_var_conv_miss
2113CALL import_var_conv(un, conv_fwd)
2114CLOSE(un)
2115
2116! backward, bufr to grib
2117un = open_package_file('vargrib2bufr.csv', filetype_data)
2118! use the same file for now
2119!un = open_package_file('varbufr2grib.csv', filetype_data)
2120n=0
2121DO WHILE(.true.)
2122 READ(un,*,END=300)
2123 n = n + 1
2124ENDDO
2125
2126300 CONTINUE
2127
2128rewind(un)
2129ALLOCATE(conv_bwd(n),stat=stallo)
2130IF (stallo /= 0) THEN
2131 CALL l4f_log(l4f_fatal,"allocating memory")
2132 CALL raise_fatal_error()
2133end if
2134
2135conv_bwd(:) = vg6d_v7d_var_conv_miss
2136CALL import_var_conv(un, conv_bwd)
2137DO i = 1, n
2138 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
2139 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
2140ENDDO
2141CLOSE(un)
2142
2143CONTAINS
2144
2145SUBROUTINE import_var_conv(un, conv_type)
2146INTEGER, INTENT(in) :: un
2147TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
2148
2149INTEGER :: i
2150TYPE(csv_record) :: csv
2151CHARACTER(len=1024) :: line
2152CHARACTER(len=10) :: btable
2153INTEGER :: centre, category, number, discipline
2154
2155DO i = 1, SIZE(conv_type)
2156 READ(un,'(A)',END=200)line
2158 CALL csv_record_getfield(csv, btable)
2159 CALL csv_record_getfield(csv) ! skip fields for description and unit,
2160 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
2162
2163 CALL csv_record_getfield(csv, centre)
2164 CALL csv_record_getfield(csv, category)
2165 CALL csv_record_getfield(csv, number)
2166 CALL csv_record_getfield(csv, discipline)
2168 number=number, discipline=discipline) ! controllare l'ordine
2169
2170 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
2171 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
2173ENDDO
2174
2175200 CONTINUE
2176
2177END SUBROUTINE import_var_conv
2178
2179END SUBROUTINE vg6d_v7d_var_conv_setup
2180
2181
2182ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
2183TYPE(conv_func),INTENT(IN) :: this, that
2184LOGICAL :: res
2185
2186res = this%a == that%a .AND. this%b == that%b
2187
2188END FUNCTION conv_func_eq
2189
2190
2191ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
2192TYPE(conv_func),INTENT(IN) :: this, that
2193LOGICAL :: res
2194
2195res = .NOT.(this == that)
2196
2197END FUNCTION conv_func_ne
2198
2199
2200FUNCTION conv_func_mult(this, that) RESULT(mult)
2201TYPE(conv_func),INTENT(in) :: this
2202TYPE(conv_func),INTENT(in) :: that
2203
2204TYPE(conv_func) :: mult
2205
2206IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
2207 mult = conv_func_miss
2208ELSE
2209 mult%a = this%a*that%a
2210 mult%b = this%a*that%b+this%b
2211ENDIF
2212
2213END FUNCTION conv_func_mult
2214
2222ELEMENTAL SUBROUTINE conv_func_compute(this, values)
2223TYPE(conv_func),INTENT(in) :: this
2224REAL,INTENT(inout) :: values
2225
2226IF (this /= conv_func_miss) THEN
2227 IF (c_e(values)) values = values*this%a + this%b
2228ELSE
2229 values=rmiss
2230ENDIF
2231
2232END SUBROUTINE conv_func_compute
2233
2234
2242ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
2243TYPE(conv_func),intent(in) :: this
2244REAL,INTENT(in) :: values
2245REAL :: convert
2246
2247convert = values
2249
2250END FUNCTION conv_func_convert
2251
2252
2266SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
2267TYPE(volgrid6d_var),INTENT(in) :: this(:)
2268INTEGER,POINTER :: xind(:), yind(:)
2269
2270TYPE(vol7d_var) :: varbufr(SIZE(this))
2271TYPE(conv_func),POINTER :: c_func(:)
2272INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
2273
2274NULLIFY(xind, yind)
2275counts(:) = 0
2276
2277CALL vargrib2varbufr(this, varbufr, c_func)
2278
2279DO i = 1, SIZE(vol7d_var_horcomp)
2280 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
2281ENDDO
2282
2283IF (any(counts(1::2) > 1)) THEN
2284 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
2285 DEALLOCATE(c_func)
2286 RETURN
2287ENDIF
2288IF (any(counts(2::2) > 1)) THEN
2289 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
2290 DEALLOCATE(c_func)
2291 RETURN
2292ENDIF
2293
2294! check that variables are paired and count pairs
2295nv = 0
2296DO i = 1, SIZE(vol7d_var_horcomp), 2
2297 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
2298 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
2299 ' present but the corresponding x-component '// &
2300 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
2301 RETURN
2302 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
2303 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
2304 ' present but the corresponding y-component '// &
2305 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
2306 RETURN
2307 ENDIF
2308 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
2309ENDDO
2310
2311! repeat the loop storing indices
2312ALLOCATE(xind(nv), yind(nv))
2313nv = 0
2314DO i = 1, SIZE(vol7d_var_horcomp), 2
2315 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
2316 nv = nv + 1
2317 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
2318 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
2319 ENDIF
2320ENDDO
2321DEALLOCATE(c_func)
2322
2323END SUBROUTINE volgrid6d_var_hor_comp_index
2324
2325
2330FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
2331TYPE(volgrid6d_var),INTENT(in) :: this
2332LOGICAL :: is_hor_comp
2333
2334TYPE(vol7d_var) :: varbufr
2335
2336varbufr = convert(this)
2337is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
2338
2339END FUNCTION volgrid6d_var_is_hor_comp
2340
2341! before unstaggering??
2342
2343!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
2344!
2345!call init(varu,btable="B11003")
2346!call init(varv,btable="B11004")
2347!
2348! test about presence of u and v in standard table
2349!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
2350! call l4f_category_log(this%category,L4F_FATAL, &
2351! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
2352! CALL raise_error()
2353! RETURN
2354!end if
2355!
2356!if (associated(this%var))then
2357! nvar=size(this%var)
2358! allocate(varbufr(nvar),stat=stallo)
2359! if (stallo /=0)then
2360! call l4f_log(L4F_FATAL,"allocating memory")
2361! call raise_fatal_error("allocating memory")
2362! end if
2363!
2364! CALL vargrib2varbufr(this%var, varbufr)
2365!ELSE
2366! CALL l4f_category_log(this%category, L4F_ERROR, &
2367! "trying to destagger an incomplete volgrid6d object")
2368! CALL raise_error()
2369! RETURN
2370!end if
2371!
2372!nvaru=COUNT(varbufr==varu)
2373!nvarv=COUNT(varbufr==varv)
2374!
2375!if (nvaru > 1 )then
2376! call l4f_category_log(this%category,L4F_WARN, &
2377! ">1 variables refer to u wind component, destaggering will not be done ")
2378! DEALLOCATE(varbufr)
2379! RETURN
2380!endif
2381!
2382!if (nvarv > 1 )then
2383! call l4f_category_log(this%category,L4F_WARN, &
2384! ">1 variables refer to v wind component, destaggering will not be done ")
2385! DEALLOCATE(varbufr)
2386! RETURN
2387!endif
2388!
2389!if (nvaru == 0 .and. nvarv == 0) then
2390! call l4f_category_log(this%category,L4F_WARN, &
2391! "no u or v wind component found in volume, nothing to do")
2392! DEALLOCATE(varbufr)
2393! RETURN
2394!endif
2395!
2396!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2397! call l4f_category_log(this%category,L4F_WARN, &
2398! "there are variables different from u and v wind component in C grid")
2399!endif
2400
2401
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 |