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