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