libsim Versione 7.1.11
|
◆ volgrid6d_var_normalize()
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 .
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
1322
1323IMPLICIT NONE
1324
1330 integer :: centre
1331 integer :: category
1332 integer :: number
1333 integer :: discipline
1334 CHARACTER(len=65) :: description
1335 CHARACTER(len=24) :: unit
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) = (/ &
1344 /)
1345
1346TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1351/)
1352!/), (/2,2/)) ! bug in gfortran
1353
1363 PRIVATE
1364 REAL :: a, b
1366
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
1396 MODULE PROCEDURE volgrid6d_var_init
1397END INTERFACE
1398
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
1432 MODULE PROCEDURE display_volgrid6d_var
1433END INTERFACE
1434
1439INTERFACE OPERATOR (*)
1440 MODULE PROCEDURE conv_func_mult
1441END INTERFACE OPERATOR (*)
1442
1446 MODULE PROCEDURE conv_func_compute
1447END INTERFACE
1448
1452 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1453 conv_func_convert
1454END INTERFACE
1455
1456PRIVATE
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, &
1463 vargrib2varbufr, varbufr2vargrib, &
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
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
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
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)
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)
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
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
Apply the conversion function this to values. Definition: volgrid6d_var_class.F90:396 Apply the conversion function this to values. Definition: volgrid6d_var_class.F90:402 Destructor for the corresponding object, it assigns it to a missing value. Definition: volgrid6d_var_class.F90:310 Display on the screen a brief content of object. Definition: volgrid6d_var_class.F90:382 Initialize a volgrid6d_var object with the optional arguments provided. Definition: volgrid6d_var_class.F90:304 This module defines an abstract interface to different drivers for access to files containing gridded... Definition: grid_id_class.F90:255 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. Definition: missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition: vol7d_var_class.F90:218 Class for managing physical variables in a grib 1/2 fashion. Definition: volgrid6d_var_class.F90:224 Definisce una variabile meteorologica osservata o un suo attributo. Definition: vol7d_var_class.F90:232 Class defining a real conversion function between units. Definition: volgrid6d_var_class.F90:271 Definition of a physical variable in grib coding style. Definition: volgrid6d_var_class.F90:238 |