libsim Versione 7.2.4

◆ 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 1171 del file volgrid6d_var_class.F90.

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