libsim Versione 7.2.1

◆ conv_func_compute()

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

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

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