libsim Versione 7.2.4

◆ vargrib2varbufr_convert()

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

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

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