libsim Versione 7.1.11
|
◆ conv_func_compute()
Apply the conversion function this to values. The numerical conversion (only linear at the moment) defined by the conv_func object this is applied to the values argument; the converted result is stored in place; missing values remain missing; if the conversion function is undefined (conv_func_miss) the values are unchanged. The method is
Definizione alla linea 1461 del file volgrid6d_var_class.F90. 1462! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1463! authors:
1464! Davide Cesari <dcesari@arpa.emr.it>
1465! Paolo Patruno <ppatruno@arpa.emr.it>
1466
1467! This program is free software; you can redistribute it and/or
1468! modify it under the terms of the GNU General Public License as
1469! published by the Free Software Foundation; either version 2 of
1470! the License, or (at your option) any later version.
1471
1472! This program is distributed in the hope that it will be useful,
1473! but WITHOUT ANY WARRANTY; without even the implied warranty of
1474! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1475! GNU General Public License for more details.
1476
1477! You should have received a copy of the GNU General Public License
1478! along with this program. If not, see <http://www.gnu.org/licenses/>.
1479#include "config.h"
1480
1498
1499IMPLICIT NONE
1500
1506 integer :: centre
1507 integer :: category
1508 integer :: number
1509 integer :: discipline
1510 CHARACTER(len=65) :: description
1511 CHARACTER(len=24) :: unit
1513
1514TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1515 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1516
1517TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1520 /)
1521
1522TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1527/)
1528!/), (/2,2/)) ! bug in gfortran
1529
1539 PRIVATE
1540 REAL :: a, b
1542
1545
1546TYPE vg6d_v7d_var_conv
1547 TYPE(volgrid6d_var) :: vg6d_var
1548 TYPE(vol7d_var) :: v7d_var
1549 TYPE(conv_func) :: c_func
1550! aggiungere informazioni ad es. su rotazione del vento
1551END TYPE vg6d_v7d_var_conv
1552
1553TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1554 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1555
1556TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1557
1572 MODULE PROCEDURE volgrid6d_var_init
1573END INTERFACE
1574
1578 MODULE PROCEDURE volgrid6d_var_delete
1579END INTERFACE
1580
1581INTERFACE c_e
1582 MODULE PROCEDURE volgrid6d_var_c_e
1583END INTERFACE
1584
1585
1590INTERFACE OPERATOR (==)
1591 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1592END INTERFACE
1593
1598INTERFACE OPERATOR (/=)
1599 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1600END INTERFACE
1601
1602#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1603#define VOL7D_POLY_TYPES _var6d
1604#include "array_utilities_pre.F90"
1605
1608 MODULE PROCEDURE display_volgrid6d_var
1609END INTERFACE
1610
1615INTERFACE OPERATOR (*)
1616 MODULE PROCEDURE conv_func_mult
1617END INTERFACE OPERATOR (*)
1618
1622 MODULE PROCEDURE conv_func_compute
1623END INTERFACE
1624
1628 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1629 conv_func_convert
1630END INTERFACE
1631
1632PRIVATE
1634 c_e, volgrid6d_var_normalize, &
1635 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1636 count_distinct, pack_distinct, count_and_pack_distinct, &
1637 map_distinct, map_inv_distinct, &
1639 vargrib2varbufr, varbufr2vargrib, &
1641 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1642
1643
1644CONTAINS
1645
1646
1647ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1648 discipline, description, unit) RESULT(this)
1649integer,INTENT(in),OPTIONAL :: centre
1650integer,INTENT(in),OPTIONAL :: category
1651integer,INTENT(in),OPTIONAL :: number
1652integer,INTENT(in),OPTIONAL :: discipline
1653CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1654CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1655
1656TYPE(volgrid6d_var) :: this
1657
1659
1660END FUNCTION volgrid6d_var_new
1661
1662
1663! documented in the interface
1664ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1665TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1666INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1667INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1668INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1669INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1670CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1671CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1672
1673IF (PRESENT(centre)) THEN
1674 this%centre = centre
1675ELSE
1676 this%centre = imiss
1677 this%category = imiss
1678 this%number = imiss
1679 this%discipline = imiss
1680 RETURN
1681ENDIF
1682
1683IF (PRESENT(category)) THEN
1684 this%category = category
1685ELSE
1686 this%category = imiss
1687 this%number = imiss
1688 this%discipline = imiss
1689 RETURN
1690ENDIF
1691
1692
1693IF (PRESENT(number)) THEN
1694 this%number = number
1695ELSE
1696 this%number = imiss
1697 this%discipline = imiss
1698 RETURN
1699ENDIF
1700
1701! se sono arrivato fino a qui ho impostato centre, category e number
1702!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1703
1704IF (PRESENT(discipline)) THEN
1705 this%discipline = discipline
1706ELSE
1707 this%discipline = 255
1708ENDIF
1709
1710IF (PRESENT(description)) THEN
1711 this%description = description
1712ELSE
1713 this%description = cmiss
1714ENDIF
1715
1716IF (PRESENT(unit)) THEN
1717 this%unit = unit
1718ELSE
1719 this%unit = cmiss
1720ENDIF
1721
1722
1723
1724END SUBROUTINE volgrid6d_var_init
1725
1726
1727! documented in the interface
1728SUBROUTINE volgrid6d_var_delete(this)
1729TYPE(volgrid6d_var),INTENT(INOUT) :: this
1730
1731this%centre = imiss
1732this%category = imiss
1733this%number = imiss
1734this%discipline = imiss
1735this%description = cmiss
1736this%unit = cmiss
1737
1738END SUBROUTINE volgrid6d_var_delete
1739
1740
1741ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1742TYPE(volgrid6d_var),INTENT(IN) :: this
1743LOGICAL :: c_e
1744c_e = this /= volgrid6d_var_miss
1745END FUNCTION volgrid6d_var_c_e
1746
1747
1748ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1749TYPE(volgrid6d_var),INTENT(IN) :: this, that
1750LOGICAL :: res
1751
1752IF (this%discipline == that%discipline) THEN
1753
1754 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1755 res = ((this%category == that%category) .OR. &
1756 (this%category >= 1 .AND. this%category <=3 .AND. &
1757 that%category >= 1 .AND. that%category <=3)) .AND. &
1758 this%number == that%number
1759
1760 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1761 (this%number >= 128 .AND. this%number <= 254)) THEN
1762 res = res .AND. this%centre == that%centre ! local definition, centre matters
1763 ENDIF
1764
1765 ELSE ! grib2
1766 res = this%category == that%category .AND. &
1767 this%number == that%number
1768
1769 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1770 (this%category >= 192 .AND. this%category <= 254) .OR. &
1771 (this%number >= 192 .AND. this%number <= 254)) THEN
1772 res = res .AND. this%centre == that%centre ! local definition, centre matters
1773 ENDIF
1774 ENDIF
1775
1776ELSE ! different edition or different discipline
1777 res = .false.
1778ENDIF
1779
1780END FUNCTION volgrid6d_var_eq
1781
1782
1783ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1784TYPE(volgrid6d_var),INTENT(IN) :: this, that
1785LOGICAL :: res
1786
1787res = .NOT.(this == that)
1788
1789END FUNCTION volgrid6d_var_ne
1790
1791
1792#include "array_utilities_inc.F90"
1793
1794
1796SUBROUTINE display_volgrid6d_var(this)
1797TYPE(volgrid6d_var),INTENT(in) :: this
1798
1799print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1800
1801END SUBROUTINE display_volgrid6d_var
1802
1803
1816SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1817TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1818TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1819TYPE(conv_func),POINTER :: c_func(:)
1820
1821INTEGER :: i, n, stallo
1822
1823n = min(SIZE(varbufr), SIZE(vargrib))
1824ALLOCATE(c_func(n),stat=stallo)
1825IF (stallo /= 0) THEN
1826 call l4f_log(l4f_fatal,"allocating memory")
1827 call raise_fatal_error()
1828ENDIF
1829
1830DO i = 1, n
1831 varbufr(i) = convert(vargrib(i), c_func(i))
1832ENDDO
1833
1834END SUBROUTINE vargrib2varbufr
1835
1836
1847FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1848TYPE(volgrid6d_var),INTENT(in) :: vargrib
1849TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1850TYPE(vol7d_var) :: convert
1851
1852INTEGER :: i
1853
1854IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1855
1856DO i = 1, SIZE(conv_fwd)
1857 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1858 convert = conv_fwd(i)%v7d_var
1859 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1860 RETURN
1861 ENDIF
1862ENDDO
1863! not found
1864convert = vol7d_var_miss
1865IF (PRESENT(c_func)) c_func = conv_func_miss
1866
1867! set hint for backwards conversion
1868convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1869 vargrib%discipline/)
1870
1871CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1872 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1873 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1874 ' not found in table')
1875
1876END FUNCTION vargrib2varbufr_convert
1877
1878
1894SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1895TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1896TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1897TYPE(conv_func),POINTER :: c_func(:)
1898TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1899
1900INTEGER :: i, n, stallo
1901
1902n = min(SIZE(varbufr), SIZE(vargrib))
1903ALLOCATE(c_func(n),stat=stallo)
1904IF (stallo /= 0) THEN
1905 CALL l4f_log(l4f_fatal,"allocating memory")
1906 CALL raise_fatal_error()
1907ENDIF
1908
1909DO i = 1, n
1910 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1911ENDDO
1912
1913END SUBROUTINE varbufr2vargrib
1914
1915
1929FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1930TYPE(vol7d_var),INTENT(in) :: varbufr
1931TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1932TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1933TYPE(volgrid6d_var) :: convert
1934
1935INTEGER :: i
1936#ifdef HAVE_LIBGRIBAPI
1937INTEGER :: gaid, editionnumber, category, centre
1938#endif
1939
1940IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1941
1942#ifdef HAVE_LIBGRIBAPI
1943editionnumber=255; category=255; centre=255
1944#endif
1945IF (PRESENT(grid_id_template)) THEN
1946#ifdef HAVE_LIBGRIBAPI
1947 gaid = grid_id_get_gaid(grid_id_template)
1948 IF (c_e(gaid)) THEN
1949 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1950 IF (editionnumber == 1) THEN
1951 CALL grib_get(gaid,'gribTablesVersionNo',category)
1952 ENDIF
1953 CALL grib_get(gaid,'centre',centre)
1954 ENDIF
1955#endif
1956ENDIF
1957
1958DO i = 1, SIZE(conv_bwd)
1959 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1960#ifdef HAVE_LIBGRIBAPI
1961 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1962 IF (editionnumber == 1) THEN
1963 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1964 ELSE IF (editionnumber == 2) THEN
1965 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1966 ENDIF
1967 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1968 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1969 ENDIF
1970#endif
1971 convert = conv_bwd(i)%vg6d_var
1972 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1973 RETURN
1974 ENDIF
1975ENDDO
1976! not found
1977convert = volgrid6d_var_miss
1978IF (PRESENT(c_func)) c_func = conv_func_miss
1979
1980! if hint available use it as a fallback
1981IF (any(varbufr%gribhint /= imiss)) THEN
1982 convert%centre = varbufr%gribhint(1)
1983 convert%category = varbufr%gribhint(2)
1984 convert%number = varbufr%gribhint(3)
1985 convert%discipline = varbufr%gribhint(4)
1986ENDIF
1987
1988CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1989 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1990 ' not found in table')
1991
1992END FUNCTION varbufr2vargrib_convert
1993
1994
2002SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
2003TYPE(volgrid6d_var),INTENT(inout) :: this
2004TYPE(conv_func),INTENT(out) :: c_func
2005TYPE(grid_id),INTENT(in) :: grid_id_template
2006
2007LOGICAL :: eqed, eqcentre
2008INTEGER :: gaid, editionnumber, centre
2009TYPE(volgrid6d_var) :: tmpgrib
2010TYPE(vol7d_var) :: tmpbufr
2011TYPE(conv_func) tmpc_func1, tmpc_func2
2012
2013eqed = .true.
2014eqcentre = .true.
2015c_func = conv_func_miss
2016
2017#ifdef HAVE_LIBGRIBAPI
2018gaid = grid_id_get_gaid(grid_id_template)
2019IF (c_e(gaid)) THEN
2020 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
2021 CALL grib_get(gaid, 'centre', centre)
2022 eqed = editionnumber == 1 .EQV. this%discipline == 255
2023 eqcentre = centre == this%centre
2024ENDIF
2025#endif
2026
2027IF (eqed .AND. eqcentre) RETURN ! nothing to do
2028
2029tmpbufr = convert(this, tmpc_func1)
2030tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
2031
2032IF (tmpgrib /= volgrid6d_var_miss) THEN
2033! conversion back and forth successful, set also conversion function
2034 this = tmpgrib
2035 c_func = tmpc_func1 * tmpc_func2
2036! set to missing in common case to avoid useless computation
2037 IF (c_func == conv_func_identity) c_func = conv_func_miss
2038ELSE IF (.NOT.eqed) THEN
2039! conversion back and forth unsuccessful and grib edition incompatible, set to miss
2040 this = tmpgrib
2041ENDIF
2042
2043END SUBROUTINE volgrid6d_var_normalize
2044
2045
2046! Private subroutine for reading forward and backward conversion tables
2047! todo: better error handling
2048SUBROUTINE vg6d_v7d_var_conv_setup()
2049INTEGER :: un, i, n, stallo
2050
2051! forward, grib to bufr
2052un = open_package_file('vargrib2bufr.csv', filetype_data)
2053n=0
2054DO WHILE(.true.)
2055 READ(un,*,END=100)
2056 n = n + 1
2057ENDDO
2058
2059100 CONTINUE
2060
2061rewind(un)
2062ALLOCATE(conv_fwd(n),stat=stallo)
2063IF (stallo /= 0) THEN
2064 CALL l4f_log(l4f_fatal,"allocating memory")
2065 CALL raise_fatal_error()
2066ENDIF
2067
2068conv_fwd(:) = vg6d_v7d_var_conv_miss
2069CALL import_var_conv(un, conv_fwd)
2070CLOSE(un)
2071
2072! backward, bufr to grib
2073un = open_package_file('vargrib2bufr.csv', filetype_data)
2074! use the same file for now
2075!un = open_package_file('varbufr2grib.csv', filetype_data)
2076n=0
2077DO WHILE(.true.)
2078 READ(un,*,END=300)
2079 n = n + 1
2080ENDDO
2081
2082300 CONTINUE
2083
2084rewind(un)
2085ALLOCATE(conv_bwd(n),stat=stallo)
2086IF (stallo /= 0) THEN
2087 CALL l4f_log(l4f_fatal,"allocating memory")
2088 CALL raise_fatal_error()
2089end if
2090
2091conv_bwd(:) = vg6d_v7d_var_conv_miss
2092CALL import_var_conv(un, conv_bwd)
2093DO i = 1, n
2094 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
2095 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
2096ENDDO
2097CLOSE(un)
2098
2099CONTAINS
2100
2101SUBROUTINE import_var_conv(un, conv_type)
2102INTEGER, INTENT(in) :: un
2103TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
2104
2105INTEGER :: i
2106TYPE(csv_record) :: csv
2107CHARACTER(len=1024) :: line
2108CHARACTER(len=10) :: btable
2109INTEGER :: centre, category, number, discipline
2110
2111DO i = 1, SIZE(conv_type)
2112 READ(un,'(A)',END=200)line
2114 CALL csv_record_getfield(csv, btable)
2115 CALL csv_record_getfield(csv) ! skip fields for description and unit,
2116 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
2118
2119 CALL csv_record_getfield(csv, centre)
2120 CALL csv_record_getfield(csv, category)
2121 CALL csv_record_getfield(csv, number)
2122 CALL csv_record_getfield(csv, discipline)
2124 number=number, discipline=discipline) ! controllare l'ordine
2125
2126 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
2127 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
2129ENDDO
2130
2131200 CONTINUE
2132
2133END SUBROUTINE import_var_conv
2134
2135END SUBROUTINE vg6d_v7d_var_conv_setup
2136
2137
2138ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
2139TYPE(conv_func),INTENT(IN) :: this, that
2140LOGICAL :: res
2141
2142res = this%a == that%a .AND. this%b == that%b
2143
2144END FUNCTION conv_func_eq
2145
2146
2147ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
2148TYPE(conv_func),INTENT(IN) :: this, that
2149LOGICAL :: res
2150
2151res = .NOT.(this == that)
2152
2153END FUNCTION conv_func_ne
2154
2155
2156FUNCTION conv_func_mult(this, that) RESULT(mult)
2157TYPE(conv_func),INTENT(in) :: this
2158TYPE(conv_func),INTENT(in) :: that
2159
2160TYPE(conv_func) :: mult
2161
2162IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
2163 mult = conv_func_miss
2164ELSE
2165 mult%a = this%a*that%a
2166 mult%b = this%a*that%b+this%b
2167ENDIF
2168
2169END FUNCTION conv_func_mult
2170
2178ELEMENTAL SUBROUTINE conv_func_compute(this, values)
2179TYPE(conv_func),INTENT(in) :: this
2180REAL,INTENT(inout) :: values
2181
2182IF (this /= conv_func_miss) THEN
2183 IF (c_e(values)) values = values*this%a + this%b
2184ELSE
2185 values=rmiss
2186ENDIF
2187
2188END SUBROUTINE conv_func_compute
2189
2190
2198ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
2199TYPE(conv_func),intent(in) :: this
2200REAL,INTENT(in) :: values
2201REAL :: convert
2202
2203convert = values
2205
2206END FUNCTION conv_func_convert
2207
2208
2222SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
2223TYPE(volgrid6d_var),INTENT(in) :: this(:)
2224INTEGER,POINTER :: xind(:), yind(:)
2225
2226TYPE(vol7d_var) :: varbufr(SIZE(this))
2227TYPE(conv_func),POINTER :: c_func(:)
2228INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
2229
2230NULLIFY(xind, yind)
2231counts(:) = 0
2232
2233CALL vargrib2varbufr(this, varbufr, c_func)
2234
2235DO i = 1, SIZE(vol7d_var_horcomp)
2236 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
2237ENDDO
2238
2239IF (any(counts(1::2) > 1)) THEN
2240 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
2241 DEALLOCATE(c_func)
2242 RETURN
2243ENDIF
2244IF (any(counts(2::2) > 1)) THEN
2245 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
2246 DEALLOCATE(c_func)
2247 RETURN
2248ENDIF
2249
2250! check that variables are paired and count pairs
2251nv = 0
2252DO i = 1, SIZE(vol7d_var_horcomp), 2
2253 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
2254 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
2255 ' present but the corresponding x-component '// &
2256 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
2257 RETURN
2258 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
2259 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
2260 ' present but the corresponding y-component '// &
2261 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
2262 RETURN
2263 ENDIF
2264 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
2265ENDDO
2266
2267! repeat the loop storing indices
2268ALLOCATE(xind(nv), yind(nv))
2269nv = 0
2270DO i = 1, SIZE(vol7d_var_horcomp), 2
2271 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
2272 nv = nv + 1
2273 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
2274 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
2275 ENDIF
2276ENDDO
2277DEALLOCATE(c_func)
2278
2279END SUBROUTINE volgrid6d_var_hor_comp_index
2280
2281
2286FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
2287TYPE(volgrid6d_var),INTENT(in) :: this
2288LOGICAL :: is_hor_comp
2289
2290TYPE(vol7d_var) :: varbufr
2291
2292varbufr = convert(this)
2293is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
2294
2295END FUNCTION volgrid6d_var_is_hor_comp
2296
2297! before unstaggering??
2298
2299!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
2300!
2301!call init(varu,btable="B11003")
2302!call init(varv,btable="B11004")
2303!
2304! test about presence of u and v in standard table
2305!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
2306! call l4f_category_log(this%category,L4F_FATAL, &
2307! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
2308! CALL raise_error()
2309! RETURN
2310!end if
2311!
2312!if (associated(this%var))then
2313! nvar=size(this%var)
2314! allocate(varbufr(nvar),stat=stallo)
2315! if (stallo /=0)then
2316! call l4f_log(L4F_FATAL,"allocating memory")
2317! call raise_fatal_error("allocating memory")
2318! end if
2319!
2320! CALL vargrib2varbufr(this%var, varbufr)
2321!ELSE
2322! CALL l4f_category_log(this%category, L4F_ERROR, &
2323! "trying to destagger an incomplete volgrid6d object")
2324! CALL raise_error()
2325! RETURN
2326!end if
2327!
2328!nvaru=COUNT(varbufr==varu)
2329!nvarv=COUNT(varbufr==varv)
2330!
2331!if (nvaru > 1 )then
2332! call l4f_category_log(this%category,L4F_WARN, &
2333! ">1 variables refer to u wind component, destaggering will not be done ")
2334! DEALLOCATE(varbufr)
2335! RETURN
2336!endif
2337!
2338!if (nvarv > 1 )then
2339! call l4f_category_log(this%category,L4F_WARN, &
2340! ">1 variables refer to v wind component, destaggering will not be done ")
2341! DEALLOCATE(varbufr)
2342! RETURN
2343!endif
2344!
2345!if (nvaru == 0 .and. nvarv == 0) then
2346! call l4f_category_log(this%category,L4F_WARN, &
2347! "no u or v wind component found in volume, nothing to do")
2348! DEALLOCATE(varbufr)
2349! RETURN
2350!endif
2351!
2352!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2353! call l4f_category_log(this%category,L4F_WARN, &
2354! "there are variables different from u and v wind component in C grid")
2355!endif
2356
2357
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 |