libsim Versione 7.2.1
|
◆ conv_func_convert()
Return a copy of values converted by applying the conversion function this. The numerical conversion (only linear at the moment) defined by the conv_func object this is applied to the values argument and the converted result is returned; missing values remain missing; if the conversion function is undefined (conv_func_miss) the values are unchanged. The method is
Definizione alla linea 1475 del file volgrid6d_var_class.F90. 1476! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1477! authors:
1478! Davide Cesari <dcesari@arpa.emr.it>
1479! Paolo Patruno <ppatruno@arpa.emr.it>
1480
1481! This program is free software; you can redistribute it and/or
1482! modify it under the terms of the GNU General Public License as
1483! published by the Free Software Foundation; either version 2 of
1484! the License, or (at your option) any later version.
1485
1486! This program is distributed in the hope that it will be useful,
1487! but WITHOUT ANY WARRANTY; without even the implied warranty of
1488! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1489! GNU General Public License for more details.
1490
1491! You should have received a copy of the GNU General Public License
1492! along with this program. If not, see <http://www.gnu.org/licenses/>.
1493#include "config.h"
1494
1512
1513IMPLICIT NONE
1514
1520 integer :: centre
1521 integer :: category
1522 integer :: number
1523 integer :: discipline
1524 CHARACTER(len=65) :: description
1525 CHARACTER(len=24) :: unit
1527
1528TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1529 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1530
1531TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1534 /)
1535
1536TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1541/)
1542!/), (/2,2/)) ! bug in gfortran
1543
1553 PRIVATE
1554 REAL :: a, b
1556
1559
1560TYPE vg6d_v7d_var_conv
1561 TYPE(volgrid6d_var) :: vg6d_var
1562 TYPE(vol7d_var) :: v7d_var
1563 TYPE(conv_func) :: c_func
1564! aggiungere informazioni ad es. su rotazione del vento
1565END TYPE vg6d_v7d_var_conv
1566
1567TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1568 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1569
1570TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1571
1586 MODULE PROCEDURE volgrid6d_var_init
1587END INTERFACE
1588
1592 MODULE PROCEDURE volgrid6d_var_delete
1593END INTERFACE
1594
1595INTERFACE c_e
1596 MODULE PROCEDURE volgrid6d_var_c_e
1597END INTERFACE
1598
1599
1604INTERFACE OPERATOR (==)
1605 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1606END INTERFACE
1607
1612INTERFACE OPERATOR (/=)
1613 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1614END INTERFACE
1615
1616#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1617#define VOL7D_POLY_TYPES _var6d
1618#include "array_utilities_pre.F90"
1619
1622 MODULE PROCEDURE display_volgrid6d_var
1623END INTERFACE
1624
1629INTERFACE OPERATOR (*)
1630 MODULE PROCEDURE conv_func_mult
1631END INTERFACE OPERATOR (*)
1632
1636 MODULE PROCEDURE conv_func_compute
1637END INTERFACE
1638
1642 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1643 conv_func_convert
1644END INTERFACE
1645
1646PRIVATE
1648 c_e, volgrid6d_var_normalize, &
1649 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1650 count_distinct, pack_distinct, count_and_pack_distinct, &
1651 map_distinct, map_inv_distinct, &
1653 vargrib2varbufr, varbufr2vargrib, &
1655 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1656
1657
1658CONTAINS
1659
1660
1661ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1662 discipline, description, unit) RESULT(this)
1663integer,INTENT(in),OPTIONAL :: centre
1664integer,INTENT(in),OPTIONAL :: category
1665integer,INTENT(in),OPTIONAL :: number
1666integer,INTENT(in),OPTIONAL :: discipline
1667CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1668CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1669
1670TYPE(volgrid6d_var) :: this
1671
1673
1674END FUNCTION volgrid6d_var_new
1675
1676
1677! documented in the interface
1678ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1679TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1680INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1681INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1682INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1683INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1684CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1685CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1686
1687IF (PRESENT(centre)) THEN
1688 this%centre = centre
1689ELSE
1690 this%centre = imiss
1691 this%category = imiss
1692 this%number = imiss
1693 this%discipline = imiss
1694 RETURN
1695ENDIF
1696
1697IF (PRESENT(category)) THEN
1698 this%category = category
1699ELSE
1700 this%category = imiss
1701 this%number = imiss
1702 this%discipline = imiss
1703 RETURN
1704ENDIF
1705
1706
1707IF (PRESENT(number)) THEN
1708 this%number = number
1709ELSE
1710 this%number = imiss
1711 this%discipline = imiss
1712 RETURN
1713ENDIF
1714
1715! se sono arrivato fino a qui ho impostato centre, category e number
1716!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1717
1718IF (PRESENT(discipline)) THEN
1719 this%discipline = discipline
1720ELSE
1721 this%discipline = 255
1722ENDIF
1723
1724IF (PRESENT(description)) THEN
1725 this%description = description
1726ELSE
1727 this%description = cmiss
1728ENDIF
1729
1730IF (PRESENT(unit)) THEN
1731 this%unit = unit
1732ELSE
1733 this%unit = cmiss
1734ENDIF
1735
1736
1737
1738END SUBROUTINE volgrid6d_var_init
1739
1740
1741! documented in the interface
1742SUBROUTINE volgrid6d_var_delete(this)
1743TYPE(volgrid6d_var),INTENT(INOUT) :: this
1744
1745this%centre = imiss
1746this%category = imiss
1747this%number = imiss
1748this%discipline = imiss
1749this%description = cmiss
1750this%unit = cmiss
1751
1752END SUBROUTINE volgrid6d_var_delete
1753
1754
1755ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1756TYPE(volgrid6d_var),INTENT(IN) :: this
1757LOGICAL :: c_e
1758c_e = this /= volgrid6d_var_miss
1759END FUNCTION volgrid6d_var_c_e
1760
1761
1762ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1763TYPE(volgrid6d_var),INTENT(IN) :: this, that
1764LOGICAL :: res
1765
1766IF (this%discipline == that%discipline) THEN
1767
1768 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1769 res = ((this%category == that%category) .OR. &
1770 (this%category >= 1 .AND. this%category <=3 .AND. &
1771 that%category >= 1 .AND. that%category <=3)) .AND. &
1772 this%number == that%number
1773
1774 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1775 (this%number >= 128 .AND. this%number <= 254)) THEN
1776 res = res .AND. this%centre == that%centre ! local definition, centre matters
1777 ENDIF
1778
1779 ELSE ! grib2
1780 res = this%category == that%category .AND. &
1781 this%number == that%number
1782
1783 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1784 (this%category >= 192 .AND. this%category <= 254) .OR. &
1785 (this%number >= 192 .AND. this%number <= 254)) THEN
1786 res = res .AND. this%centre == that%centre ! local definition, centre matters
1787 ENDIF
1788 ENDIF
1789
1790ELSE ! different edition or different discipline
1791 res = .false.
1792ENDIF
1793
1794END FUNCTION volgrid6d_var_eq
1795
1796
1797ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1798TYPE(volgrid6d_var),INTENT(IN) :: this, that
1799LOGICAL :: res
1800
1801res = .NOT.(this == that)
1802
1803END FUNCTION volgrid6d_var_ne
1804
1805
1806#include "array_utilities_inc.F90"
1807
1808
1810SUBROUTINE display_volgrid6d_var(this)
1811TYPE(volgrid6d_var),INTENT(in) :: this
1812
1813print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1814
1815END SUBROUTINE display_volgrid6d_var
1816
1817
1830SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1831TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1832TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1833TYPE(conv_func),POINTER :: c_func(:)
1834
1835INTEGER :: i, n, stallo
1836
1837n = min(SIZE(varbufr), SIZE(vargrib))
1838ALLOCATE(c_func(n),stat=stallo)
1839IF (stallo /= 0) THEN
1840 call l4f_log(l4f_fatal,"allocating memory")
1841 call raise_fatal_error()
1842ENDIF
1843
1844DO i = 1, n
1845 varbufr(i) = convert(vargrib(i), c_func(i))
1846ENDDO
1847
1848END SUBROUTINE vargrib2varbufr
1849
1850
1861FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1862TYPE(volgrid6d_var),INTENT(in) :: vargrib
1863TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1864TYPE(vol7d_var) :: convert
1865
1866INTEGER :: i
1867
1868IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1869
1870DO i = 1, SIZE(conv_fwd)
1871 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1872 convert = conv_fwd(i)%v7d_var
1873 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1874 RETURN
1875 ENDIF
1876ENDDO
1877! not found
1878convert = vol7d_var_miss
1879IF (PRESENT(c_func)) c_func = conv_func_miss
1880
1881! set hint for backwards conversion
1882convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1883 vargrib%discipline/)
1884
1885CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1886 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1887 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1888 ' not found in table')
1889
1890END FUNCTION vargrib2varbufr_convert
1891
1892
1908SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1909TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1910TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1911TYPE(conv_func),POINTER :: c_func(:)
1912TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1913
1914INTEGER :: i, n, stallo
1915
1916n = min(SIZE(varbufr), SIZE(vargrib))
1917ALLOCATE(c_func(n),stat=stallo)
1918IF (stallo /= 0) THEN
1919 CALL l4f_log(l4f_fatal,"allocating memory")
1920 CALL raise_fatal_error()
1921ENDIF
1922
1923DO i = 1, n
1924 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1925ENDDO
1926
1927END SUBROUTINE varbufr2vargrib
1928
1929
1943FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1944TYPE(vol7d_var),INTENT(in) :: varbufr
1945TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1946TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1947TYPE(volgrid6d_var) :: convert
1948
1949INTEGER :: i
1950#ifdef HAVE_LIBGRIBAPI
1951INTEGER :: gaid, editionnumber, category, centre
1952#endif
1953
1954IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1955
1956#ifdef HAVE_LIBGRIBAPI
1957editionnumber=255; category=255; centre=255
1958#endif
1959IF (PRESENT(grid_id_template)) THEN
1960#ifdef HAVE_LIBGRIBAPI
1961 gaid = grid_id_get_gaid(grid_id_template)
1962 IF (c_e(gaid)) THEN
1963 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1964 IF (editionnumber == 1) THEN
1965 CALL grib_get(gaid,'gribTablesVersionNo',category)
1966 ENDIF
1967 CALL grib_get(gaid,'centre',centre)
1968 ENDIF
1969#endif
1970ENDIF
1971
1972DO i = 1, SIZE(conv_bwd)
1973 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1974#ifdef HAVE_LIBGRIBAPI
1975 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1976 IF (editionnumber == 1) THEN
1977 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1978 ELSE IF (editionnumber == 2) THEN
1979 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1980 ENDIF
1981 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1982 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1983 ENDIF
1984#endif
1985 convert = conv_bwd(i)%vg6d_var
1986 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1987 RETURN
1988 ENDIF
1989ENDDO
1990! not found
1991convert = volgrid6d_var_miss
1992IF (PRESENT(c_func)) c_func = conv_func_miss
1993
1994! if hint available use it as a fallback
1995IF (any(varbufr%gribhint /= imiss)) THEN
1996 convert%centre = varbufr%gribhint(1)
1997 convert%category = varbufr%gribhint(2)
1998 convert%number = varbufr%gribhint(3)
1999 convert%discipline = varbufr%gribhint(4)
2000ENDIF
2001
2002CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
2003 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
2004 ' not found in table')
2005
2006END FUNCTION varbufr2vargrib_convert
2007
2008
2016SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
2017TYPE(volgrid6d_var),INTENT(inout) :: this
2018TYPE(conv_func),INTENT(out) :: c_func
2019TYPE(grid_id),INTENT(in) :: grid_id_template
2020
2021LOGICAL :: eqed, eqcentre
2022INTEGER :: gaid, editionnumber, centre
2023TYPE(volgrid6d_var) :: tmpgrib
2024TYPE(vol7d_var) :: tmpbufr
2025TYPE(conv_func) tmpc_func1, tmpc_func2
2026
2027eqed = .true.
2028eqcentre = .true.
2029c_func = conv_func_miss
2030
2031#ifdef HAVE_LIBGRIBAPI
2032gaid = grid_id_get_gaid(grid_id_template)
2033IF (c_e(gaid)) THEN
2034 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
2035 CALL grib_get(gaid, 'centre', centre)
2036 eqed = editionnumber == 1 .EQV. this%discipline == 255
2037 eqcentre = centre == this%centre
2038ENDIF
2039#endif
2040
2041IF (eqed .AND. eqcentre) RETURN ! nothing to do
2042
2043tmpbufr = convert(this, tmpc_func1)
2044tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
2045
2046IF (tmpgrib /= volgrid6d_var_miss) THEN
2047! conversion back and forth successful, set also conversion function
2048 this = tmpgrib
2049 c_func = tmpc_func1 * tmpc_func2
2050! set to missing in common case to avoid useless computation
2051 IF (c_func == conv_func_identity) c_func = conv_func_miss
2052ELSE IF (.NOT.eqed) THEN
2053! conversion back and forth unsuccessful and grib edition incompatible, set to miss
2054 this = tmpgrib
2055ENDIF
2056
2057END SUBROUTINE volgrid6d_var_normalize
2058
2059
2060! Private subroutine for reading forward and backward conversion tables
2061! todo: better error handling
2062SUBROUTINE vg6d_v7d_var_conv_setup()
2063INTEGER :: un, i, n, stallo
2064
2065! forward, grib to bufr
2066un = open_package_file('vargrib2bufr.csv', filetype_data)
2067n=0
2068DO WHILE(.true.)
2069 READ(un,*,END=100)
2070 n = n + 1
2071ENDDO
2072
2073100 CONTINUE
2074
2075rewind(un)
2076ALLOCATE(conv_fwd(n),stat=stallo)
2077IF (stallo /= 0) THEN
2078 CALL l4f_log(l4f_fatal,"allocating memory")
2079 CALL raise_fatal_error()
2080ENDIF
2081
2082conv_fwd(:) = vg6d_v7d_var_conv_miss
2083CALL import_var_conv(un, conv_fwd)
2084CLOSE(un)
2085
2086! backward, bufr to grib
2087un = open_package_file('vargrib2bufr.csv', filetype_data)
2088! use the same file for now
2089!un = open_package_file('varbufr2grib.csv', filetype_data)
2090n=0
2091DO WHILE(.true.)
2092 READ(un,*,END=300)
2093 n = n + 1
2094ENDDO
2095
2096300 CONTINUE
2097
2098rewind(un)
2099ALLOCATE(conv_bwd(n),stat=stallo)
2100IF (stallo /= 0) THEN
2101 CALL l4f_log(l4f_fatal,"allocating memory")
2102 CALL raise_fatal_error()
2103end if
2104
2105conv_bwd(:) = vg6d_v7d_var_conv_miss
2106CALL import_var_conv(un, conv_bwd)
2107DO i = 1, n
2108 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
2109 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
2110ENDDO
2111CLOSE(un)
2112
2113CONTAINS
2114
2115SUBROUTINE import_var_conv(un, conv_type)
2116INTEGER, INTENT(in) :: un
2117TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
2118
2119INTEGER :: i
2120TYPE(csv_record) :: csv
2121CHARACTER(len=1024) :: line
2122CHARACTER(len=10) :: btable
2123INTEGER :: centre, category, number, discipline
2124
2125DO i = 1, SIZE(conv_type)
2126 READ(un,'(A)',END=200)line
2128 CALL csv_record_getfield(csv, btable)
2129 CALL csv_record_getfield(csv) ! skip fields for description and unit,
2130 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
2132
2133 CALL csv_record_getfield(csv, centre)
2134 CALL csv_record_getfield(csv, category)
2135 CALL csv_record_getfield(csv, number)
2136 CALL csv_record_getfield(csv, discipline)
2138 number=number, discipline=discipline) ! controllare l'ordine
2139
2140 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
2141 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
2143ENDDO
2144
2145200 CONTINUE
2146
2147END SUBROUTINE import_var_conv
2148
2149END SUBROUTINE vg6d_v7d_var_conv_setup
2150
2151
2152ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
2153TYPE(conv_func),INTENT(IN) :: this, that
2154LOGICAL :: res
2155
2156res = this%a == that%a .AND. this%b == that%b
2157
2158END FUNCTION conv_func_eq
2159
2160
2161ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
2162TYPE(conv_func),INTENT(IN) :: this, that
2163LOGICAL :: res
2164
2165res = .NOT.(this == that)
2166
2167END FUNCTION conv_func_ne
2168
2169
2170FUNCTION conv_func_mult(this, that) RESULT(mult)
2171TYPE(conv_func),INTENT(in) :: this
2172TYPE(conv_func),INTENT(in) :: that
2173
2174TYPE(conv_func) :: mult
2175
2176IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
2177 mult = conv_func_miss
2178ELSE
2179 mult%a = this%a*that%a
2180 mult%b = this%a*that%b+this%b
2181ENDIF
2182
2183END FUNCTION conv_func_mult
2184
2192ELEMENTAL SUBROUTINE conv_func_compute(this, values)
2193TYPE(conv_func),INTENT(in) :: this
2194REAL,INTENT(inout) :: values
2195
2196IF (this /= conv_func_miss) THEN
2197 IF (c_e(values)) values = values*this%a + this%b
2198ELSE
2199 values=rmiss
2200ENDIF
2201
2202END SUBROUTINE conv_func_compute
2203
2204
2212ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
2213TYPE(conv_func),intent(in) :: this
2214REAL,INTENT(in) :: values
2215REAL :: convert
2216
2217convert = values
2219
2220END FUNCTION conv_func_convert
2221
2222
2236SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
2237TYPE(volgrid6d_var),INTENT(in) :: this(:)
2238INTEGER,POINTER :: xind(:), yind(:)
2239
2240TYPE(vol7d_var) :: varbufr(SIZE(this))
2241TYPE(conv_func),POINTER :: c_func(:)
2242INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
2243
2244NULLIFY(xind, yind)
2245counts(:) = 0
2246
2247CALL vargrib2varbufr(this, varbufr, c_func)
2248
2249DO i = 1, SIZE(vol7d_var_horcomp)
2250 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
2251ENDDO
2252
2253IF (any(counts(1::2) > 1)) THEN
2254 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
2255 DEALLOCATE(c_func)
2256 RETURN
2257ENDIF
2258IF (any(counts(2::2) > 1)) THEN
2259 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
2260 DEALLOCATE(c_func)
2261 RETURN
2262ENDIF
2263
2264! check that variables are paired and count pairs
2265nv = 0
2266DO i = 1, SIZE(vol7d_var_horcomp), 2
2267 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
2268 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
2269 ' present but the corresponding x-component '// &
2270 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
2271 RETURN
2272 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
2273 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
2274 ' present but the corresponding y-component '// &
2275 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
2276 RETURN
2277 ENDIF
2278 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
2279ENDDO
2280
2281! repeat the loop storing indices
2282ALLOCATE(xind(nv), yind(nv))
2283nv = 0
2284DO i = 1, SIZE(vol7d_var_horcomp), 2
2285 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
2286 nv = nv + 1
2287 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
2288 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
2289 ENDIF
2290ENDDO
2291DEALLOCATE(c_func)
2292
2293END SUBROUTINE volgrid6d_var_hor_comp_index
2294
2295
2300FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
2301TYPE(volgrid6d_var),INTENT(in) :: this
2302LOGICAL :: is_hor_comp
2303
2304TYPE(vol7d_var) :: varbufr
2305
2306varbufr = convert(this)
2307is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
2308
2309END FUNCTION volgrid6d_var_is_hor_comp
2310
2311! before unstaggering??
2312
2313!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
2314!
2315!call init(varu,btable="B11003")
2316!call init(varv,btable="B11004")
2317!
2318! test about presence of u and v in standard table
2319!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
2320! call l4f_category_log(this%category,L4F_FATAL, &
2321! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
2322! CALL raise_error()
2323! RETURN
2324!end if
2325!
2326!if (associated(this%var))then
2327! nvar=size(this%var)
2328! allocate(varbufr(nvar),stat=stallo)
2329! if (stallo /=0)then
2330! call l4f_log(L4F_FATAL,"allocating memory")
2331! call raise_fatal_error("allocating memory")
2332! end if
2333!
2334! CALL vargrib2varbufr(this%var, varbufr)
2335!ELSE
2336! CALL l4f_category_log(this%category, L4F_ERROR, &
2337! "trying to destagger an incomplete volgrid6d object")
2338! CALL raise_error()
2339! RETURN
2340!end if
2341!
2342!nvaru=COUNT(varbufr==varu)
2343!nvarv=COUNT(varbufr==varv)
2344!
2345!if (nvaru > 1 )then
2346! call l4f_category_log(this%category,L4F_WARN, &
2347! ">1 variables refer to u wind component, destaggering will not be done ")
2348! DEALLOCATE(varbufr)
2349! RETURN
2350!endif
2351!
2352!if (nvarv > 1 )then
2353! call l4f_category_log(this%category,L4F_WARN, &
2354! ">1 variables refer to v wind component, destaggering will not be done ")
2355! DEALLOCATE(varbufr)
2356! RETURN
2357!endif
2358!
2359!if (nvaru == 0 .and. nvarv == 0) then
2360! call l4f_category_log(this%category,L4F_WARN, &
2361! "no u or v wind component found in volume, nothing to do")
2362! DEALLOCATE(varbufr)
2363! RETURN
2364!endif
2365!
2366!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2367! call l4f_category_log(this%category,L4F_WARN, &
2368! "there are variables different from u and v wind component in C grid")
2369!endif
2370
2371
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 |