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