libsim Versione 7.1.11

◆ vargrib2varbufr_convert()

type(vol7d_var) function vargrib2varbufr_convert ( type(volgrid6d_var), intent(in)  vargrib,
type(conv_func), intent(out), optional  c_func 
)

Convert a volgrid6d_var object into a physically equivalent vol7d_var object.

This method returns a physically based, bufr-like representation of type vol7d_var of the grib-like input physical variable vargrib. The method optionally returns a conv_func object which can successively be used to convert the numerical values of the field associated to vargrib to the corresponding fields in the bufr-like representation. If the conversion is not successful, the output variable is set to vol7d_var_miss and the conversion function to conv_func_miss.

Parametri
[in]vargribinput grib-like variable
[out]c_funccorresponding conv_func object

Definizione alla linea 1130 del file volgrid6d_var_class.F90.

1131! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1132! authors:
1133! Davide Cesari <dcesari@arpa.emr.it>
1134! Paolo Patruno <ppatruno@arpa.emr.it>
1135
1136! This program is free software; you can redistribute it and/or
1137! modify it under the terms of the GNU General Public License as
1138! published by the Free Software Foundation; either version 2 of
1139! the License, or (at your option) any later version.
1140
1141! This program is distributed in the hope that it will be useful,
1142! but WITHOUT ANY WARRANTY; without even the implied warranty of
1143! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1144! GNU General Public License for more details.
1145
1146! You should have received a copy of the GNU General Public License
1147! along with this program. If not, see <http://www.gnu.org/licenses/>.
1148#include "config.h"
1149
1161USE kinds
1163USE err_handling
1166USE grid_id_class
1167
1168IMPLICIT NONE
1169
1174TYPE volgrid6d_var
1175 integer :: centre
1176 integer :: category
1177 integer :: number
1178 integer :: discipline
1179 CHARACTER(len=65) :: description
1180 CHARACTER(len=24) :: unit
1181END TYPE volgrid6d_var
1182
1183TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1184 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1185
1186TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1187 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1188 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
1189 /)
1190
1191TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1192 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1193 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
1194 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
1195 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
1196/)
1197!/), (/2,2/)) ! bug in gfortran
1198
1207TYPE conv_func
1208 PRIVATE
1209 REAL :: a, b
1210END TYPE conv_func
1211
1212TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
1213TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
1214
1215TYPE vg6d_v7d_var_conv
1216 TYPE(volgrid6d_var) :: vg6d_var
1217 TYPE(vol7d_var) :: v7d_var
1218 TYPE(conv_func) :: c_func
1219! aggiungere informazioni ad es. su rotazione del vento
1220END TYPE vg6d_v7d_var_conv
1221
1222TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1223 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1224
1225TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1226
1240INTERFACE init
1241 MODULE PROCEDURE volgrid6d_var_init
1242END INTERFACE
1243
1246INTERFACE delete
1247 MODULE PROCEDURE volgrid6d_var_delete
1248END INTERFACE
1249
1250INTERFACE c_e
1251 MODULE PROCEDURE volgrid6d_var_c_e
1252END INTERFACE
1253
1254
1259INTERFACE OPERATOR (==)
1260 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1261END INTERFACE
1262
1267INTERFACE OPERATOR (/=)
1268 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1269END INTERFACE
1270
1271#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1272#define VOL7D_POLY_TYPES _var6d
1273#include "array_utilities_pre.F90"
1274
1276INTERFACE display
1277 MODULE PROCEDURE display_volgrid6d_var
1278END INTERFACE
1279
1284INTERFACE OPERATOR (*)
1285 MODULE PROCEDURE conv_func_mult
1286END INTERFACE OPERATOR (*)
1287
1290INTERFACE compute
1291 MODULE PROCEDURE conv_func_compute
1292END INTERFACE
1293
1296INTERFACE convert
1297 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1298 conv_func_convert
1299END INTERFACE
1300
1301PRIVATE
1302PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
1303 c_e, volgrid6d_var_normalize, &
1304 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1305 count_distinct, pack_distinct, count_and_pack_distinct, &
1306 map_distinct, map_inv_distinct, &
1307 index, display, &
1308 vargrib2varbufr, varbufr2vargrib, &
1309 conv_func, conv_func_miss, compute, convert, &
1310 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1311
1312
1313CONTAINS
1314
1315
1316ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1317 discipline, description, unit) RESULT(this)
1318integer,INTENT(in),OPTIONAL :: centre
1319integer,INTENT(in),OPTIONAL :: category
1320integer,INTENT(in),OPTIONAL :: number
1321integer,INTENT(in),OPTIONAL :: discipline
1322CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1323CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1324
1325TYPE(volgrid6d_var) :: this
1326
1327CALL init(this, centre, category, number, discipline, description, unit)
1328
1329END FUNCTION volgrid6d_var_new
1330
1331
1332! documented in the interface
1333ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1334TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1335INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1336INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1337INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1338INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1339CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1340CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1341
1342IF (PRESENT(centre)) THEN
1343 this%centre = centre
1344ELSE
1345 this%centre = imiss
1346 this%category = imiss
1347 this%number = imiss
1348 this%discipline = imiss
1349 RETURN
1350ENDIF
1351
1352IF (PRESENT(category)) THEN
1353 this%category = category
1354ELSE
1355 this%category = imiss
1356 this%number = imiss
1357 this%discipline = imiss
1358 RETURN
1359ENDIF
1360
1361
1362IF (PRESENT(number)) THEN
1363 this%number = number
1364ELSE
1365 this%number = imiss
1366 this%discipline = imiss
1367 RETURN
1368ENDIF
1369
1370! se sono arrivato fino a qui ho impostato centre, category e number
1371!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1372
1373IF (PRESENT(discipline)) THEN
1374 this%discipline = discipline
1375ELSE
1376 this%discipline = 255
1377ENDIF
1378
1379IF (PRESENT(description)) THEN
1380 this%description = description
1381ELSE
1382 this%description = cmiss
1383ENDIF
1384
1385IF (PRESENT(unit)) THEN
1386 this%unit = unit
1387ELSE
1388 this%unit = cmiss
1389ENDIF
1390
1391
1392
1393END SUBROUTINE volgrid6d_var_init
1394
1395
1396! documented in the interface
1397SUBROUTINE volgrid6d_var_delete(this)
1398TYPE(volgrid6d_var),INTENT(INOUT) :: this
1399
1400this%centre = imiss
1401this%category = imiss
1402this%number = imiss
1403this%discipline = imiss
1404this%description = cmiss
1405this%unit = cmiss
1406
1407END SUBROUTINE volgrid6d_var_delete
1408
1409
1410ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1411TYPE(volgrid6d_var),INTENT(IN) :: this
1412LOGICAL :: c_e
1413c_e = this /= volgrid6d_var_miss
1414END FUNCTION volgrid6d_var_c_e
1415
1416
1417ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1418TYPE(volgrid6d_var),INTENT(IN) :: this, that
1419LOGICAL :: res
1420
1421IF (this%discipline == that%discipline) THEN
1422
1423 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1424 res = ((this%category == that%category) .OR. &
1425 (this%category >= 1 .AND. this%category <=3 .AND. &
1426 that%category >= 1 .AND. that%category <=3)) .AND. &
1427 this%number == that%number
1428
1429 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1430 (this%number >= 128 .AND. this%number <= 254)) THEN
1431 res = res .AND. this%centre == that%centre ! local definition, centre matters
1432 ENDIF
1433
1434 ELSE ! grib2
1435 res = this%category == that%category .AND. &
1436 this%number == that%number
1437
1438 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1439 (this%category >= 192 .AND. this%category <= 254) .OR. &
1440 (this%number >= 192 .AND. this%number <= 254)) THEN
1441 res = res .AND. this%centre == that%centre ! local definition, centre matters
1442 ENDIF
1443 ENDIF
1444
1445ELSE ! different edition or different discipline
1446 res = .false.
1447ENDIF
1448
1449END FUNCTION volgrid6d_var_eq
1450
1451
1452ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1453TYPE(volgrid6d_var),INTENT(IN) :: this, that
1454LOGICAL :: res
1455
1456res = .NOT.(this == that)
1457
1458END FUNCTION volgrid6d_var_ne
1459
1460
1461#include "array_utilities_inc.F90"
1462
1463
1465SUBROUTINE display_volgrid6d_var(this)
1466TYPE(volgrid6d_var),INTENT(in) :: this
1467
1468print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1469
1470END SUBROUTINE display_volgrid6d_var
1471
1472
1485SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1486TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1487TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1488TYPE(conv_func),POINTER :: c_func(:)
1489
1490INTEGER :: i, n, stallo
1491
1492n = min(SIZE(varbufr), SIZE(vargrib))
1493ALLOCATE(c_func(n),stat=stallo)
1494IF (stallo /= 0) THEN
1495 call l4f_log(l4f_fatal,"allocating memory")
1496 call raise_fatal_error()
1497ENDIF
1498
1499DO i = 1, n
1500 varbufr(i) = convert(vargrib(i), c_func(i))
1501ENDDO
1502
1503END SUBROUTINE vargrib2varbufr
1504
1505
1516FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1517TYPE(volgrid6d_var),INTENT(in) :: vargrib
1518TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1519TYPE(vol7d_var) :: convert
1520
1521INTEGER :: i
1522
1523IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1524
1525DO i = 1, SIZE(conv_fwd)
1526 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1527 convert = conv_fwd(i)%v7d_var
1528 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1529 RETURN
1530 ENDIF
1531ENDDO
1532! not found
1533convert = vol7d_var_miss
1534IF (PRESENT(c_func)) c_func = conv_func_miss
1535
1536! set hint for backwards conversion
1537convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1538 vargrib%discipline/)
1539
1540CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1541 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1542 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1543 ' not found in table')
1544
1545END FUNCTION vargrib2varbufr_convert
1546
1547
1563SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1564TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1565TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1566TYPE(conv_func),POINTER :: c_func(:)
1567TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1568
1569INTEGER :: i, n, stallo
1570
1571n = min(SIZE(varbufr), SIZE(vargrib))
1572ALLOCATE(c_func(n),stat=stallo)
1573IF (stallo /= 0) THEN
1574 CALL l4f_log(l4f_fatal,"allocating memory")
1575 CALL raise_fatal_error()
1576ENDIF
1577
1578DO i = 1, n
1579 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1580ENDDO
1581
1582END SUBROUTINE varbufr2vargrib
1583
1584
1598FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1599TYPE(vol7d_var),INTENT(in) :: varbufr
1600TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1601TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1602TYPE(volgrid6d_var) :: convert
1603
1604INTEGER :: i
1605#ifdef HAVE_LIBGRIBAPI
1606INTEGER :: gaid, editionnumber, category, centre
1607#endif
1608
1609IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1610
1611#ifdef HAVE_LIBGRIBAPI
1612editionnumber=255; category=255; centre=255
1613#endif
1614IF (PRESENT(grid_id_template)) THEN
1615#ifdef HAVE_LIBGRIBAPI
1616 gaid = grid_id_get_gaid(grid_id_template)
1617 IF (c_e(gaid)) THEN
1618 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1619 IF (editionnumber == 1) THEN
1620 CALL grib_get(gaid,'gribTablesVersionNo',category)
1621 ENDIF
1622 CALL grib_get(gaid,'centre',centre)
1623 ENDIF
1624#endif
1625ENDIF
1626
1627DO i = 1, SIZE(conv_bwd)
1628 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1629#ifdef HAVE_LIBGRIBAPI
1630 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1631 IF (editionnumber == 1) THEN
1632 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1633 ELSE IF (editionnumber == 2) THEN
1634 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1635 ENDIF
1636 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1637 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1638 ENDIF
1639#endif
1640 convert = conv_bwd(i)%vg6d_var
1641 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1642 RETURN
1643 ENDIF
1644ENDDO
1645! not found
1646convert = volgrid6d_var_miss
1647IF (PRESENT(c_func)) c_func = conv_func_miss
1648
1649! if hint available use it as a fallback
1650IF (any(varbufr%gribhint /= imiss)) THEN
1651 convert%centre = varbufr%gribhint(1)
1652 convert%category = varbufr%gribhint(2)
1653 convert%number = varbufr%gribhint(3)
1654 convert%discipline = varbufr%gribhint(4)
1655ENDIF
1656
1657CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1658 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1659 ' not found in table')
1660
1661END FUNCTION varbufr2vargrib_convert
1662
1663
1671SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1672TYPE(volgrid6d_var),INTENT(inout) :: this
1673TYPE(conv_func),INTENT(out) :: c_func
1674TYPE(grid_id),INTENT(in) :: grid_id_template
1675
1676LOGICAL :: eqed, eqcentre
1677INTEGER :: gaid, editionnumber, centre
1678TYPE(volgrid6d_var) :: tmpgrib
1679TYPE(vol7d_var) :: tmpbufr
1680TYPE(conv_func) tmpc_func1, tmpc_func2
1681
1682eqed = .true.
1683eqcentre = .true.
1684c_func = conv_func_miss
1685
1686#ifdef HAVE_LIBGRIBAPI
1687gaid = grid_id_get_gaid(grid_id_template)
1688IF (c_e(gaid)) THEN
1689 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1690 CALL grib_get(gaid, 'centre', centre)
1691 eqed = editionnumber == 1 .EQV. this%discipline == 255
1692 eqcentre = centre == this%centre
1693ENDIF
1694#endif
1695
1696IF (eqed .AND. eqcentre) RETURN ! nothing to do
1697
1698tmpbufr = convert(this, tmpc_func1)
1699tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1700
1701IF (tmpgrib /= volgrid6d_var_miss) THEN
1702! conversion back and forth successful, set also conversion function
1703 this = tmpgrib
1704 c_func = tmpc_func1 * tmpc_func2
1705! set to missing in common case to avoid useless computation
1706 IF (c_func == conv_func_identity) c_func = conv_func_miss
1707ELSE IF (.NOT.eqed) THEN
1708! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1709 this = tmpgrib
1710ENDIF
1711
1712END SUBROUTINE volgrid6d_var_normalize
1713
1714
1715! Private subroutine for reading forward and backward conversion tables
1716! todo: better error handling
1717SUBROUTINE vg6d_v7d_var_conv_setup()
1718INTEGER :: un, i, n, stallo
1719
1720! forward, grib to bufr
1721un = open_package_file('vargrib2bufr.csv', filetype_data)
1722n=0
1723DO WHILE(.true.)
1724 READ(un,*,END=100)
1725 n = n + 1
1726ENDDO
1727
1728100 CONTINUE
1729
1730rewind(un)
1731ALLOCATE(conv_fwd(n),stat=stallo)
1732IF (stallo /= 0) THEN
1733 CALL l4f_log(l4f_fatal,"allocating memory")
1734 CALL raise_fatal_error()
1735ENDIF
1736
1737conv_fwd(:) = vg6d_v7d_var_conv_miss
1738CALL import_var_conv(un, conv_fwd)
1739CLOSE(un)
1740
1741! backward, bufr to grib
1742un = open_package_file('vargrib2bufr.csv', filetype_data)
1743! use the same file for now
1744!un = open_package_file('varbufr2grib.csv', filetype_data)
1745n=0
1746DO WHILE(.true.)
1747 READ(un,*,END=300)
1748 n = n + 1
1749ENDDO
1750
1751300 CONTINUE
1752
1753rewind(un)
1754ALLOCATE(conv_bwd(n),stat=stallo)
1755IF (stallo /= 0) THEN
1756 CALL l4f_log(l4f_fatal,"allocating memory")
1757 CALL raise_fatal_error()
1758end if
1759
1760conv_bwd(:) = vg6d_v7d_var_conv_miss
1761CALL import_var_conv(un, conv_bwd)
1762DO i = 1, n
1763 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1764 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1765ENDDO
1766CLOSE(un)
1767
1768CONTAINS
1769
1770SUBROUTINE import_var_conv(un, conv_type)
1771INTEGER, INTENT(in) :: un
1772TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1773
1774INTEGER :: i
1775TYPE(csv_record) :: csv
1776CHARACTER(len=1024) :: line
1777CHARACTER(len=10) :: btable
1778INTEGER :: centre, category, number, discipline
1779
1780DO i = 1, SIZE(conv_type)
1781 READ(un,'(A)',END=200)line
1782 CALL init(csv, line)
1783 CALL csv_record_getfield(csv, btable)
1784 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1785 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1786 CALL init(conv_type(i)%v7d_var, btable=btable)
1787
1788 CALL csv_record_getfield(csv, centre)
1789 CALL csv_record_getfield(csv, category)
1790 CALL csv_record_getfield(csv, number)
1791 CALL csv_record_getfield(csv, discipline)
1792 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
1793 number=number, discipline=discipline) ! controllare l'ordine
1794
1795 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1796 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1797 CALL delete(csv)
1798ENDDO
1799
1800200 CONTINUE
1801
1802END SUBROUTINE import_var_conv
1803
1804END SUBROUTINE vg6d_v7d_var_conv_setup
1805
1806
1807ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1808TYPE(conv_func),INTENT(IN) :: this, that
1809LOGICAL :: res
1810
1811res = this%a == that%a .AND. this%b == that%b
1812
1813END FUNCTION conv_func_eq
1814
1815
1816ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1817TYPE(conv_func),INTENT(IN) :: this, that
1818LOGICAL :: res
1819
1820res = .NOT.(this == that)
1821
1822END FUNCTION conv_func_ne
1823
1824
1825FUNCTION conv_func_mult(this, that) RESULT(mult)
1826TYPE(conv_func),INTENT(in) :: this
1827TYPE(conv_func),INTENT(in) :: that
1828
1829TYPE(conv_func) :: mult
1830
1831IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1832 mult = conv_func_miss
1833ELSE
1834 mult%a = this%a*that%a
1835 mult%b = this%a*that%b+this%b
1836ENDIF
1837
1838END FUNCTION conv_func_mult
1839
1847ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1848TYPE(conv_func),INTENT(in) :: this
1849REAL,INTENT(inout) :: values
1850
1851IF (this /= conv_func_miss) THEN
1852 IF (c_e(values)) values = values*this%a + this%b
1853ELSE
1854 values=rmiss
1855ENDIF
1856
1857END SUBROUTINE conv_func_compute
1858
1859
1867ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1868TYPE(conv_func),intent(in) :: this
1869REAL,INTENT(in) :: values
1870REAL :: convert
1871
1872convert = values
1873CALL compute(this, convert)
1874
1875END FUNCTION conv_func_convert
1876
1877
1891SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1892TYPE(volgrid6d_var),INTENT(in) :: this(:)
1893INTEGER,POINTER :: xind(:), yind(:)
1894
1895TYPE(vol7d_var) :: varbufr(SIZE(this))
1896TYPE(conv_func),POINTER :: c_func(:)
1897INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1898
1899NULLIFY(xind, yind)
1900counts(:) = 0
1901
1902CALL vargrib2varbufr(this, varbufr, c_func)
1903
1904DO i = 1, SIZE(vol7d_var_horcomp)
1905 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1906ENDDO
1907
1908IF (any(counts(1::2) > 1)) THEN
1909 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1910 DEALLOCATE(c_func)
1911 RETURN
1912ENDIF
1913IF (any(counts(2::2) > 1)) THEN
1914 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1915 DEALLOCATE(c_func)
1916 RETURN
1917ENDIF
1918
1919! check that variables are paired and count pairs
1920nv = 0
1921DO i = 1, SIZE(vol7d_var_horcomp), 2
1922 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
1923 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
1924 ' present but the corresponding x-component '// &
1925 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
1926 RETURN
1927 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
1928 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
1929 ' present but the corresponding y-component '// &
1930 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
1931 RETURN
1932 ENDIF
1933 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
1934ENDDO
1935
1936! repeat the loop storing indices
1937ALLOCATE(xind(nv), yind(nv))
1938nv = 0
1939DO i = 1, SIZE(vol7d_var_horcomp), 2
1940 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
1941 nv = nv + 1
1942 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
1943 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
1944 ENDIF
1945ENDDO
1946DEALLOCATE(c_func)
1947
1948END SUBROUTINE volgrid6d_var_hor_comp_index
1949
1950
1955FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
1956TYPE(volgrid6d_var),INTENT(in) :: this
1957LOGICAL :: is_hor_comp
1958
1959TYPE(vol7d_var) :: varbufr
1960
1961varbufr = convert(this)
1962is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
1963
1964END FUNCTION volgrid6d_var_is_hor_comp
1965
1966! before unstaggering??
1967
1968!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1969!
1970!call init(varu,btable="B11003")
1971!call init(varv,btable="B11004")
1972!
1973! test about presence of u and v in standard table
1974!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
1975! call l4f_category_log(this%category,L4F_FATAL, &
1976! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
1977! CALL raise_error()
1978! RETURN
1979!end if
1980!
1981!if (associated(this%var))then
1982! nvar=size(this%var)
1983! allocate(varbufr(nvar),stat=stallo)
1984! if (stallo /=0)then
1985! call l4f_log(L4F_FATAL,"allocating memory")
1986! call raise_fatal_error("allocating memory")
1987! end if
1988!
1989! CALL vargrib2varbufr(this%var, varbufr)
1990!ELSE
1991! CALL l4f_category_log(this%category, L4F_ERROR, &
1992! "trying to destagger an incomplete volgrid6d object")
1993! CALL raise_error()
1994! RETURN
1995!end if
1996!
1997!nvaru=COUNT(varbufr==varu)
1998!nvarv=COUNT(varbufr==varv)
1999!
2000!if (nvaru > 1 )then
2001! call l4f_category_log(this%category,L4F_WARN, &
2002! ">1 variables refer to u wind component, destaggering will not be done ")
2003! DEALLOCATE(varbufr)
2004! RETURN
2005!endif
2006!
2007!if (nvarv > 1 )then
2008! call l4f_category_log(this%category,L4F_WARN, &
2009! ">1 variables refer to v wind component, destaggering will not be done ")
2010! DEALLOCATE(varbufr)
2011! RETURN
2012!endif
2013!
2014!if (nvaru == 0 .and. nvarv == 0) then
2015! call l4f_category_log(this%category,L4F_WARN, &
2016! "no u or v wind component found in volume, nothing to do")
2017! DEALLOCATE(varbufr)
2018! RETURN
2019!endif
2020!
2021!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2022! call l4f_category_log(this%category,L4F_WARN, &
2023! "there are variables different from u and v wind component in C grid")
2024!endif
2025
2026
2027END 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.