libsim Versione 7.1.11
|
◆ vargrib2varbufr()
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.
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
1136
1137IMPLICIT NONE
1138
1144 integer :: centre
1145 integer :: category
1146 integer :: number
1147 integer :: discipline
1148 CHARACTER(len=65) :: description
1149 CHARACTER(len=24) :: unit
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) = (/ &
1158 /)
1159
1160TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1165/)
1166!/), (/2,2/)) ! bug in gfortran
1167
1177 PRIVATE
1178 REAL :: a, b
1180
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
1210 MODULE PROCEDURE volgrid6d_var_init
1211END INTERFACE
1212
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
1246 MODULE PROCEDURE display_volgrid6d_var
1247END INTERFACE
1248
1253INTERFACE OPERATOR (*)
1254 MODULE PROCEDURE conv_func_mult
1255END INTERFACE OPERATOR (*)
1256
1260 MODULE PROCEDURE conv_func_compute
1261END INTERFACE
1262
1266 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1267 conv_func_convert
1268END INTERFACE
1269
1270PRIVATE
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, &
1277 vargrib2varbufr, varbufr2vargrib, &
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
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
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
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)
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)
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
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
Apply the conversion function this to values. Definition: volgrid6d_var_class.F90:396 Apply the conversion function this to values. Definition: volgrid6d_var_class.F90:402 Destructor for the corresponding object, it assigns it to a missing value. Definition: volgrid6d_var_class.F90:310 Display on the screen a brief content of object. Definition: volgrid6d_var_class.F90:382 Initialize a volgrid6d_var object with the optional arguments provided. Definition: volgrid6d_var_class.F90:304 This module defines an abstract interface to different drivers for access to files containing gridded... Definition: grid_id_class.F90:255 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. Definition: missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition: vol7d_var_class.F90:218 Class for managing physical variables in a grib 1/2 fashion. Definition: volgrid6d_var_class.F90:224 Definisce una variabile meteorologica osservata o un suo attributo. Definition: vol7d_var_class.F90:232 Class defining a real conversion function between units. Definition: volgrid6d_var_class.F90:271 Definition of a physical variable in grib coding style. Definition: volgrid6d_var_class.F90:238 |