libsim Versione 7.1.11

◆ volgrid6d_var_normalize()

subroutine, public volgrid6d_var_normalize ( type(volgrid6d_var), intent(inout)  this,
type(conv_func), intent(out)  c_func,
type(grid_id), intent(in)  grid_id_template 
)

Normalize a variable definition converting it to the format (grib edition) specified in the (grib) template provided.

This allows a basic grib1 <-> grib2 conversion provided that entries for both grib editions of the related variable are present in the static file vargrib2ufr.csv. If the c_func variable returned is not missing (i.e. /= conv_func_miss) the field value should be converted as well using the conv_func::compute method .

Parametri
[in,out]thisvariable to normalize
[out]c_funcconv_func object to convert data
[in]grid_id_templatea template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion

Definizione alla linea 1285 del file volgrid6d_var_class.F90.

1286! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1287! authors:
1288! Davide Cesari <dcesari@arpa.emr.it>
1289! Paolo Patruno <ppatruno@arpa.emr.it>
1290
1291! This program is free software; you can redistribute it and/or
1292! modify it under the terms of the GNU General Public License as
1293! published by the Free Software Foundation; either version 2 of
1294! the License, or (at your option) any later version.
1295
1296! This program is distributed in the hope that it will be useful,
1297! but WITHOUT ANY WARRANTY; without even the implied warranty of
1298! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1299! GNU General Public License for more details.
1300
1301! You should have received a copy of the GNU General Public License
1302! along with this program. If not, see <http://www.gnu.org/licenses/>.
1303#include "config.h"
1304
1316USE kinds
1318USE err_handling
1321USE grid_id_class
1322
1323IMPLICIT NONE
1324
1329TYPE volgrid6d_var
1330 integer :: centre
1331 integer :: category
1332 integer :: number
1333 integer :: discipline
1334 CHARACTER(len=65) :: description
1335 CHARACTER(len=24) :: unit
1336END TYPE volgrid6d_var
1337
1338TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1339 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1340
1341TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1342 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1343 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
1344 /)
1345
1346TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1347 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1348 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
1349 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
1350 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
1351/)
1352!/), (/2,2/)) ! bug in gfortran
1353
1362TYPE conv_func
1363 PRIVATE
1364 REAL :: a, b
1365END TYPE conv_func
1366
1367TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
1368TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
1369
1370TYPE vg6d_v7d_var_conv
1371 TYPE(volgrid6d_var) :: vg6d_var
1372 TYPE(vol7d_var) :: v7d_var
1373 TYPE(conv_func) :: c_func
1374! aggiungere informazioni ad es. su rotazione del vento
1375END TYPE vg6d_v7d_var_conv
1376
1377TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1378 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1379
1380TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1381
1395INTERFACE init
1396 MODULE PROCEDURE volgrid6d_var_init
1397END INTERFACE
1398
1401INTERFACE delete
1402 MODULE PROCEDURE volgrid6d_var_delete
1403END INTERFACE
1404
1405INTERFACE c_e
1406 MODULE PROCEDURE volgrid6d_var_c_e
1407END INTERFACE
1408
1409
1414INTERFACE OPERATOR (==)
1415 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1416END INTERFACE
1417
1422INTERFACE OPERATOR (/=)
1423 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1424END INTERFACE
1425
1426#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1427#define VOL7D_POLY_TYPES _var6d
1428#include "array_utilities_pre.F90"
1429
1431INTERFACE display
1432 MODULE PROCEDURE display_volgrid6d_var
1433END INTERFACE
1434
1439INTERFACE OPERATOR (*)
1440 MODULE PROCEDURE conv_func_mult
1441END INTERFACE OPERATOR (*)
1442
1445INTERFACE compute
1446 MODULE PROCEDURE conv_func_compute
1447END INTERFACE
1448
1451INTERFACE convert
1452 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1453 conv_func_convert
1454END INTERFACE
1455
1456PRIVATE
1457PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
1458 c_e, volgrid6d_var_normalize, &
1459 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1460 count_distinct, pack_distinct, count_and_pack_distinct, &
1461 map_distinct, map_inv_distinct, &
1462 index, display, &
1463 vargrib2varbufr, varbufr2vargrib, &
1464 conv_func, conv_func_miss, compute, convert, &
1465 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1466
1467
1468CONTAINS
1469
1470
1471ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1472 discipline, description, unit) RESULT(this)
1473integer,INTENT(in),OPTIONAL :: centre
1474integer,INTENT(in),OPTIONAL :: category
1475integer,INTENT(in),OPTIONAL :: number
1476integer,INTENT(in),OPTIONAL :: discipline
1477CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1478CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1479
1480TYPE(volgrid6d_var) :: this
1481
1482CALL init(this, centre, category, number, discipline, description, unit)
1483
1484END FUNCTION volgrid6d_var_new
1485
1486
1487! documented in the interface
1488ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1489TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1490INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1491INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1492INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1493INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1494CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1495CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1496
1497IF (PRESENT(centre)) THEN
1498 this%centre = centre
1499ELSE
1500 this%centre = imiss
1501 this%category = imiss
1502 this%number = imiss
1503 this%discipline = imiss
1504 RETURN
1505ENDIF
1506
1507IF (PRESENT(category)) THEN
1508 this%category = category
1509ELSE
1510 this%category = imiss
1511 this%number = imiss
1512 this%discipline = imiss
1513 RETURN
1514ENDIF
1515
1516
1517IF (PRESENT(number)) THEN
1518 this%number = number
1519ELSE
1520 this%number = imiss
1521 this%discipline = imiss
1522 RETURN
1523ENDIF
1524
1525! se sono arrivato fino a qui ho impostato centre, category e number
1526!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1527
1528IF (PRESENT(discipline)) THEN
1529 this%discipline = discipline
1530ELSE
1531 this%discipline = 255
1532ENDIF
1533
1534IF (PRESENT(description)) THEN
1535 this%description = description
1536ELSE
1537 this%description = cmiss
1538ENDIF
1539
1540IF (PRESENT(unit)) THEN
1541 this%unit = unit
1542ELSE
1543 this%unit = cmiss
1544ENDIF
1545
1546
1547
1548END SUBROUTINE volgrid6d_var_init
1549
1550
1551! documented in the interface
1552SUBROUTINE volgrid6d_var_delete(this)
1553TYPE(volgrid6d_var),INTENT(INOUT) :: this
1554
1555this%centre = imiss
1556this%category = imiss
1557this%number = imiss
1558this%discipline = imiss
1559this%description = cmiss
1560this%unit = cmiss
1561
1562END SUBROUTINE volgrid6d_var_delete
1563
1564
1565ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1566TYPE(volgrid6d_var),INTENT(IN) :: this
1567LOGICAL :: c_e
1568c_e = this /= volgrid6d_var_miss
1569END FUNCTION volgrid6d_var_c_e
1570
1571
1572ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1573TYPE(volgrid6d_var),INTENT(IN) :: this, that
1574LOGICAL :: res
1575
1576IF (this%discipline == that%discipline) THEN
1577
1578 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1579 res = ((this%category == that%category) .OR. &
1580 (this%category >= 1 .AND. this%category <=3 .AND. &
1581 that%category >= 1 .AND. that%category <=3)) .AND. &
1582 this%number == that%number
1583
1584 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1585 (this%number >= 128 .AND. this%number <= 254)) THEN
1586 res = res .AND. this%centre == that%centre ! local definition, centre matters
1587 ENDIF
1588
1589 ELSE ! grib2
1590 res = this%category == that%category .AND. &
1591 this%number == that%number
1592
1593 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1594 (this%category >= 192 .AND. this%category <= 254) .OR. &
1595 (this%number >= 192 .AND. this%number <= 254)) THEN
1596 res = res .AND. this%centre == that%centre ! local definition, centre matters
1597 ENDIF
1598 ENDIF
1599
1600ELSE ! different edition or different discipline
1601 res = .false.
1602ENDIF
1603
1604END FUNCTION volgrid6d_var_eq
1605
1606
1607ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1608TYPE(volgrid6d_var),INTENT(IN) :: this, that
1609LOGICAL :: res
1610
1611res = .NOT.(this == that)
1612
1613END FUNCTION volgrid6d_var_ne
1614
1615
1616#include "array_utilities_inc.F90"
1617
1618
1620SUBROUTINE display_volgrid6d_var(this)
1621TYPE(volgrid6d_var),INTENT(in) :: this
1622
1623print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1624
1625END SUBROUTINE display_volgrid6d_var
1626
1627
1640SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1641TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1642TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1643TYPE(conv_func),POINTER :: c_func(:)
1644
1645INTEGER :: i, n, stallo
1646
1647n = min(SIZE(varbufr), SIZE(vargrib))
1648ALLOCATE(c_func(n),stat=stallo)
1649IF (stallo /= 0) THEN
1650 call l4f_log(l4f_fatal,"allocating memory")
1651 call raise_fatal_error()
1652ENDIF
1653
1654DO i = 1, n
1655 varbufr(i) = convert(vargrib(i), c_func(i))
1656ENDDO
1657
1658END SUBROUTINE vargrib2varbufr
1659
1660
1671FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1672TYPE(volgrid6d_var),INTENT(in) :: vargrib
1673TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1674TYPE(vol7d_var) :: convert
1675
1676INTEGER :: i
1677
1678IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1679
1680DO i = 1, SIZE(conv_fwd)
1681 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1682 convert = conv_fwd(i)%v7d_var
1683 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1684 RETURN
1685 ENDIF
1686ENDDO
1687! not found
1688convert = vol7d_var_miss
1689IF (PRESENT(c_func)) c_func = conv_func_miss
1690
1691! set hint for backwards conversion
1692convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1693 vargrib%discipline/)
1694
1695CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1696 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1697 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1698 ' not found in table')
1699
1700END FUNCTION vargrib2varbufr_convert
1701
1702
1718SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1719TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1720TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1721TYPE(conv_func),POINTER :: c_func(:)
1722TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1723
1724INTEGER :: i, n, stallo
1725
1726n = min(SIZE(varbufr), SIZE(vargrib))
1727ALLOCATE(c_func(n),stat=stallo)
1728IF (stallo /= 0) THEN
1729 CALL l4f_log(l4f_fatal,"allocating memory")
1730 CALL raise_fatal_error()
1731ENDIF
1732
1733DO i = 1, n
1734 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1735ENDDO
1736
1737END SUBROUTINE varbufr2vargrib
1738
1739
1753FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1754TYPE(vol7d_var),INTENT(in) :: varbufr
1755TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1756TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1757TYPE(volgrid6d_var) :: convert
1758
1759INTEGER :: i
1760#ifdef HAVE_LIBGRIBAPI
1761INTEGER :: gaid, editionnumber, category, centre
1762#endif
1763
1764IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1765
1766#ifdef HAVE_LIBGRIBAPI
1767editionnumber=255; category=255; centre=255
1768#endif
1769IF (PRESENT(grid_id_template)) THEN
1770#ifdef HAVE_LIBGRIBAPI
1771 gaid = grid_id_get_gaid(grid_id_template)
1772 IF (c_e(gaid)) THEN
1773 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1774 IF (editionnumber == 1) THEN
1775 CALL grib_get(gaid,'gribTablesVersionNo',category)
1776 ENDIF
1777 CALL grib_get(gaid,'centre',centre)
1778 ENDIF
1779#endif
1780ENDIF
1781
1782DO i = 1, SIZE(conv_bwd)
1783 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1784#ifdef HAVE_LIBGRIBAPI
1785 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1786 IF (editionnumber == 1) THEN
1787 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1788 ELSE IF (editionnumber == 2) THEN
1789 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1790 ENDIF
1791 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1792 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1793 ENDIF
1794#endif
1795 convert = conv_bwd(i)%vg6d_var
1796 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1797 RETURN
1798 ENDIF
1799ENDDO
1800! not found
1801convert = volgrid6d_var_miss
1802IF (PRESENT(c_func)) c_func = conv_func_miss
1803
1804! if hint available use it as a fallback
1805IF (any(varbufr%gribhint /= imiss)) THEN
1806 convert%centre = varbufr%gribhint(1)
1807 convert%category = varbufr%gribhint(2)
1808 convert%number = varbufr%gribhint(3)
1809 convert%discipline = varbufr%gribhint(4)
1810ENDIF
1811
1812CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1813 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1814 ' not found in table')
1815
1816END FUNCTION varbufr2vargrib_convert
1817
1818
1826SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1827TYPE(volgrid6d_var),INTENT(inout) :: this
1828TYPE(conv_func),INTENT(out) :: c_func
1829TYPE(grid_id),INTENT(in) :: grid_id_template
1830
1831LOGICAL :: eqed, eqcentre
1832INTEGER :: gaid, editionnumber, centre
1833TYPE(volgrid6d_var) :: tmpgrib
1834TYPE(vol7d_var) :: tmpbufr
1835TYPE(conv_func) tmpc_func1, tmpc_func2
1836
1837eqed = .true.
1838eqcentre = .true.
1839c_func = conv_func_miss
1840
1841#ifdef HAVE_LIBGRIBAPI
1842gaid = grid_id_get_gaid(grid_id_template)
1843IF (c_e(gaid)) THEN
1844 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1845 CALL grib_get(gaid, 'centre', centre)
1846 eqed = editionnumber == 1 .EQV. this%discipline == 255
1847 eqcentre = centre == this%centre
1848ENDIF
1849#endif
1850
1851IF (eqed .AND. eqcentre) RETURN ! nothing to do
1852
1853tmpbufr = convert(this, tmpc_func1)
1854tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1855
1856IF (tmpgrib /= volgrid6d_var_miss) THEN
1857! conversion back and forth successful, set also conversion function
1858 this = tmpgrib
1859 c_func = tmpc_func1 * tmpc_func2
1860! set to missing in common case to avoid useless computation
1861 IF (c_func == conv_func_identity) c_func = conv_func_miss
1862ELSE IF (.NOT.eqed) THEN
1863! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1864 this = tmpgrib
1865ENDIF
1866
1867END SUBROUTINE volgrid6d_var_normalize
1868
1869
1870! Private subroutine for reading forward and backward conversion tables
1871! todo: better error handling
1872SUBROUTINE vg6d_v7d_var_conv_setup()
1873INTEGER :: un, i, n, stallo
1874
1875! forward, grib to bufr
1876un = open_package_file('vargrib2bufr.csv', filetype_data)
1877n=0
1878DO WHILE(.true.)
1879 READ(un,*,END=100)
1880 n = n + 1
1881ENDDO
1882
1883100 CONTINUE
1884
1885rewind(un)
1886ALLOCATE(conv_fwd(n),stat=stallo)
1887IF (stallo /= 0) THEN
1888 CALL l4f_log(l4f_fatal,"allocating memory")
1889 CALL raise_fatal_error()
1890ENDIF
1891
1892conv_fwd(:) = vg6d_v7d_var_conv_miss
1893CALL import_var_conv(un, conv_fwd)
1894CLOSE(un)
1895
1896! backward, bufr to grib
1897un = open_package_file('vargrib2bufr.csv', filetype_data)
1898! use the same file for now
1899!un = open_package_file('varbufr2grib.csv', filetype_data)
1900n=0
1901DO WHILE(.true.)
1902 READ(un,*,END=300)
1903 n = n + 1
1904ENDDO
1905
1906300 CONTINUE
1907
1908rewind(un)
1909ALLOCATE(conv_bwd(n),stat=stallo)
1910IF (stallo /= 0) THEN
1911 CALL l4f_log(l4f_fatal,"allocating memory")
1912 CALL raise_fatal_error()
1913end if
1914
1915conv_bwd(:) = vg6d_v7d_var_conv_miss
1916CALL import_var_conv(un, conv_bwd)
1917DO i = 1, n
1918 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1919 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1920ENDDO
1921CLOSE(un)
1922
1923CONTAINS
1924
1925SUBROUTINE import_var_conv(un, conv_type)
1926INTEGER, INTENT(in) :: un
1927TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1928
1929INTEGER :: i
1930TYPE(csv_record) :: csv
1931CHARACTER(len=1024) :: line
1932CHARACTER(len=10) :: btable
1933INTEGER :: centre, category, number, discipline
1934
1935DO i = 1, SIZE(conv_type)
1936 READ(un,'(A)',END=200)line
1937 CALL init(csv, line)
1938 CALL csv_record_getfield(csv, btable)
1939 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1940 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1941 CALL init(conv_type(i)%v7d_var, btable=btable)
1942
1943 CALL csv_record_getfield(csv, centre)
1944 CALL csv_record_getfield(csv, category)
1945 CALL csv_record_getfield(csv, number)
1946 CALL csv_record_getfield(csv, discipline)
1947 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
1948 number=number, discipline=discipline) ! controllare l'ordine
1949
1950 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1951 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1952 CALL delete(csv)
1953ENDDO
1954
1955200 CONTINUE
1956
1957END SUBROUTINE import_var_conv
1958
1959END SUBROUTINE vg6d_v7d_var_conv_setup
1960
1961
1962ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1963TYPE(conv_func),INTENT(IN) :: this, that
1964LOGICAL :: res
1965
1966res = this%a == that%a .AND. this%b == that%b
1967
1968END FUNCTION conv_func_eq
1969
1970
1971ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1972TYPE(conv_func),INTENT(IN) :: this, that
1973LOGICAL :: res
1974
1975res = .NOT.(this == that)
1976
1977END FUNCTION conv_func_ne
1978
1979
1980FUNCTION conv_func_mult(this, that) RESULT(mult)
1981TYPE(conv_func),INTENT(in) :: this
1982TYPE(conv_func),INTENT(in) :: that
1983
1984TYPE(conv_func) :: mult
1985
1986IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1987 mult = conv_func_miss
1988ELSE
1989 mult%a = this%a*that%a
1990 mult%b = this%a*that%b+this%b
1991ENDIF
1992
1993END FUNCTION conv_func_mult
1994
2002ELEMENTAL SUBROUTINE conv_func_compute(this, values)
2003TYPE(conv_func),INTENT(in) :: this
2004REAL,INTENT(inout) :: values
2005
2006IF (this /= conv_func_miss) THEN
2007 IF (c_e(values)) values = values*this%a + this%b
2008ELSE
2009 values=rmiss
2010ENDIF
2011
2012END SUBROUTINE conv_func_compute
2013
2014
2022ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
2023TYPE(conv_func),intent(in) :: this
2024REAL,INTENT(in) :: values
2025REAL :: convert
2026
2027convert = values
2028CALL compute(this, convert)
2029
2030END FUNCTION conv_func_convert
2031
2032
2046SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
2047TYPE(volgrid6d_var),INTENT(in) :: this(:)
2048INTEGER,POINTER :: xind(:), yind(:)
2049
2050TYPE(vol7d_var) :: varbufr(SIZE(this))
2051TYPE(conv_func),POINTER :: c_func(:)
2052INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
2053
2054NULLIFY(xind, yind)
2055counts(:) = 0
2056
2057CALL vargrib2varbufr(this, varbufr, c_func)
2058
2059DO i = 1, SIZE(vol7d_var_horcomp)
2060 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
2061ENDDO
2062
2063IF (any(counts(1::2) > 1)) THEN
2064 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
2065 DEALLOCATE(c_func)
2066 RETURN
2067ENDIF
2068IF (any(counts(2::2) > 1)) THEN
2069 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
2070 DEALLOCATE(c_func)
2071 RETURN
2072ENDIF
2073
2074! check that variables are paired and count pairs
2075nv = 0
2076DO i = 1, SIZE(vol7d_var_horcomp), 2
2077 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
2078 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
2079 ' present but the corresponding x-component '// &
2080 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
2081 RETURN
2082 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
2083 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
2084 ' present but the corresponding y-component '// &
2085 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
2086 RETURN
2087 ENDIF
2088 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
2089ENDDO
2090
2091! repeat the loop storing indices
2092ALLOCATE(xind(nv), yind(nv))
2093nv = 0
2094DO i = 1, SIZE(vol7d_var_horcomp), 2
2095 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
2096 nv = nv + 1
2097 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
2098 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
2099 ENDIF
2100ENDDO
2101DEALLOCATE(c_func)
2102
2103END SUBROUTINE volgrid6d_var_hor_comp_index
2104
2105
2110FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
2111TYPE(volgrid6d_var),INTENT(in) :: this
2112LOGICAL :: is_hor_comp
2113
2114TYPE(vol7d_var) :: varbufr
2115
2116varbufr = convert(this)
2117is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
2118
2119END FUNCTION volgrid6d_var_is_hor_comp
2120
2121! before unstaggering??
2122
2123!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
2124!
2125!call init(varu,btable="B11003")
2126!call init(varv,btable="B11004")
2127!
2128! test about presence of u and v in standard table
2129!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
2130! call l4f_category_log(this%category,L4F_FATAL, &
2131! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
2132! CALL raise_error()
2133! RETURN
2134!end if
2135!
2136!if (associated(this%var))then
2137! nvar=size(this%var)
2138! allocate(varbufr(nvar),stat=stallo)
2139! if (stallo /=0)then
2140! call l4f_log(L4F_FATAL,"allocating memory")
2141! call raise_fatal_error("allocating memory")
2142! end if
2143!
2144! CALL vargrib2varbufr(this%var, varbufr)
2145!ELSE
2146! CALL l4f_category_log(this%category, L4F_ERROR, &
2147! "trying to destagger an incomplete volgrid6d object")
2148! CALL raise_error()
2149! RETURN
2150!end if
2151!
2152!nvaru=COUNT(varbufr==varu)
2153!nvarv=COUNT(varbufr==varv)
2154!
2155!if (nvaru > 1 )then
2156! call l4f_category_log(this%category,L4F_WARN, &
2157! ">1 variables refer to u wind component, destaggering will not be done ")
2158! DEALLOCATE(varbufr)
2159! RETURN
2160!endif
2161!
2162!if (nvarv > 1 )then
2163! call l4f_category_log(this%category,L4F_WARN, &
2164! ">1 variables refer to v wind component, destaggering will not be done ")
2165! DEALLOCATE(varbufr)
2166! RETURN
2167!endif
2168!
2169!if (nvaru == 0 .and. nvarv == 0) then
2170! call l4f_category_log(this%category,L4F_WARN, &
2171! "no u or v wind component found in volume, nothing to do")
2172! DEALLOCATE(varbufr)
2173! RETURN
2174!endif
2175!
2176!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2177! call l4f_category_log(this%category,L4F_WARN, &
2178! "there are variables different from u and v wind component in C grid")
2179!endif
2180
2181
2182END 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.