libsim Versione 7.2.0
|
◆ 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 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
1316
1317IMPLICIT NONE
1318
1324 integer :: centre
1325 integer :: category
1326 integer :: number
1327 integer :: discipline
1328 CHARACTER(len=65) :: description
1329 CHARACTER(len=24) :: unit
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) = (/ &
1338 /)
1339
1340TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1345/)
1346!/), (/2,2/)) ! bug in gfortran
1347
1357 PRIVATE
1358 REAL :: a, b
1360
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
1390 MODULE PROCEDURE volgrid6d_var_init
1391END INTERFACE
1392
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
1426 MODULE PROCEDURE display_volgrid6d_var
1427END INTERFACE
1428
1433INTERFACE OPERATOR (*)
1434 MODULE PROCEDURE conv_func_mult
1435END INTERFACE OPERATOR (*)
1436
1440 MODULE PROCEDURE conv_func_compute
1441END INTERFACE
1442
1446 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1447 conv_func_convert
1448END INTERFACE
1449
1450PRIVATE
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, &
1457 vargrib2varbufr, varbufr2vargrib, &
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
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
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
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)
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)
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
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
Apply the conversion function this to values. Definition: volgrid6d_var_class.F90:390 Apply the conversion function this to values. Definition: volgrid6d_var_class.F90:396 Destructor for the corresponding object, it assigns it to a missing value. Definition: volgrid6d_var_class.F90:304 Display on the screen a brief content of object. Definition: volgrid6d_var_class.F90:376 Initialize a volgrid6d_var object with the optional arguments provided. Definition: volgrid6d_var_class.F90:298 This module defines an abstract interface to different drivers for access to files containing gridded... Definition: grid_id_class.F90:249 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. Definition: missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition: vol7d_var_class.F90:212 Class for managing physical variables in a grib 1/2 fashion. Definition: volgrid6d_var_class.F90:218 Definisce una variabile meteorologica osservata o un suo attributo. Definition: vol7d_var_class.F90:226 Class defining a real conversion function between units. Definition: volgrid6d_var_class.F90:265 Definition of a physical variable in grib coding style. Definition: volgrid6d_var_class.F90:232 |