libsim Versione 7.1.11

◆ vargrib2varbufr()

subroutine, public vargrib2varbufr ( type(volgrid6d_var), dimension(:), intent(in)  vargrib,
type(vol7d_var), dimension(:), intent(out)  varbufr,
type(conv_func), dimension(:), pointer  c_func 
)

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

This method converts a grib-like array of physical variables vargrib, to an array of unique, physically based, bufr-like variables varbufr. 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 vargrib to the corresponding fields in the bufr-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 vol7d_var_miss and the conversion function to conv_func_miss.

Parametri
[in]vargribarray of input grib-like variables
[out]varbufrarray of output bufr-like variables
c_funcpointer to an array of the corresponding conv_func objects, allocated in the method

Definizione alla linea 1099 del file volgrid6d_var_class.F90.

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