libsim Versione 7.2.4
|
◆ vargrib2varbufr_convert()
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.
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
1161
1162IMPLICIT NONE
1163
1169 integer :: centre
1170 integer :: category
1171 integer :: number
1172 integer :: discipline
1173 CHARACTER(len=65) :: description
1174 CHARACTER(len=24) :: unit
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) = (/ &
1183 /)
1184
1185TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1190/)
1191!/), (/2,2/)) ! bug in gfortran
1192
1202 PRIVATE
1203 REAL :: a, b
1205
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
1235 MODULE PROCEDURE volgrid6d_var_init
1236END INTERFACE
1237
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
1271 MODULE PROCEDURE display_volgrid6d_var
1272END INTERFACE
1273
1278INTERFACE OPERATOR (*)
1279 MODULE PROCEDURE conv_func_mult
1280END INTERFACE OPERATOR (*)
1281
1285 MODULE PROCEDURE conv_func_compute
1286END INTERFACE
1287
1291 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1292 conv_func_convert
1293END INTERFACE
1294
1295PRIVATE
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, &
1302 vargrib2varbufr, varbufr2vargrib, &
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
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
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
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)
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)
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
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
Apply the conversion function this to values. Definition volgrid6d_var_class.F90:390 Apply the conversion function this to values. Definition volgrid6d_var_class.F90:396 Destructor for the corresponding object, it assigns it to a missing value. Definition volgrid6d_var_class.F90:304 Display on the screen a brief content of object. Definition volgrid6d_var_class.F90:376 Initialize a volgrid6d_var object with the optional arguments provided. Definition volgrid6d_var_class.F90:298 This module defines an abstract interface to different drivers for access to files containing gridded... Definition grid_id_class.F90:249 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. Definition missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition vol7d_var_class.F90:212 Class for managing physical variables in a grib 1/2 fashion. Definition volgrid6d_var_class.F90:218 Definisce una variabile meteorologica osservata o un suo attributo. Definition vol7d_var_class.F90:226 Class defining a real conversion function between units. Definition volgrid6d_var_class.F90:265 Definition of a physical variable in grib coding style. Definition volgrid6d_var_class.F90:232 |