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