libsim Versione 7.1.11

◆ varbufr2vargrib_convert()

type(volgrid6d_var) function varbufr2vargrib_convert ( type(vol7d_var), intent(in)  varbufr,
type(conv_func), intent(out), optional  c_func,
type(grid_id), intent(in), optional  grid_id_template 
)

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.

Parametri
[in]varbufrinput bufr-like variable
[out]c_funccorresponding conv_func object
[in]grid_id_templatea template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion

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
1243USE kinds
1245USE err_handling
1248USE grid_id_class
1249
1250IMPLICIT NONE
1251
1256TYPE volgrid6d_var
1257 integer :: centre
1258 integer :: category
1259 integer :: number
1260 integer :: discipline
1261 CHARACTER(len=65) :: description
1262 CHARACTER(len=24) :: unit
1263END TYPE volgrid6d_var
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) = (/ &
1269 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1270 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
1271 /)
1272
1273TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1274 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1275 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
1276 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
1277 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
1278/)
1279!/), (/2,2/)) ! bug in gfortran
1280
1289TYPE conv_func
1290 PRIVATE
1291 REAL :: a, b
1292END TYPE conv_func
1293
1294TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
1295TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
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
1322INTERFACE init
1323 MODULE PROCEDURE volgrid6d_var_init
1324END INTERFACE
1325
1328INTERFACE delete
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
1358INTERFACE display
1359 MODULE PROCEDURE display_volgrid6d_var
1360END INTERFACE
1361
1366INTERFACE OPERATOR (*)
1367 MODULE PROCEDURE conv_func_mult
1368END INTERFACE OPERATOR (*)
1369
1372INTERFACE compute
1373 MODULE PROCEDURE conv_func_compute
1374END INTERFACE
1375
1378INTERFACE convert
1379 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1380 conv_func_convert
1381END INTERFACE
1382
1383PRIVATE
1384PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
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, &
1389 index, display, &
1390 vargrib2varbufr, varbufr2vargrib, &
1391 conv_func, conv_func_miss, compute, convert, &
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
1409CALL init(this, centre, category, number, discipline, description, unit)
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
1864 CALL init(csv, 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
1868 CALL init(conv_type(i)%v7d_var, btable=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)
1874 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
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)
1879 CALL delete(csv)
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
1955CALL compute(this, convert)
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
2109END MODULE volgrid6d_var_class
Index method.
Apply the conversion function this to values.
Apply the conversion function this to values.
Destructor for the corresponding object, it assigns it to a missing value.
Display on the screen a brief content of object.
Initialize a volgrid6d_var object with the optional arguments provided.
Gestione degli errori.
Utilities for managing files.
This module defines an abstract interface to different drivers for access to files containing gridded...
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:251
Definitions of constants and functions for working with missing values.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Class for managing physical variables in a grib 1/2 fashion.
Definisce una variabile meteorologica osservata o un suo attributo.
Class defining a real conversion function between units.
Definition of a physical variable in grib coding style.

Generated with Doxygen.