libsim Versione 7.2.1

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

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