libsim Versione 7.2.1
|
◆ varbufr2vargrib()
Convert a vol7d_var array object into a physically equivalent volgrid6d_var array object. This method converts a bufr-like array of physical variables vargrib, to an array of grib-like variables varbufr. Unlike the opposite method vargrib2varbufr, in this case the conversion is not uniqe and at the moment the first matching grib-like variable is chosen, without any control over the choice process. 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 varbufr to the corresponding fields in the grib-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 volgrid6d_var_miss and the conversion function to conv_func_miss.
Definizione alla linea 1171 del file volgrid6d_var_class.F90. 1172! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1173! authors:
1174! Davide Cesari <dcesari@arpa.emr.it>
1175! Paolo Patruno <ppatruno@arpa.emr.it>
1176
1177! This program is free software; you can redistribute it and/or
1178! modify it under the terms of the GNU General Public License as
1179! published by the Free Software Foundation; either version 2 of
1180! the License, or (at your option) any later version.
1181
1182! This program is distributed in the hope that it will be useful,
1183! but WITHOUT ANY WARRANTY; without even the implied warranty of
1184! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1185! GNU General Public License for more details.
1186
1187! You should have received a copy of the GNU General Public License
1188! along with this program. If not, see <http://www.gnu.org/licenses/>.
1189#include "config.h"
1190
1208
1209IMPLICIT NONE
1210
1216 integer :: centre
1217 integer :: category
1218 integer :: number
1219 integer :: discipline
1220 CHARACTER(len=65) :: description
1221 CHARACTER(len=24) :: unit
1223
1224TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1225 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1226
1227TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1230 /)
1231
1232TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1237/)
1238!/), (/2,2/)) ! bug in gfortran
1239
1249 PRIVATE
1250 REAL :: a, b
1252
1255
1256TYPE vg6d_v7d_var_conv
1257 TYPE(volgrid6d_var) :: vg6d_var
1258 TYPE(vol7d_var) :: v7d_var
1259 TYPE(conv_func) :: c_func
1260! aggiungere informazioni ad es. su rotazione del vento
1261END TYPE vg6d_v7d_var_conv
1262
1263TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1264 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1265
1266TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1267
1282 MODULE PROCEDURE volgrid6d_var_init
1283END INTERFACE
1284
1288 MODULE PROCEDURE volgrid6d_var_delete
1289END INTERFACE
1290
1291INTERFACE c_e
1292 MODULE PROCEDURE volgrid6d_var_c_e
1293END INTERFACE
1294
1295
1300INTERFACE OPERATOR (==)
1301 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1302END INTERFACE
1303
1308INTERFACE OPERATOR (/=)
1309 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1310END INTERFACE
1311
1312#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1313#define VOL7D_POLY_TYPES _var6d
1314#include "array_utilities_pre.F90"
1315
1318 MODULE PROCEDURE display_volgrid6d_var
1319END INTERFACE
1320
1325INTERFACE OPERATOR (*)
1326 MODULE PROCEDURE conv_func_mult
1327END INTERFACE OPERATOR (*)
1328
1332 MODULE PROCEDURE conv_func_compute
1333END INTERFACE
1334
1338 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1339 conv_func_convert
1340END INTERFACE
1341
1342PRIVATE
1344 c_e, volgrid6d_var_normalize, &
1345 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1346 count_distinct, pack_distinct, count_and_pack_distinct, &
1347 map_distinct, map_inv_distinct, &
1349 vargrib2varbufr, varbufr2vargrib, &
1351 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1352
1353
1354CONTAINS
1355
1356
1357ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1358 discipline, description, unit) RESULT(this)
1359integer,INTENT(in),OPTIONAL :: centre
1360integer,INTENT(in),OPTIONAL :: category
1361integer,INTENT(in),OPTIONAL :: number
1362integer,INTENT(in),OPTIONAL :: discipline
1363CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1364CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1365
1366TYPE(volgrid6d_var) :: this
1367
1369
1370END FUNCTION volgrid6d_var_new
1371
1372
1373! documented in the interface
1374ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1375TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1376INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1377INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1378INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1379INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1380CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1381CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1382
1383IF (PRESENT(centre)) THEN
1384 this%centre = centre
1385ELSE
1386 this%centre = imiss
1387 this%category = imiss
1388 this%number = imiss
1389 this%discipline = imiss
1390 RETURN
1391ENDIF
1392
1393IF (PRESENT(category)) THEN
1394 this%category = category
1395ELSE
1396 this%category = imiss
1397 this%number = imiss
1398 this%discipline = imiss
1399 RETURN
1400ENDIF
1401
1402
1403IF (PRESENT(number)) THEN
1404 this%number = number
1405ELSE
1406 this%number = imiss
1407 this%discipline = imiss
1408 RETURN
1409ENDIF
1410
1411! se sono arrivato fino a qui ho impostato centre, category e number
1412!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1413
1414IF (PRESENT(discipline)) THEN
1415 this%discipline = discipline
1416ELSE
1417 this%discipline = 255
1418ENDIF
1419
1420IF (PRESENT(description)) THEN
1421 this%description = description
1422ELSE
1423 this%description = cmiss
1424ENDIF
1425
1426IF (PRESENT(unit)) THEN
1427 this%unit = unit
1428ELSE
1429 this%unit = cmiss
1430ENDIF
1431
1432
1433
1434END SUBROUTINE volgrid6d_var_init
1435
1436
1437! documented in the interface
1438SUBROUTINE volgrid6d_var_delete(this)
1439TYPE(volgrid6d_var),INTENT(INOUT) :: this
1440
1441this%centre = imiss
1442this%category = imiss
1443this%number = imiss
1444this%discipline = imiss
1445this%description = cmiss
1446this%unit = cmiss
1447
1448END SUBROUTINE volgrid6d_var_delete
1449
1450
1451ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1452TYPE(volgrid6d_var),INTENT(IN) :: this
1453LOGICAL :: c_e
1454c_e = this /= volgrid6d_var_miss
1455END FUNCTION volgrid6d_var_c_e
1456
1457
1458ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1459TYPE(volgrid6d_var),INTENT(IN) :: this, that
1460LOGICAL :: res
1461
1462IF (this%discipline == that%discipline) THEN
1463
1464 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1465 res = ((this%category == that%category) .OR. &
1466 (this%category >= 1 .AND. this%category <=3 .AND. &
1467 that%category >= 1 .AND. that%category <=3)) .AND. &
1468 this%number == that%number
1469
1470 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1471 (this%number >= 128 .AND. this%number <= 254)) THEN
1472 res = res .AND. this%centre == that%centre ! local definition, centre matters
1473 ENDIF
1474
1475 ELSE ! grib2
1476 res = this%category == that%category .AND. &
1477 this%number == that%number
1478
1479 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1480 (this%category >= 192 .AND. this%category <= 254) .OR. &
1481 (this%number >= 192 .AND. this%number <= 254)) THEN
1482 res = res .AND. this%centre == that%centre ! local definition, centre matters
1483 ENDIF
1484 ENDIF
1485
1486ELSE ! different edition or different discipline
1487 res = .false.
1488ENDIF
1489
1490END FUNCTION volgrid6d_var_eq
1491
1492
1493ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1494TYPE(volgrid6d_var),INTENT(IN) :: this, that
1495LOGICAL :: res
1496
1497res = .NOT.(this == that)
1498
1499END FUNCTION volgrid6d_var_ne
1500
1501
1502#include "array_utilities_inc.F90"
1503
1504
1506SUBROUTINE display_volgrid6d_var(this)
1507TYPE(volgrid6d_var),INTENT(in) :: this
1508
1509print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1510
1511END SUBROUTINE display_volgrid6d_var
1512
1513
1526SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1527TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1528TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1529TYPE(conv_func),POINTER :: c_func(:)
1530
1531INTEGER :: i, n, stallo
1532
1533n = min(SIZE(varbufr), SIZE(vargrib))
1534ALLOCATE(c_func(n),stat=stallo)
1535IF (stallo /= 0) THEN
1536 call l4f_log(l4f_fatal,"allocating memory")
1537 call raise_fatal_error()
1538ENDIF
1539
1540DO i = 1, n
1541 varbufr(i) = convert(vargrib(i), c_func(i))
1542ENDDO
1543
1544END SUBROUTINE vargrib2varbufr
1545
1546
1557FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1558TYPE(volgrid6d_var),INTENT(in) :: vargrib
1559TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1560TYPE(vol7d_var) :: convert
1561
1562INTEGER :: i
1563
1564IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1565
1566DO i = 1, SIZE(conv_fwd)
1567 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1568 convert = conv_fwd(i)%v7d_var
1569 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1570 RETURN
1571 ENDIF
1572ENDDO
1573! not found
1574convert = vol7d_var_miss
1575IF (PRESENT(c_func)) c_func = conv_func_miss
1576
1577! set hint for backwards conversion
1578convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1579 vargrib%discipline/)
1580
1581CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1582 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1583 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1584 ' not found in table')
1585
1586END FUNCTION vargrib2varbufr_convert
1587
1588
1604SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1605TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1606TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1607TYPE(conv_func),POINTER :: c_func(:)
1608TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1609
1610INTEGER :: i, n, stallo
1611
1612n = min(SIZE(varbufr), SIZE(vargrib))
1613ALLOCATE(c_func(n),stat=stallo)
1614IF (stallo /= 0) THEN
1615 CALL l4f_log(l4f_fatal,"allocating memory")
1616 CALL raise_fatal_error()
1617ENDIF
1618
1619DO i = 1, n
1620 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1621ENDDO
1622
1623END SUBROUTINE varbufr2vargrib
1624
1625
1639FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1640TYPE(vol7d_var),INTENT(in) :: varbufr
1641TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1642TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1643TYPE(volgrid6d_var) :: convert
1644
1645INTEGER :: i
1646#ifdef HAVE_LIBGRIBAPI
1647INTEGER :: gaid, editionnumber, category, centre
1648#endif
1649
1650IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1651
1652#ifdef HAVE_LIBGRIBAPI
1653editionnumber=255; category=255; centre=255
1654#endif
1655IF (PRESENT(grid_id_template)) THEN
1656#ifdef HAVE_LIBGRIBAPI
1657 gaid = grid_id_get_gaid(grid_id_template)
1658 IF (c_e(gaid)) THEN
1659 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1660 IF (editionnumber == 1) THEN
1661 CALL grib_get(gaid,'gribTablesVersionNo',category)
1662 ENDIF
1663 CALL grib_get(gaid,'centre',centre)
1664 ENDIF
1665#endif
1666ENDIF
1667
1668DO i = 1, SIZE(conv_bwd)
1669 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1670#ifdef HAVE_LIBGRIBAPI
1671 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1672 IF (editionnumber == 1) THEN
1673 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1674 ELSE IF (editionnumber == 2) THEN
1675 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1676 ENDIF
1677 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1678 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1679 ENDIF
1680#endif
1681 convert = conv_bwd(i)%vg6d_var
1682 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1683 RETURN
1684 ENDIF
1685ENDDO
1686! not found
1687convert = volgrid6d_var_miss
1688IF (PRESENT(c_func)) c_func = conv_func_miss
1689
1690! if hint available use it as a fallback
1691IF (any(varbufr%gribhint /= imiss)) THEN
1692 convert%centre = varbufr%gribhint(1)
1693 convert%category = varbufr%gribhint(2)
1694 convert%number = varbufr%gribhint(3)
1695 convert%discipline = varbufr%gribhint(4)
1696ENDIF
1697
1698CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1699 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1700 ' not found in table')
1701
1702END FUNCTION varbufr2vargrib_convert
1703
1704
1712SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1713TYPE(volgrid6d_var),INTENT(inout) :: this
1714TYPE(conv_func),INTENT(out) :: c_func
1715TYPE(grid_id),INTENT(in) :: grid_id_template
1716
1717LOGICAL :: eqed, eqcentre
1718INTEGER :: gaid, editionnumber, centre
1719TYPE(volgrid6d_var) :: tmpgrib
1720TYPE(vol7d_var) :: tmpbufr
1721TYPE(conv_func) tmpc_func1, tmpc_func2
1722
1723eqed = .true.
1724eqcentre = .true.
1725c_func = conv_func_miss
1726
1727#ifdef HAVE_LIBGRIBAPI
1728gaid = grid_id_get_gaid(grid_id_template)
1729IF (c_e(gaid)) THEN
1730 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1731 CALL grib_get(gaid, 'centre', centre)
1732 eqed = editionnumber == 1 .EQV. this%discipline == 255
1733 eqcentre = centre == this%centre
1734ENDIF
1735#endif
1736
1737IF (eqed .AND. eqcentre) RETURN ! nothing to do
1738
1739tmpbufr = convert(this, tmpc_func1)
1740tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1741
1742IF (tmpgrib /= volgrid6d_var_miss) THEN
1743! conversion back and forth successful, set also conversion function
1744 this = tmpgrib
1745 c_func = tmpc_func1 * tmpc_func2
1746! set to missing in common case to avoid useless computation
1747 IF (c_func == conv_func_identity) c_func = conv_func_miss
1748ELSE IF (.NOT.eqed) THEN
1749! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1750 this = tmpgrib
1751ENDIF
1752
1753END SUBROUTINE volgrid6d_var_normalize
1754
1755
1756! Private subroutine for reading forward and backward conversion tables
1757! todo: better error handling
1758SUBROUTINE vg6d_v7d_var_conv_setup()
1759INTEGER :: un, i, n, stallo
1760
1761! forward, grib to bufr
1762un = open_package_file('vargrib2bufr.csv', filetype_data)
1763n=0
1764DO WHILE(.true.)
1765 READ(un,*,END=100)
1766 n = n + 1
1767ENDDO
1768
1769100 CONTINUE
1770
1771rewind(un)
1772ALLOCATE(conv_fwd(n),stat=stallo)
1773IF (stallo /= 0) THEN
1774 CALL l4f_log(l4f_fatal,"allocating memory")
1775 CALL raise_fatal_error()
1776ENDIF
1777
1778conv_fwd(:) = vg6d_v7d_var_conv_miss
1779CALL import_var_conv(un, conv_fwd)
1780CLOSE(un)
1781
1782! backward, bufr to grib
1783un = open_package_file('vargrib2bufr.csv', filetype_data)
1784! use the same file for now
1785!un = open_package_file('varbufr2grib.csv', filetype_data)
1786n=0
1787DO WHILE(.true.)
1788 READ(un,*,END=300)
1789 n = n + 1
1790ENDDO
1791
1792300 CONTINUE
1793
1794rewind(un)
1795ALLOCATE(conv_bwd(n),stat=stallo)
1796IF (stallo /= 0) THEN
1797 CALL l4f_log(l4f_fatal,"allocating memory")
1798 CALL raise_fatal_error()
1799end if
1800
1801conv_bwd(:) = vg6d_v7d_var_conv_miss
1802CALL import_var_conv(un, conv_bwd)
1803DO i = 1, n
1804 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1805 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1806ENDDO
1807CLOSE(un)
1808
1809CONTAINS
1810
1811SUBROUTINE import_var_conv(un, conv_type)
1812INTEGER, INTENT(in) :: un
1813TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1814
1815INTEGER :: i
1816TYPE(csv_record) :: csv
1817CHARACTER(len=1024) :: line
1818CHARACTER(len=10) :: btable
1819INTEGER :: centre, category, number, discipline
1820
1821DO i = 1, SIZE(conv_type)
1822 READ(un,'(A)',END=200)line
1824 CALL csv_record_getfield(csv, btable)
1825 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1826 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1828
1829 CALL csv_record_getfield(csv, centre)
1830 CALL csv_record_getfield(csv, category)
1831 CALL csv_record_getfield(csv, number)
1832 CALL csv_record_getfield(csv, discipline)
1834 number=number, discipline=discipline) ! controllare l'ordine
1835
1836 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1837 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1839ENDDO
1840
1841200 CONTINUE
1842
1843END SUBROUTINE import_var_conv
1844
1845END SUBROUTINE vg6d_v7d_var_conv_setup
1846
1847
1848ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1849TYPE(conv_func),INTENT(IN) :: this, that
1850LOGICAL :: res
1851
1852res = this%a == that%a .AND. this%b == that%b
1853
1854END FUNCTION conv_func_eq
1855
1856
1857ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1858TYPE(conv_func),INTENT(IN) :: this, that
1859LOGICAL :: res
1860
1861res = .NOT.(this == that)
1862
1863END FUNCTION conv_func_ne
1864
1865
1866FUNCTION conv_func_mult(this, that) RESULT(mult)
1867TYPE(conv_func),INTENT(in) :: this
1868TYPE(conv_func),INTENT(in) :: that
1869
1870TYPE(conv_func) :: mult
1871
1872IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1873 mult = conv_func_miss
1874ELSE
1875 mult%a = this%a*that%a
1876 mult%b = this%a*that%b+this%b
1877ENDIF
1878
1879END FUNCTION conv_func_mult
1880
1888ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1889TYPE(conv_func),INTENT(in) :: this
1890REAL,INTENT(inout) :: values
1891
1892IF (this /= conv_func_miss) THEN
1893 IF (c_e(values)) values = values*this%a + this%b
1894ELSE
1895 values=rmiss
1896ENDIF
1897
1898END SUBROUTINE conv_func_compute
1899
1900
1908ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1909TYPE(conv_func),intent(in) :: this
1910REAL,INTENT(in) :: values
1911REAL :: convert
1912
1913convert = values
1915
1916END FUNCTION conv_func_convert
1917
1918
1932SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1933TYPE(volgrid6d_var),INTENT(in) :: this(:)
1934INTEGER,POINTER :: xind(:), yind(:)
1935
1936TYPE(vol7d_var) :: varbufr(SIZE(this))
1937TYPE(conv_func),POINTER :: c_func(:)
1938INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1939
1940NULLIFY(xind, yind)
1941counts(:) = 0
1942
1943CALL vargrib2varbufr(this, varbufr, c_func)
1944
1945DO i = 1, SIZE(vol7d_var_horcomp)
1946 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1947ENDDO
1948
1949IF (any(counts(1::2) > 1)) THEN
1950 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1951 DEALLOCATE(c_func)
1952 RETURN
1953ENDIF
1954IF (any(counts(2::2) > 1)) THEN
1955 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1956 DEALLOCATE(c_func)
1957 RETURN
1958ENDIF
1959
1960! check that variables are paired and count pairs
1961nv = 0
1962DO i = 1, SIZE(vol7d_var_horcomp), 2
1963 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
1964 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
1965 ' present but the corresponding x-component '// &
1966 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
1967 RETURN
1968 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
1969 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
1970 ' present but the corresponding y-component '// &
1971 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
1972 RETURN
1973 ENDIF
1974 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
1975ENDDO
1976
1977! repeat the loop storing indices
1978ALLOCATE(xind(nv), yind(nv))
1979nv = 0
1980DO i = 1, SIZE(vol7d_var_horcomp), 2
1981 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
1982 nv = nv + 1
1983 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
1984 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
1985 ENDIF
1986ENDDO
1987DEALLOCATE(c_func)
1988
1989END SUBROUTINE volgrid6d_var_hor_comp_index
1990
1991
1996FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
1997TYPE(volgrid6d_var),INTENT(in) :: this
1998LOGICAL :: is_hor_comp
1999
2000TYPE(vol7d_var) :: varbufr
2001
2002varbufr = convert(this)
2003is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
2004
2005END FUNCTION volgrid6d_var_is_hor_comp
2006
2007! before unstaggering??
2008
2009!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
2010!
2011!call init(varu,btable="B11003")
2012!call init(varv,btable="B11004")
2013!
2014! test about presence of u and v in standard table
2015!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
2016! call l4f_category_log(this%category,L4F_FATAL, &
2017! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
2018! CALL raise_error()
2019! RETURN
2020!end if
2021!
2022!if (associated(this%var))then
2023! nvar=size(this%var)
2024! allocate(varbufr(nvar),stat=stallo)
2025! if (stallo /=0)then
2026! call l4f_log(L4F_FATAL,"allocating memory")
2027! call raise_fatal_error("allocating memory")
2028! end if
2029!
2030! CALL vargrib2varbufr(this%var, varbufr)
2031!ELSE
2032! CALL l4f_category_log(this%category, L4F_ERROR, &
2033! "trying to destagger an incomplete volgrid6d object")
2034! CALL raise_error()
2035! RETURN
2036!end if
2037!
2038!nvaru=COUNT(varbufr==varu)
2039!nvarv=COUNT(varbufr==varv)
2040!
2041!if (nvaru > 1 )then
2042! call l4f_category_log(this%category,L4F_WARN, &
2043! ">1 variables refer to u wind component, destaggering will not be done ")
2044! DEALLOCATE(varbufr)
2045! RETURN
2046!endif
2047!
2048!if (nvarv > 1 )then
2049! call l4f_category_log(this%category,L4F_WARN, &
2050! ">1 variables refer to v wind component, destaggering will not be done ")
2051! DEALLOCATE(varbufr)
2052! RETURN
2053!endif
2054!
2055!if (nvaru == 0 .and. nvarv == 0) then
2056! call l4f_category_log(this%category,L4F_WARN, &
2057! "no u or v wind component found in volume, nothing to do")
2058! DEALLOCATE(varbufr)
2059! RETURN
2060!endif
2061!
2062!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
2063! call l4f_category_log(this%category,L4F_WARN, &
2064! "there are variables different from u and v wind component in C grid")
2065!endif
2066
2067
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 |