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