libsim Versione 7.1.11
|
◆ varbufr2vargrib_convert()
Convert a vol7d_var object into a physically equivalent volgrid6d_var object. This method returns a grib-like representation of type volgrid6d_var of the bufr-like input physical variable varbufr. Unlike the opposite convert method, in this case the conversion is not uniqe and at the moment the first matching grib-like variable is chosen, without any control over the choice process. The method optionally returns a conv_func object which can successively be used to convert the numerical values of the field associated to varbufr to the corresponding fields in the grib-like representation. If the conversion is not successful, the output variable is set to volgrid6d_var_miss and the conversion function to conv_func_miss.
Definizione alla linea 1212 del file volgrid6d_var_class.F90. 1213! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1214! authors:
1215! Davide Cesari <dcesari@arpa.emr.it>
1216! Paolo Patruno <ppatruno@arpa.emr.it>
1217
1218! This program is free software; you can redistribute it and/or
1219! modify it under the terms of the GNU General Public License as
1220! published by the Free Software Foundation; either version 2 of
1221! the License, or (at your option) any later version.
1222
1223! This program is distributed in the hope that it will be useful,
1224! but WITHOUT ANY WARRANTY; without even the implied warranty of
1225! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1226! GNU General Public License for more details.
1227
1228! You should have received a copy of the GNU General Public License
1229! along with this program. If not, see <http://www.gnu.org/licenses/>.
1230#include "config.h"
1231
1249
1250IMPLICIT NONE
1251
1257 integer :: centre
1258 integer :: category
1259 integer :: number
1260 integer :: discipline
1261 CHARACTER(len=65) :: description
1262 CHARACTER(len=24) :: unit
1264
1265TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1266 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1267
1268TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1271 /)
1272
1273TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1278/)
1279!/), (/2,2/)) ! bug in gfortran
1280
1290 PRIVATE
1291 REAL :: a, b
1293
1296
1297TYPE vg6d_v7d_var_conv
1298 TYPE(volgrid6d_var) :: vg6d_var
1299 TYPE(vol7d_var) :: v7d_var
1300 TYPE(conv_func) :: c_func
1301! aggiungere informazioni ad es. su rotazione del vento
1302END TYPE vg6d_v7d_var_conv
1303
1304TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1305 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1306
1307TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1308
1323 MODULE PROCEDURE volgrid6d_var_init
1324END INTERFACE
1325
1329 MODULE PROCEDURE volgrid6d_var_delete
1330END INTERFACE
1331
1332INTERFACE c_e
1333 MODULE PROCEDURE volgrid6d_var_c_e
1334END INTERFACE
1335
1336
1341INTERFACE OPERATOR (==)
1342 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1343END INTERFACE
1344
1349INTERFACE OPERATOR (/=)
1350 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1351END INTERFACE
1352
1353#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1354#define VOL7D_POLY_TYPES _var6d
1355#include "array_utilities_pre.F90"
1356
1359 MODULE PROCEDURE display_volgrid6d_var
1360END INTERFACE
1361
1366INTERFACE OPERATOR (*)
1367 MODULE PROCEDURE conv_func_mult
1368END INTERFACE OPERATOR (*)
1369
1373 MODULE PROCEDURE conv_func_compute
1374END INTERFACE
1375
1379 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1380 conv_func_convert
1381END INTERFACE
1382
1383PRIVATE
1385 c_e, volgrid6d_var_normalize, &
1386 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1387 count_distinct, pack_distinct, count_and_pack_distinct, &
1388 map_distinct, map_inv_distinct, &
1390 vargrib2varbufr, varbufr2vargrib, &
1392 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1393
1394
1395CONTAINS
1396
1397
1398ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1399 discipline, description, unit) RESULT(this)
1400integer,INTENT(in),OPTIONAL :: centre
1401integer,INTENT(in),OPTIONAL :: category
1402integer,INTENT(in),OPTIONAL :: number
1403integer,INTENT(in),OPTIONAL :: discipline
1404CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1405CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1406
1407TYPE(volgrid6d_var) :: this
1408
1410
1411END FUNCTION volgrid6d_var_new
1412
1413
1414! documented in the interface
1415ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1416TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1417INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1418INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1419INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1420INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1421CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1422CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1423
1424IF (PRESENT(centre)) THEN
1425 this%centre = centre
1426ELSE
1427 this%centre = imiss
1428 this%category = imiss
1429 this%number = imiss
1430 this%discipline = imiss
1431 RETURN
1432ENDIF
1433
1434IF (PRESENT(category)) THEN
1435 this%category = category
1436ELSE
1437 this%category = imiss
1438 this%number = imiss
1439 this%discipline = imiss
1440 RETURN
1441ENDIF
1442
1443
1444IF (PRESENT(number)) THEN
1445 this%number = number
1446ELSE
1447 this%number = imiss
1448 this%discipline = imiss
1449 RETURN
1450ENDIF
1451
1452! se sono arrivato fino a qui ho impostato centre, category e number
1453!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1454
1455IF (PRESENT(discipline)) THEN
1456 this%discipline = discipline
1457ELSE
1458 this%discipline = 255
1459ENDIF
1460
1461IF (PRESENT(description)) THEN
1462 this%description = description
1463ELSE
1464 this%description = cmiss
1465ENDIF
1466
1467IF (PRESENT(unit)) THEN
1468 this%unit = unit
1469ELSE
1470 this%unit = cmiss
1471ENDIF
1472
1473
1474
1475END SUBROUTINE volgrid6d_var_init
1476
1477
1478! documented in the interface
1479SUBROUTINE volgrid6d_var_delete(this)
1480TYPE(volgrid6d_var),INTENT(INOUT) :: this
1481
1482this%centre = imiss
1483this%category = imiss
1484this%number = imiss
1485this%discipline = imiss
1486this%description = cmiss
1487this%unit = cmiss
1488
1489END SUBROUTINE volgrid6d_var_delete
1490
1491
1492ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1493TYPE(volgrid6d_var),INTENT(IN) :: this
1494LOGICAL :: c_e
1495c_e = this /= volgrid6d_var_miss
1496END FUNCTION volgrid6d_var_c_e
1497
1498
1499ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1500TYPE(volgrid6d_var),INTENT(IN) :: this, that
1501LOGICAL :: res
1502
1503IF (this%discipline == that%discipline) THEN
1504
1505 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1506 res = ((this%category == that%category) .OR. &
1507 (this%category >= 1 .AND. this%category <=3 .AND. &
1508 that%category >= 1 .AND. that%category <=3)) .AND. &
1509 this%number == that%number
1510
1511 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1512 (this%number >= 128 .AND. this%number <= 254)) THEN
1513 res = res .AND. this%centre == that%centre ! local definition, centre matters
1514 ENDIF
1515
1516 ELSE ! grib2
1517 res = this%category == that%category .AND. &
1518 this%number == that%number
1519
1520 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1521 (this%category >= 192 .AND. this%category <= 254) .OR. &
1522 (this%number >= 192 .AND. this%number <= 254)) THEN
1523 res = res .AND. this%centre == that%centre ! local definition, centre matters
1524 ENDIF
1525 ENDIF
1526
1527ELSE ! different edition or different discipline
1528 res = .false.
1529ENDIF
1530
1531END FUNCTION volgrid6d_var_eq
1532
1533
1534ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1535TYPE(volgrid6d_var),INTENT(IN) :: this, that
1536LOGICAL :: res
1537
1538res = .NOT.(this == that)
1539
1540END FUNCTION volgrid6d_var_ne
1541
1542
1543#include "array_utilities_inc.F90"
1544
1545
1547SUBROUTINE display_volgrid6d_var(this)
1548TYPE(volgrid6d_var),INTENT(in) :: this
1549
1550print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1551
1552END SUBROUTINE display_volgrid6d_var
1553
1554
1567SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1568TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1569TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1570TYPE(conv_func),POINTER :: c_func(:)
1571
1572INTEGER :: i, n, stallo
1573
1574n = min(SIZE(varbufr), SIZE(vargrib))
1575ALLOCATE(c_func(n),stat=stallo)
1576IF (stallo /= 0) THEN
1577 call l4f_log(l4f_fatal,"allocating memory")
1578 call raise_fatal_error()
1579ENDIF
1580
1581DO i = 1, n
1582 varbufr(i) = convert(vargrib(i), c_func(i))
1583ENDDO
1584
1585END SUBROUTINE vargrib2varbufr
1586
1587
1598FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1599TYPE(volgrid6d_var),INTENT(in) :: vargrib
1600TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1601TYPE(vol7d_var) :: convert
1602
1603INTEGER :: i
1604
1605IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1606
1607DO i = 1, SIZE(conv_fwd)
1608 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1609 convert = conv_fwd(i)%v7d_var
1610 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1611 RETURN
1612 ENDIF
1613ENDDO
1614! not found
1615convert = vol7d_var_miss
1616IF (PRESENT(c_func)) c_func = conv_func_miss
1617
1618! set hint for backwards conversion
1619convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1620 vargrib%discipline/)
1621
1622CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1623 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1624 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1625 ' not found in table')
1626
1627END FUNCTION vargrib2varbufr_convert
1628
1629
1645SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1646TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1647TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1648TYPE(conv_func),POINTER :: c_func(:)
1649TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1650
1651INTEGER :: i, n, stallo
1652
1653n = min(SIZE(varbufr), SIZE(vargrib))
1654ALLOCATE(c_func(n),stat=stallo)
1655IF (stallo /= 0) THEN
1656 CALL l4f_log(l4f_fatal,"allocating memory")
1657 CALL raise_fatal_error()
1658ENDIF
1659
1660DO i = 1, n
1661 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1662ENDDO
1663
1664END SUBROUTINE varbufr2vargrib
1665
1666
1680FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1681TYPE(vol7d_var),INTENT(in) :: varbufr
1682TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1683TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1684TYPE(volgrid6d_var) :: convert
1685
1686INTEGER :: i
1687#ifdef HAVE_LIBGRIBAPI
1688INTEGER :: gaid, editionnumber, category, centre
1689#endif
1690
1691IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1692
1693#ifdef HAVE_LIBGRIBAPI
1694editionnumber=255; category=255; centre=255
1695#endif
1696IF (PRESENT(grid_id_template)) THEN
1697#ifdef HAVE_LIBGRIBAPI
1698 gaid = grid_id_get_gaid(grid_id_template)
1699 IF (c_e(gaid)) THEN
1700 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1701 IF (editionnumber == 1) THEN
1702 CALL grib_get(gaid,'gribTablesVersionNo',category)
1703 ENDIF
1704 CALL grib_get(gaid,'centre',centre)
1705 ENDIF
1706#endif
1707ENDIF
1708
1709DO i = 1, SIZE(conv_bwd)
1710 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1711#ifdef HAVE_LIBGRIBAPI
1712 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1713 IF (editionnumber == 1) THEN
1714 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1715 ELSE IF (editionnumber == 2) THEN
1716 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1717 ENDIF
1718 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1719 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1720 ENDIF
1721#endif
1722 convert = conv_bwd(i)%vg6d_var
1723 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1724 RETURN
1725 ENDIF
1726ENDDO
1727! not found
1728convert = volgrid6d_var_miss
1729IF (PRESENT(c_func)) c_func = conv_func_miss
1730
1731! if hint available use it as a fallback
1732IF (any(varbufr%gribhint /= imiss)) THEN
1733 convert%centre = varbufr%gribhint(1)
1734 convert%category = varbufr%gribhint(2)
1735 convert%number = varbufr%gribhint(3)
1736 convert%discipline = varbufr%gribhint(4)
1737ENDIF
1738
1739CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1740 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1741 ' not found in table')
1742
1743END FUNCTION varbufr2vargrib_convert
1744
1745
1753SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1754TYPE(volgrid6d_var),INTENT(inout) :: this
1755TYPE(conv_func),INTENT(out) :: c_func
1756TYPE(grid_id),INTENT(in) :: grid_id_template
1757
1758LOGICAL :: eqed, eqcentre
1759INTEGER :: gaid, editionnumber, centre
1760TYPE(volgrid6d_var) :: tmpgrib
1761TYPE(vol7d_var) :: tmpbufr
1762TYPE(conv_func) tmpc_func1, tmpc_func2
1763
1764eqed = .true.
1765eqcentre = .true.
1766c_func = conv_func_miss
1767
1768#ifdef HAVE_LIBGRIBAPI
1769gaid = grid_id_get_gaid(grid_id_template)
1770IF (c_e(gaid)) THEN
1771 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1772 CALL grib_get(gaid, 'centre', centre)
1773 eqed = editionnumber == 1 .EQV. this%discipline == 255
1774 eqcentre = centre == this%centre
1775ENDIF
1776#endif
1777
1778IF (eqed .AND. eqcentre) RETURN ! nothing to do
1779
1780tmpbufr = convert(this, tmpc_func1)
1781tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1782
1783IF (tmpgrib /= volgrid6d_var_miss) THEN
1784! conversion back and forth successful, set also conversion function
1785 this = tmpgrib
1786 c_func = tmpc_func1 * tmpc_func2
1787! set to missing in common case to avoid useless computation
1788 IF (c_func == conv_func_identity) c_func = conv_func_miss
1789ELSE IF (.NOT.eqed) THEN
1790! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1791 this = tmpgrib
1792ENDIF
1793
1794END SUBROUTINE volgrid6d_var_normalize
1795
1796
1797! Private subroutine for reading forward and backward conversion tables
1798! todo: better error handling
1799SUBROUTINE vg6d_v7d_var_conv_setup()
1800INTEGER :: un, i, n, stallo
1801
1802! forward, grib to bufr
1803un = open_package_file('vargrib2bufr.csv', filetype_data)
1804n=0
1805DO WHILE(.true.)
1806 READ(un,*,END=100)
1807 n = n + 1
1808ENDDO
1809
1810100 CONTINUE
1811
1812rewind(un)
1813ALLOCATE(conv_fwd(n),stat=stallo)
1814IF (stallo /= 0) THEN
1815 CALL l4f_log(l4f_fatal,"allocating memory")
1816 CALL raise_fatal_error()
1817ENDIF
1818
1819conv_fwd(:) = vg6d_v7d_var_conv_miss
1820CALL import_var_conv(un, conv_fwd)
1821CLOSE(un)
1822
1823! backward, bufr to grib
1824un = open_package_file('vargrib2bufr.csv', filetype_data)
1825! use the same file for now
1826!un = open_package_file('varbufr2grib.csv', filetype_data)
1827n=0
1828DO WHILE(.true.)
1829 READ(un,*,END=300)
1830 n = n + 1
1831ENDDO
1832
1833300 CONTINUE
1834
1835rewind(un)
1836ALLOCATE(conv_bwd(n),stat=stallo)
1837IF (stallo /= 0) THEN
1838 CALL l4f_log(l4f_fatal,"allocating memory")
1839 CALL raise_fatal_error()
1840end if
1841
1842conv_bwd(:) = vg6d_v7d_var_conv_miss
1843CALL import_var_conv(un, conv_bwd)
1844DO i = 1, n
1845 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1846 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1847ENDDO
1848CLOSE(un)
1849
1850CONTAINS
1851
1852SUBROUTINE import_var_conv(un, conv_type)
1853INTEGER, INTENT(in) :: un
1854TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1855
1856INTEGER :: i
1857TYPE(csv_record) :: csv
1858CHARACTER(len=1024) :: line
1859CHARACTER(len=10) :: btable
1860INTEGER :: centre, category, number, discipline
1861
1862DO i = 1, SIZE(conv_type)
1863 READ(un,'(A)',END=200)line
1865 CALL csv_record_getfield(csv, btable)
1866 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1867 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1869
1870 CALL csv_record_getfield(csv, centre)
1871 CALL csv_record_getfield(csv, category)
1872 CALL csv_record_getfield(csv, number)
1873 CALL csv_record_getfield(csv, discipline)
1875 number=number, discipline=discipline) ! controllare l'ordine
1876
1877 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1878 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1880ENDDO
1881
1882200 CONTINUE
1883
1884END SUBROUTINE import_var_conv
1885
1886END SUBROUTINE vg6d_v7d_var_conv_setup
1887
1888
1889ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1890TYPE(conv_func),INTENT(IN) :: this, that
1891LOGICAL :: res
1892
1893res = this%a == that%a .AND. this%b == that%b
1894
1895END FUNCTION conv_func_eq
1896
1897
1898ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1899TYPE(conv_func),INTENT(IN) :: this, that
1900LOGICAL :: res
1901
1902res = .NOT.(this == that)
1903
1904END FUNCTION conv_func_ne
1905
1906
1907FUNCTION conv_func_mult(this, that) RESULT(mult)
1908TYPE(conv_func),INTENT(in) :: this
1909TYPE(conv_func),INTENT(in) :: that
1910
1911TYPE(conv_func) :: mult
1912
1913IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1914 mult = conv_func_miss
1915ELSE
1916 mult%a = this%a*that%a
1917 mult%b = this%a*that%b+this%b
1918ENDIF
1919
1920END FUNCTION conv_func_mult
1921
1929ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1930TYPE(conv_func),INTENT(in) :: this
1931REAL,INTENT(inout) :: values
1932
1933IF (this /= conv_func_miss) THEN
1934 IF (c_e(values)) values = values*this%a + this%b
1935ELSE
1936 values=rmiss
1937ENDIF
1938
1939END SUBROUTINE conv_func_compute
1940
1941
1949ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1950TYPE(conv_func),intent(in) :: this
1951REAL,INTENT(in) :: values
1952REAL :: convert
1953
1954convert = values
1956
1957END FUNCTION conv_func_convert
1958
1959
1973SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1974TYPE(volgrid6d_var),INTENT(in) :: this(:)
1975INTEGER,POINTER :: xind(:), yind(:)
1976
1977TYPE(vol7d_var) :: varbufr(SIZE(this))
1978TYPE(conv_func),POINTER :: c_func(:)
1979INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1980
1981NULLIFY(xind, yind)
1982counts(:) = 0
1983
1984CALL vargrib2varbufr(this, varbufr, c_func)
1985
1986DO i = 1, SIZE(vol7d_var_horcomp)
1987 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1988ENDDO
1989
1990IF (any(counts(1::2) > 1)) THEN
1991 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1992 DEALLOCATE(c_func)
1993 RETURN
1994ENDIF
1995IF (any(counts(2::2) > 1)) THEN
1996 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1997 DEALLOCATE(c_func)
1998 RETURN
1999ENDIF
2000
2001! check that variables are paired and count pairs
2002nv = 0
2003DO i = 1, SIZE(vol7d_var_horcomp), 2
2004 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
2005 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
2006 ' present but the corresponding x-component '// &
2007 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
2008 RETURN
2009 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
2010 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
2011 ' present but the corresponding y-component '// &
2012 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
2013 RETURN
2014 ENDIF
2015 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
2016ENDDO
2017
2018! repeat the loop storing indices
2019ALLOCATE(xind(nv), yind(nv))
2020nv = 0
2021DO i = 1, SIZE(vol7d_var_horcomp), 2
2022 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
2023 nv = nv + 1
2024 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
2025 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
2026 ENDIF
2027ENDDO
2028DEALLOCATE(c_func)
2029
2030END SUBROUTINE volgrid6d_var_hor_comp_index
2031
2032
2037FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
2038TYPE(volgrid6d_var),INTENT(in) :: this
2039LOGICAL :: is_hor_comp
2040
2041TYPE(vol7d_var) :: varbufr
2042
2043varbufr = convert(this)
2044is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
2045
2046END FUNCTION volgrid6d_var_is_hor_comp
2047
2048! before unstaggering??
2049
2050!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
2051!
2052!call init(varu,btable="B11003")
2053!call init(varv,btable="B11004")
2054!
2055! test about presence of u and v in standard table
2056!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
2057! call l4f_category_log(this%category,L4F_FATAL, &
2058! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
2059! CALL raise_error()
2060! RETURN
2061!end if
2062!
2063!if (associated(this%var))then
2064! nvar=size(this%var)
2065! allocate(varbufr(nvar),stat=stallo)
2066! if (stallo /=0)then
2067! call l4f_log(L4F_FATAL,"allocating memory")
2068! call raise_fatal_error("allocating memory")
2069! end if
2070!
2071! CALL vargrib2varbufr(this%var, varbufr)
2072!ELSE
2073! CALL l4f_category_log(this%category, L4F_ERROR, &
2074! "trying to destagger an incomplete volgrid6d object")
2075! CALL raise_error()
2076! RETURN
2077!end if
2078!
2079!nvaru=COUNT(varbufr==varu)
2080!nvarv=COUNT(varbufr==varv)
2081!
2082!if (nvaru > 1 )then
2083! call l4f_category_log(this%category,L4F_WARN, &
2084! ">1 variables refer to u wind component, destaggering will not be done ")
2085! DEALLOCATE(varbufr)
2086! RETURN
2087!endif
2088!
2089!if (nvarv > 1 )then
2090! call l4f_category_log(this%category,L4F_WARN, &
2091! ">1 variables refer to v wind component, destaggering will not be done ")
2092! DEALLOCATE(varbufr)
2093! RETURN
2094!endif
2095!
2096!if (nvaru == 0 .and. nvarv == 0) then
2097! call l4f_category_log(this%category,L4F_WARN, &
2098! "no u or v wind component found in volume, nothing to do")
2099! DEALLOCATE(varbufr)
2100! RETURN
2101!endif
2102!
2103!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2104! call l4f_category_log(this%category,L4F_WARN, &
2105! "there are variables different from u and v wind component in C grid")
2106!endif
2107
2108
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 |