libsim Versione 7.2.1

◆ volgrid6d_var_hor_comp_index()

subroutine, public volgrid6d_var_hor_comp_index ( type(volgrid6d_var), dimension(:), intent(in) this,
integer, dimension(:), pointer xind,
integer, dimension(:), pointer yind )

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 .NOT.ASSOCIATED(xind). If no vector fields are found then xind and xind are allocated to zero size. If xind and yind are ASSOCIATED() after return, they should be DEALLOCATEd by the calling procedure.

Parametri
[in]thisarray of volgrid6d_var objects (grib variable) to test
yindoutput arrays of indices pointing to matching horizontal components, allocated by this method

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
1530USE kinds
1532USE err_handling
1535USE grid_id_class
1536
1537IMPLICIT NONE
1538
1543TYPE volgrid6d_var
1544 integer :: centre
1545 integer :: category
1546 integer :: number
1547 integer :: discipline
1548 CHARACTER(len=65) :: description
1549 CHARACTER(len=24) :: unit
1550END TYPE volgrid6d_var
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) = (/ &
1556 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1557 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
1558 /)
1559
1560TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1561 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1562 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
1563 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
1564 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
1565/)
1566!/), (/2,2/)) ! bug in gfortran
1567
1576TYPE conv_func
1577 PRIVATE
1578 REAL :: a, b
1579END TYPE conv_func
1580
1581TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
1582TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
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
1609INTERFACE init
1610 MODULE PROCEDURE volgrid6d_var_init
1611END INTERFACE
1612
1615INTERFACE delete
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
1645INTERFACE display
1646 MODULE PROCEDURE display_volgrid6d_var
1647END INTERFACE
1648
1653INTERFACE OPERATOR (*)
1654 MODULE PROCEDURE conv_func_mult
1655END INTERFACE OPERATOR (*)
1656
1659INTERFACE compute
1660 MODULE PROCEDURE conv_func_compute
1661END INTERFACE
1662
1665INTERFACE convert
1666 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1667 conv_func_convert
1668END INTERFACE
1669
1670PRIVATE
1671PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
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, &
1676 index, display, &
1677 vargrib2varbufr, varbufr2vargrib, &
1678 conv_func, conv_func_miss, compute, convert, &
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
1696CALL init(this, centre, category, number, discipline, description, unit)
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
2151 CALL init(csv, 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
2155 CALL init(conv_type(i)%v7d_var, btable=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)
2161 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
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)
2166 CALL delete(csv)
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
2242CALL compute(this, convert)
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
2396END MODULE volgrid6d_var_class
Index method.
Apply the conversion function this to values.
Apply the conversion function this to values.
Destructor for the corresponding object, it assigns it to a missing value.
Display on the screen a brief content of object.
Initialize a volgrid6d_var object with the optional arguments provided.
Gestione degli errori.
Utilities for managing files.
This module defines an abstract interface to different drivers for access to files containing gridded...
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.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Class for managing physical variables in a grib 1/2 fashion.
Definisce una variabile meteorologica osservata o un suo attributo.
Class defining a real conversion function between units.
Definition of a physical variable in grib coding style.

Generated with Doxygen.