libsim Versione 7.2.0

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

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