libsim Versione 7.2.1

◆ conv_func_convert()

elemental real function conv_func_convert ( type(conv_func), intent(in)  this,
real, intent(in)  values 
)
private

Return a copy of values converted by applying the conversion function this.

The numerical conversion (only linear at the moment) defined by the conv_func object this is applied to the values argument and the converted result is returned; missing values remain missing; if the conversion function is undefined (conv_func_miss) the values are unchanged. The method is ELEMENTAL, thus values can be also an array of any shape.

Parametri
[in]thisobject defining the conversion function
[in]valuesinput value to be converted

Definizione alla linea 1475 del file volgrid6d_var_class.F90.

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