libsim Versione 7.1.11

◆ 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 1505 del file volgrid6d_var_class.F90.

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