libsim Versione 7.1.11

◆ varbufr2vargrib()

subroutine, public varbufr2vargrib ( type(vol7d_var), dimension(:), intent(in)  varbufr,
type(volgrid6d_var), dimension(:), intent(out)  vargrib,
type(conv_func), dimension(:), pointer  c_func,
type(grid_id), intent(in), optional  grid_id_template 
)

Convert a vol7d_var array object into a physically equivalent volgrid6d_var array object.

This method converts a bufr-like array of physical variables vargrib, to an array of grib-like variables varbufr. Unlike the opposite method vargrib2varbufr, 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 output array must have enough room for the converted variables. The method additionally allocates a conv_func array object of the same size, which can successively be used to convert the numerical values of the fields associated to varbufr to the corresponding fields in the grib-like representation. c_func will have to be deallocated by the calling procedure. If a conversion is not successful, the corresponding output variable is set to volgrid6d_var_miss and the conversion function to conv_func_miss.

Parametri
[in]varbufrarray of input bufr-like variables
[out]vargribarray of output grib-like variables
c_funcpointer to an array of the corresponding conv_func objects, allocated in the method
[in]grid_id_templatea template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion

Definizione alla linea 1177 del file volgrid6d_var_class.F90.

1178! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1179! authors:
1180! Davide Cesari <dcesari@arpa.emr.it>
1181! Paolo Patruno <ppatruno@arpa.emr.it>
1182
1183! This program is free software; you can redistribute it and/or
1184! modify it under the terms of the GNU General Public License as
1185! published by the Free Software Foundation; either version 2 of
1186! the License, or (at your option) any later version.
1187
1188! This program is distributed in the hope that it will be useful,
1189! but WITHOUT ANY WARRANTY; without even the implied warranty of
1190! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1191! GNU General Public License for more details.
1192
1193! You should have received a copy of the GNU General Public License
1194! along with this program. If not, see <http://www.gnu.org/licenses/>.
1195#include "config.h"
1196
1208USE kinds
1210USE err_handling
1213USE grid_id_class
1214
1215IMPLICIT NONE
1216
1221TYPE volgrid6d_var
1222 integer :: centre
1223 integer :: category
1224 integer :: number
1225 integer :: discipline
1226 CHARACTER(len=65) :: description
1227 CHARACTER(len=24) :: unit
1228END TYPE volgrid6d_var
1229
1230TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1231 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1232
1233TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1234 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1235 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
1236 /)
1237
1238TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1239 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1240 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
1241 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
1242 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
1243/)
1244!/), (/2,2/)) ! bug in gfortran
1245
1254TYPE conv_func
1255 PRIVATE
1256 REAL :: a, b
1257END TYPE conv_func
1258
1259TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
1260TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
1261
1262TYPE vg6d_v7d_var_conv
1263 TYPE(volgrid6d_var) :: vg6d_var
1264 TYPE(vol7d_var) :: v7d_var
1265 TYPE(conv_func) :: c_func
1266! aggiungere informazioni ad es. su rotazione del vento
1267END TYPE vg6d_v7d_var_conv
1268
1269TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1270 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1271
1272TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1273
1287INTERFACE init
1288 MODULE PROCEDURE volgrid6d_var_init
1289END INTERFACE
1290
1293INTERFACE delete
1294 MODULE PROCEDURE volgrid6d_var_delete
1295END INTERFACE
1296
1297INTERFACE c_e
1298 MODULE PROCEDURE volgrid6d_var_c_e
1299END INTERFACE
1300
1301
1306INTERFACE OPERATOR (==)
1307 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1308END INTERFACE
1309
1314INTERFACE OPERATOR (/=)
1315 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1316END INTERFACE
1317
1318#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1319#define VOL7D_POLY_TYPES _var6d
1320#include "array_utilities_pre.F90"
1321
1323INTERFACE display
1324 MODULE PROCEDURE display_volgrid6d_var
1325END INTERFACE
1326
1331INTERFACE OPERATOR (*)
1332 MODULE PROCEDURE conv_func_mult
1333END INTERFACE OPERATOR (*)
1334
1337INTERFACE compute
1338 MODULE PROCEDURE conv_func_compute
1339END INTERFACE
1340
1343INTERFACE convert
1344 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1345 conv_func_convert
1346END INTERFACE
1347
1348PRIVATE
1349PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
1350 c_e, volgrid6d_var_normalize, &
1351 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1352 count_distinct, pack_distinct, count_and_pack_distinct, &
1353 map_distinct, map_inv_distinct, &
1354 index, display, &
1355 vargrib2varbufr, varbufr2vargrib, &
1356 conv_func, conv_func_miss, compute, convert, &
1357 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1358
1359
1360CONTAINS
1361
1362
1363ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1364 discipline, description, unit) RESULT(this)
1365integer,INTENT(in),OPTIONAL :: centre
1366integer,INTENT(in),OPTIONAL :: category
1367integer,INTENT(in),OPTIONAL :: number
1368integer,INTENT(in),OPTIONAL :: discipline
1369CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1370CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1371
1372TYPE(volgrid6d_var) :: this
1373
1374CALL init(this, centre, category, number, discipline, description, unit)
1375
1376END FUNCTION volgrid6d_var_new
1377
1378
1379! documented in the interface
1380ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1381TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1382INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1383INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1384INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1385INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1386CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1387CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1388
1389IF (PRESENT(centre)) THEN
1390 this%centre = centre
1391ELSE
1392 this%centre = imiss
1393 this%category = imiss
1394 this%number = imiss
1395 this%discipline = imiss
1396 RETURN
1397ENDIF
1398
1399IF (PRESENT(category)) THEN
1400 this%category = category
1401ELSE
1402 this%category = imiss
1403 this%number = imiss
1404 this%discipline = imiss
1405 RETURN
1406ENDIF
1407
1408
1409IF (PRESENT(number)) THEN
1410 this%number = number
1411ELSE
1412 this%number = imiss
1413 this%discipline = imiss
1414 RETURN
1415ENDIF
1416
1417! se sono arrivato fino a qui ho impostato centre, category e number
1418!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1419
1420IF (PRESENT(discipline)) THEN
1421 this%discipline = discipline
1422ELSE
1423 this%discipline = 255
1424ENDIF
1425
1426IF (PRESENT(description)) THEN
1427 this%description = description
1428ELSE
1429 this%description = cmiss
1430ENDIF
1431
1432IF (PRESENT(unit)) THEN
1433 this%unit = unit
1434ELSE
1435 this%unit = cmiss
1436ENDIF
1437
1438
1439
1440END SUBROUTINE volgrid6d_var_init
1441
1442
1443! documented in the interface
1444SUBROUTINE volgrid6d_var_delete(this)
1445TYPE(volgrid6d_var),INTENT(INOUT) :: this
1446
1447this%centre = imiss
1448this%category = imiss
1449this%number = imiss
1450this%discipline = imiss
1451this%description = cmiss
1452this%unit = cmiss
1453
1454END SUBROUTINE volgrid6d_var_delete
1455
1456
1457ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1458TYPE(volgrid6d_var),INTENT(IN) :: this
1459LOGICAL :: c_e
1460c_e = this /= volgrid6d_var_miss
1461END FUNCTION volgrid6d_var_c_e
1462
1463
1464ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1465TYPE(volgrid6d_var),INTENT(IN) :: this, that
1466LOGICAL :: res
1467
1468IF (this%discipline == that%discipline) THEN
1469
1470 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1471 res = ((this%category == that%category) .OR. &
1472 (this%category >= 1 .AND. this%category <=3 .AND. &
1473 that%category >= 1 .AND. that%category <=3)) .AND. &
1474 this%number == that%number
1475
1476 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1477 (this%number >= 128 .AND. this%number <= 254)) THEN
1478 res = res .AND. this%centre == that%centre ! local definition, centre matters
1479 ENDIF
1480
1481 ELSE ! grib2
1482 res = this%category == that%category .AND. &
1483 this%number == that%number
1484
1485 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1486 (this%category >= 192 .AND. this%category <= 254) .OR. &
1487 (this%number >= 192 .AND. this%number <= 254)) THEN
1488 res = res .AND. this%centre == that%centre ! local definition, centre matters
1489 ENDIF
1490 ENDIF
1491
1492ELSE ! different edition or different discipline
1493 res = .false.
1494ENDIF
1495
1496END FUNCTION volgrid6d_var_eq
1497
1498
1499ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1500TYPE(volgrid6d_var),INTENT(IN) :: this, that
1501LOGICAL :: res
1502
1503res = .NOT.(this == that)
1504
1505END FUNCTION volgrid6d_var_ne
1506
1507
1508#include "array_utilities_inc.F90"
1509
1510
1512SUBROUTINE display_volgrid6d_var(this)
1513TYPE(volgrid6d_var),INTENT(in) :: this
1514
1515print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1516
1517END SUBROUTINE display_volgrid6d_var
1518
1519
1532SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1533TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1534TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1535TYPE(conv_func),POINTER :: c_func(:)
1536
1537INTEGER :: i, n, stallo
1538
1539n = min(SIZE(varbufr), SIZE(vargrib))
1540ALLOCATE(c_func(n),stat=stallo)
1541IF (stallo /= 0) THEN
1542 call l4f_log(l4f_fatal,"allocating memory")
1543 call raise_fatal_error()
1544ENDIF
1545
1546DO i = 1, n
1547 varbufr(i) = convert(vargrib(i), c_func(i))
1548ENDDO
1549
1550END SUBROUTINE vargrib2varbufr
1551
1552
1563FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1564TYPE(volgrid6d_var),INTENT(in) :: vargrib
1565TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1566TYPE(vol7d_var) :: convert
1567
1568INTEGER :: i
1569
1570IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1571
1572DO i = 1, SIZE(conv_fwd)
1573 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1574 convert = conv_fwd(i)%v7d_var
1575 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1576 RETURN
1577 ENDIF
1578ENDDO
1579! not found
1580convert = vol7d_var_miss
1581IF (PRESENT(c_func)) c_func = conv_func_miss
1582
1583! set hint for backwards conversion
1584convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1585 vargrib%discipline/)
1586
1587CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1588 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1589 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1590 ' not found in table')
1591
1592END FUNCTION vargrib2varbufr_convert
1593
1594
1610SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1611TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1612TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1613TYPE(conv_func),POINTER :: c_func(:)
1614TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1615
1616INTEGER :: i, n, stallo
1617
1618n = min(SIZE(varbufr), SIZE(vargrib))
1619ALLOCATE(c_func(n),stat=stallo)
1620IF (stallo /= 0) THEN
1621 CALL l4f_log(l4f_fatal,"allocating memory")
1622 CALL raise_fatal_error()
1623ENDIF
1624
1625DO i = 1, n
1626 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1627ENDDO
1628
1629END SUBROUTINE varbufr2vargrib
1630
1631
1645FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1646TYPE(vol7d_var),INTENT(in) :: varbufr
1647TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1648TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1649TYPE(volgrid6d_var) :: convert
1650
1651INTEGER :: i
1652#ifdef HAVE_LIBGRIBAPI
1653INTEGER :: gaid, editionnumber, category, centre
1654#endif
1655
1656IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1657
1658#ifdef HAVE_LIBGRIBAPI
1659editionnumber=255; category=255; centre=255
1660#endif
1661IF (PRESENT(grid_id_template)) THEN
1662#ifdef HAVE_LIBGRIBAPI
1663 gaid = grid_id_get_gaid(grid_id_template)
1664 IF (c_e(gaid)) THEN
1665 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1666 IF (editionnumber == 1) THEN
1667 CALL grib_get(gaid,'gribTablesVersionNo',category)
1668 ENDIF
1669 CALL grib_get(gaid,'centre',centre)
1670 ENDIF
1671#endif
1672ENDIF
1673
1674DO i = 1, SIZE(conv_bwd)
1675 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1676#ifdef HAVE_LIBGRIBAPI
1677 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1678 IF (editionnumber == 1) THEN
1679 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1680 ELSE IF (editionnumber == 2) THEN
1681 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1682 ENDIF
1683 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1684 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1685 ENDIF
1686#endif
1687 convert = conv_bwd(i)%vg6d_var
1688 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1689 RETURN
1690 ENDIF
1691ENDDO
1692! not found
1693convert = volgrid6d_var_miss
1694IF (PRESENT(c_func)) c_func = conv_func_miss
1695
1696! if hint available use it as a fallback
1697IF (any(varbufr%gribhint /= imiss)) THEN
1698 convert%centre = varbufr%gribhint(1)
1699 convert%category = varbufr%gribhint(2)
1700 convert%number = varbufr%gribhint(3)
1701 convert%discipline = varbufr%gribhint(4)
1702ENDIF
1703
1704CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1705 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1706 ' not found in table')
1707
1708END FUNCTION varbufr2vargrib_convert
1709
1710
1718SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1719TYPE(volgrid6d_var),INTENT(inout) :: this
1720TYPE(conv_func),INTENT(out) :: c_func
1721TYPE(grid_id),INTENT(in) :: grid_id_template
1722
1723LOGICAL :: eqed, eqcentre
1724INTEGER :: gaid, editionnumber, centre
1725TYPE(volgrid6d_var) :: tmpgrib
1726TYPE(vol7d_var) :: tmpbufr
1727TYPE(conv_func) tmpc_func1, tmpc_func2
1728
1729eqed = .true.
1730eqcentre = .true.
1731c_func = conv_func_miss
1732
1733#ifdef HAVE_LIBGRIBAPI
1734gaid = grid_id_get_gaid(grid_id_template)
1735IF (c_e(gaid)) THEN
1736 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1737 CALL grib_get(gaid, 'centre', centre)
1738 eqed = editionnumber == 1 .EQV. this%discipline == 255
1739 eqcentre = centre == this%centre
1740ENDIF
1741#endif
1742
1743IF (eqed .AND. eqcentre) RETURN ! nothing to do
1744
1745tmpbufr = convert(this, tmpc_func1)
1746tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1747
1748IF (tmpgrib /= volgrid6d_var_miss) THEN
1749! conversion back and forth successful, set also conversion function
1750 this = tmpgrib
1751 c_func = tmpc_func1 * tmpc_func2
1752! set to missing in common case to avoid useless computation
1753 IF (c_func == conv_func_identity) c_func = conv_func_miss
1754ELSE IF (.NOT.eqed) THEN
1755! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1756 this = tmpgrib
1757ENDIF
1758
1759END SUBROUTINE volgrid6d_var_normalize
1760
1761
1762! Private subroutine for reading forward and backward conversion tables
1763! todo: better error handling
1764SUBROUTINE vg6d_v7d_var_conv_setup()
1765INTEGER :: un, i, n, stallo
1766
1767! forward, grib to bufr
1768un = open_package_file('vargrib2bufr.csv', filetype_data)
1769n=0
1770DO WHILE(.true.)
1771 READ(un,*,END=100)
1772 n = n + 1
1773ENDDO
1774
1775100 CONTINUE
1776
1777rewind(un)
1778ALLOCATE(conv_fwd(n),stat=stallo)
1779IF (stallo /= 0) THEN
1780 CALL l4f_log(l4f_fatal,"allocating memory")
1781 CALL raise_fatal_error()
1782ENDIF
1783
1784conv_fwd(:) = vg6d_v7d_var_conv_miss
1785CALL import_var_conv(un, conv_fwd)
1786CLOSE(un)
1787
1788! backward, bufr to grib
1789un = open_package_file('vargrib2bufr.csv', filetype_data)
1790! use the same file for now
1791!un = open_package_file('varbufr2grib.csv', filetype_data)
1792n=0
1793DO WHILE(.true.)
1794 READ(un,*,END=300)
1795 n = n + 1
1796ENDDO
1797
1798300 CONTINUE
1799
1800rewind(un)
1801ALLOCATE(conv_bwd(n),stat=stallo)
1802IF (stallo /= 0) THEN
1803 CALL l4f_log(l4f_fatal,"allocating memory")
1804 CALL raise_fatal_error()
1805end if
1806
1807conv_bwd(:) = vg6d_v7d_var_conv_miss
1808CALL import_var_conv(un, conv_bwd)
1809DO i = 1, n
1810 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1811 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1812ENDDO
1813CLOSE(un)
1814
1815CONTAINS
1816
1817SUBROUTINE import_var_conv(un, conv_type)
1818INTEGER, INTENT(in) :: un
1819TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1820
1821INTEGER :: i
1822TYPE(csv_record) :: csv
1823CHARACTER(len=1024) :: line
1824CHARACTER(len=10) :: btable
1825INTEGER :: centre, category, number, discipline
1826
1827DO i = 1, SIZE(conv_type)
1828 READ(un,'(A)',END=200)line
1829 CALL init(csv, line)
1830 CALL csv_record_getfield(csv, btable)
1831 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1832 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1833 CALL init(conv_type(i)%v7d_var, btable=btable)
1834
1835 CALL csv_record_getfield(csv, centre)
1836 CALL csv_record_getfield(csv, category)
1837 CALL csv_record_getfield(csv, number)
1838 CALL csv_record_getfield(csv, discipline)
1839 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
1840 number=number, discipline=discipline) ! controllare l'ordine
1841
1842 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1843 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1844 CALL delete(csv)
1845ENDDO
1846
1847200 CONTINUE
1848
1849END SUBROUTINE import_var_conv
1850
1851END SUBROUTINE vg6d_v7d_var_conv_setup
1852
1853
1854ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1855TYPE(conv_func),INTENT(IN) :: this, that
1856LOGICAL :: res
1857
1858res = this%a == that%a .AND. this%b == that%b
1859
1860END FUNCTION conv_func_eq
1861
1862
1863ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1864TYPE(conv_func),INTENT(IN) :: this, that
1865LOGICAL :: res
1866
1867res = .NOT.(this == that)
1868
1869END FUNCTION conv_func_ne
1870
1871
1872FUNCTION conv_func_mult(this, that) RESULT(mult)
1873TYPE(conv_func),INTENT(in) :: this
1874TYPE(conv_func),INTENT(in) :: that
1875
1876TYPE(conv_func) :: mult
1877
1878IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1879 mult = conv_func_miss
1880ELSE
1881 mult%a = this%a*that%a
1882 mult%b = this%a*that%b+this%b
1883ENDIF
1884
1885END FUNCTION conv_func_mult
1886
1894ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1895TYPE(conv_func),INTENT(in) :: this
1896REAL,INTENT(inout) :: values
1897
1898IF (this /= conv_func_miss) THEN
1899 IF (c_e(values)) values = values*this%a + this%b
1900ELSE
1901 values=rmiss
1902ENDIF
1903
1904END SUBROUTINE conv_func_compute
1905
1906
1914ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1915TYPE(conv_func),intent(in) :: this
1916REAL,INTENT(in) :: values
1917REAL :: convert
1918
1919convert = values
1920CALL compute(this, convert)
1921
1922END FUNCTION conv_func_convert
1923
1924
1938SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1939TYPE(volgrid6d_var),INTENT(in) :: this(:)
1940INTEGER,POINTER :: xind(:), yind(:)
1941
1942TYPE(vol7d_var) :: varbufr(SIZE(this))
1943TYPE(conv_func),POINTER :: c_func(:)
1944INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1945
1946NULLIFY(xind, yind)
1947counts(:) = 0
1948
1949CALL vargrib2varbufr(this, varbufr, c_func)
1950
1951DO i = 1, SIZE(vol7d_var_horcomp)
1952 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1953ENDDO
1954
1955IF (any(counts(1::2) > 1)) THEN
1956 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1957 DEALLOCATE(c_func)
1958 RETURN
1959ENDIF
1960IF (any(counts(2::2) > 1)) THEN
1961 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1962 DEALLOCATE(c_func)
1963 RETURN
1964ENDIF
1965
1966! check that variables are paired and count pairs
1967nv = 0
1968DO i = 1, SIZE(vol7d_var_horcomp), 2
1969 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
1970 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
1971 ' present but the corresponding x-component '// &
1972 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
1973 RETURN
1974 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
1975 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
1976 ' present but the corresponding y-component '// &
1977 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
1978 RETURN
1979 ENDIF
1980 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
1981ENDDO
1982
1983! repeat the loop storing indices
1984ALLOCATE(xind(nv), yind(nv))
1985nv = 0
1986DO i = 1, SIZE(vol7d_var_horcomp), 2
1987 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
1988 nv = nv + 1
1989 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
1990 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
1991 ENDIF
1992ENDDO
1993DEALLOCATE(c_func)
1994
1995END SUBROUTINE volgrid6d_var_hor_comp_index
1996
1997
2002FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
2003TYPE(volgrid6d_var),INTENT(in) :: this
2004LOGICAL :: is_hor_comp
2005
2006TYPE(vol7d_var) :: varbufr
2007
2008varbufr = convert(this)
2009is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
2010
2011END FUNCTION volgrid6d_var_is_hor_comp
2012
2013! before unstaggering??
2014
2015!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
2016!
2017!call init(varu,btable="B11003")
2018!call init(varv,btable="B11004")
2019!
2020! test about presence of u and v in standard table
2021!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
2022! call l4f_category_log(this%category,L4F_FATAL, &
2023! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
2024! CALL raise_error()
2025! RETURN
2026!end if
2027!
2028!if (associated(this%var))then
2029! nvar=size(this%var)
2030! allocate(varbufr(nvar),stat=stallo)
2031! if (stallo /=0)then
2032! call l4f_log(L4F_FATAL,"allocating memory")
2033! call raise_fatal_error("allocating memory")
2034! end if
2035!
2036! CALL vargrib2varbufr(this%var, varbufr)
2037!ELSE
2038! CALL l4f_category_log(this%category, L4F_ERROR, &
2039! "trying to destagger an incomplete volgrid6d object")
2040! CALL raise_error()
2041! RETURN
2042!end if
2043!
2044!nvaru=COUNT(varbufr==varu)
2045!nvarv=COUNT(varbufr==varv)
2046!
2047!if (nvaru > 1 )then
2048! call l4f_category_log(this%category,L4F_WARN, &
2049! ">1 variables refer to u wind component, destaggering will not be done ")
2050! DEALLOCATE(varbufr)
2051! RETURN
2052!endif
2053!
2054!if (nvarv > 1 )then
2055! call l4f_category_log(this%category,L4F_WARN, &
2056! ">1 variables refer to v wind component, destaggering will not be done ")
2057! DEALLOCATE(varbufr)
2058! RETURN
2059!endif
2060!
2061!if (nvaru == 0 .and. nvarv == 0) then
2062! call l4f_category_log(this%category,L4F_WARN, &
2063! "no u or v wind component found in volume, nothing to do")
2064! DEALLOCATE(varbufr)
2065! RETURN
2066!endif
2067!
2068!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2069! call l4f_category_log(this%category,L4F_WARN, &
2070! "there are variables different from u and v wind component in C grid")
2071!endif
2072
2073
2074END 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.