libsim Versione 7.2.1

◆ 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 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
1237USE kinds
1239USE err_handling
1242USE grid_id_class
1243
1244IMPLICIT NONE
1245
1250TYPE volgrid6d_var
1251 integer :: centre
1252 integer :: category
1253 integer :: number
1254 integer :: discipline
1255 CHARACTER(len=65) :: description
1256 CHARACTER(len=24) :: unit
1257END TYPE volgrid6d_var
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) = (/ &
1263 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1264 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
1265 /)
1266
1267TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1268 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1269 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
1270 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
1271 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
1272/)
1273!/), (/2,2/)) ! bug in gfortran
1274
1283TYPE conv_func
1284 PRIVATE
1285 REAL :: a, b
1286END TYPE conv_func
1287
1288TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
1289TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
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
1316INTERFACE init
1317 MODULE PROCEDURE volgrid6d_var_init
1318END INTERFACE
1319
1322INTERFACE delete
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
1352INTERFACE display
1353 MODULE PROCEDURE display_volgrid6d_var
1354END INTERFACE
1355
1360INTERFACE OPERATOR (*)
1361 MODULE PROCEDURE conv_func_mult
1362END INTERFACE OPERATOR (*)
1363
1366INTERFACE compute
1367 MODULE PROCEDURE conv_func_compute
1368END INTERFACE
1369
1372INTERFACE convert
1373 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1374 conv_func_convert
1375END INTERFACE
1376
1377PRIVATE
1378PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
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, &
1383 index, display, &
1384 vargrib2varbufr, varbufr2vargrib, &
1385 conv_func, conv_func_miss, compute, convert, &
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
1403CALL init(this, centre, category, number, discipline, description, unit)
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
1858 CALL init(csv, 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
1862 CALL init(conv_type(i)%v7d_var, btable=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)
1868 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
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)
1873 CALL delete(csv)
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
1949CALL compute(this, convert)
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
2103END 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:245
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.