libsim Versione 7.1.11

◆ conv_func_compute()

elemental subroutine conv_func_compute ( type(conv_func), intent(in)  this,
real, intent(inout)  values 
)
private

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 ELEMENTAL, thus values can be also an array of any shape.

Parametri
[in]thisobject defining the conversion function
[in,out]valuesvalue to be converted in place

Definizione alla linea 1461 del file volgrid6d_var_class.F90.

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