libsim Versione 7.2.1
|
◆ vargrib2varbufr()
Convert a volgrid6d_var array object into a physically equivalent vol7d_var array object. This method converts a grib-like array of physical variables vargrib, to an array of unique, physically based, bufr-like variables varbufr. The output array must have enough room for the converted variables. The method additionally allocates a conv_func array object of the same size, which can successively be used to convert the numerical values of the fields associated to vargrib to the corresponding fields in the bufr-like representation. c_func will have to be deallocated by the calling procedure. If a conversion is not successful, the corresponding output variable is set to vol7d_var_miss and the conversion function to conv_func_miss.
Definizione alla linea 1093 del file volgrid6d_var_class.F90. 1094! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1095! authors:
1096! Davide Cesari <dcesari@arpa.emr.it>
1097! Paolo Patruno <ppatruno@arpa.emr.it>
1098
1099! This program is free software; you can redistribute it and/or
1100! modify it under the terms of the GNU General Public License as
1101! published by the Free Software Foundation; either version 2 of
1102! the License, or (at your option) any later version.
1103
1104! This program is distributed in the hope that it will be useful,
1105! but WITHOUT ANY WARRANTY; without even the implied warranty of
1106! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1107! GNU General Public License for more details.
1108
1109! You should have received a copy of the GNU General Public License
1110! along with this program. If not, see <http://www.gnu.org/licenses/>.
1111#include "config.h"
1112
1130
1131IMPLICIT NONE
1132
1138 integer :: centre
1139 integer :: category
1140 integer :: number
1141 integer :: discipline
1142 CHARACTER(len=65) :: description
1143 CHARACTER(len=24) :: unit
1145
1146TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1147 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1148
1149TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1152 /)
1153
1154TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1159/)
1160!/), (/2,2/)) ! bug in gfortran
1161
1171 PRIVATE
1172 REAL :: a, b
1174
1177
1178TYPE vg6d_v7d_var_conv
1179 TYPE(volgrid6d_var) :: vg6d_var
1180 TYPE(vol7d_var) :: v7d_var
1181 TYPE(conv_func) :: c_func
1182! aggiungere informazioni ad es. su rotazione del vento
1183END TYPE vg6d_v7d_var_conv
1184
1185TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1186 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1187
1188TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1189
1204 MODULE PROCEDURE volgrid6d_var_init
1205END INTERFACE
1206
1210 MODULE PROCEDURE volgrid6d_var_delete
1211END INTERFACE
1212
1213INTERFACE c_e
1214 MODULE PROCEDURE volgrid6d_var_c_e
1215END INTERFACE
1216
1217
1222INTERFACE OPERATOR (==)
1223 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1224END INTERFACE
1225
1230INTERFACE OPERATOR (/=)
1231 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1232END INTERFACE
1233
1234#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1235#define VOL7D_POLY_TYPES _var6d
1236#include "array_utilities_pre.F90"
1237
1240 MODULE PROCEDURE display_volgrid6d_var
1241END INTERFACE
1242
1247INTERFACE OPERATOR (*)
1248 MODULE PROCEDURE conv_func_mult
1249END INTERFACE OPERATOR (*)
1250
1254 MODULE PROCEDURE conv_func_compute
1255END INTERFACE
1256
1260 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1261 conv_func_convert
1262END INTERFACE
1263
1264PRIVATE
1266 c_e, volgrid6d_var_normalize, &
1267 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1268 count_distinct, pack_distinct, count_and_pack_distinct, &
1269 map_distinct, map_inv_distinct, &
1271 vargrib2varbufr, varbufr2vargrib, &
1273 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1274
1275
1276CONTAINS
1277
1278
1279ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1280 discipline, description, unit) RESULT(this)
1281integer,INTENT(in),OPTIONAL :: centre
1282integer,INTENT(in),OPTIONAL :: category
1283integer,INTENT(in),OPTIONAL :: number
1284integer,INTENT(in),OPTIONAL :: discipline
1285CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1286CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1287
1288TYPE(volgrid6d_var) :: this
1289
1291
1292END FUNCTION volgrid6d_var_new
1293
1294
1295! documented in the interface
1296ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1297TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1298INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1299INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1300INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1301INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1302CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1303CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1304
1305IF (PRESENT(centre)) THEN
1306 this%centre = centre
1307ELSE
1308 this%centre = imiss
1309 this%category = imiss
1310 this%number = imiss
1311 this%discipline = imiss
1312 RETURN
1313ENDIF
1314
1315IF (PRESENT(category)) THEN
1316 this%category = category
1317ELSE
1318 this%category = imiss
1319 this%number = imiss
1320 this%discipline = imiss
1321 RETURN
1322ENDIF
1323
1324
1325IF (PRESENT(number)) THEN
1326 this%number = number
1327ELSE
1328 this%number = imiss
1329 this%discipline = imiss
1330 RETURN
1331ENDIF
1332
1333! se sono arrivato fino a qui ho impostato centre, category e number
1334!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1335
1336IF (PRESENT(discipline)) THEN
1337 this%discipline = discipline
1338ELSE
1339 this%discipline = 255
1340ENDIF
1341
1342IF (PRESENT(description)) THEN
1343 this%description = description
1344ELSE
1345 this%description = cmiss
1346ENDIF
1347
1348IF (PRESENT(unit)) THEN
1349 this%unit = unit
1350ELSE
1351 this%unit = cmiss
1352ENDIF
1353
1354
1355
1356END SUBROUTINE volgrid6d_var_init
1357
1358
1359! documented in the interface
1360SUBROUTINE volgrid6d_var_delete(this)
1361TYPE(volgrid6d_var),INTENT(INOUT) :: this
1362
1363this%centre = imiss
1364this%category = imiss
1365this%number = imiss
1366this%discipline = imiss
1367this%description = cmiss
1368this%unit = cmiss
1369
1370END SUBROUTINE volgrid6d_var_delete
1371
1372
1373ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1374TYPE(volgrid6d_var),INTENT(IN) :: this
1375LOGICAL :: c_e
1376c_e = this /= volgrid6d_var_miss
1377END FUNCTION volgrid6d_var_c_e
1378
1379
1380ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1381TYPE(volgrid6d_var),INTENT(IN) :: this, that
1382LOGICAL :: res
1383
1384IF (this%discipline == that%discipline) THEN
1385
1386 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1387 res = ((this%category == that%category) .OR. &
1388 (this%category >= 1 .AND. this%category <=3 .AND. &
1389 that%category >= 1 .AND. that%category <=3)) .AND. &
1390 this%number == that%number
1391
1392 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1393 (this%number >= 128 .AND. this%number <= 254)) THEN
1394 res = res .AND. this%centre == that%centre ! local definition, centre matters
1395 ENDIF
1396
1397 ELSE ! grib2
1398 res = this%category == that%category .AND. &
1399 this%number == that%number
1400
1401 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1402 (this%category >= 192 .AND. this%category <= 254) .OR. &
1403 (this%number >= 192 .AND. this%number <= 254)) THEN
1404 res = res .AND. this%centre == that%centre ! local definition, centre matters
1405 ENDIF
1406 ENDIF
1407
1408ELSE ! different edition or different discipline
1409 res = .false.
1410ENDIF
1411
1412END FUNCTION volgrid6d_var_eq
1413
1414
1415ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1416TYPE(volgrid6d_var),INTENT(IN) :: this, that
1417LOGICAL :: res
1418
1419res = .NOT.(this == that)
1420
1421END FUNCTION volgrid6d_var_ne
1422
1423
1424#include "array_utilities_inc.F90"
1425
1426
1428SUBROUTINE display_volgrid6d_var(this)
1429TYPE(volgrid6d_var),INTENT(in) :: this
1430
1431print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1432
1433END SUBROUTINE display_volgrid6d_var
1434
1435
1448SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1449TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1450TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1451TYPE(conv_func),POINTER :: c_func(:)
1452
1453INTEGER :: i, n, stallo
1454
1455n = min(SIZE(varbufr), SIZE(vargrib))
1456ALLOCATE(c_func(n),stat=stallo)
1457IF (stallo /= 0) THEN
1458 call l4f_log(l4f_fatal,"allocating memory")
1459 call raise_fatal_error()
1460ENDIF
1461
1462DO i = 1, n
1463 varbufr(i) = convert(vargrib(i), c_func(i))
1464ENDDO
1465
1466END SUBROUTINE vargrib2varbufr
1467
1468
1479FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1480TYPE(volgrid6d_var),INTENT(in) :: vargrib
1481TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1482TYPE(vol7d_var) :: convert
1483
1484INTEGER :: i
1485
1486IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1487
1488DO i = 1, SIZE(conv_fwd)
1489 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1490 convert = conv_fwd(i)%v7d_var
1491 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1492 RETURN
1493 ENDIF
1494ENDDO
1495! not found
1496convert = vol7d_var_miss
1497IF (PRESENT(c_func)) c_func = conv_func_miss
1498
1499! set hint for backwards conversion
1500convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1501 vargrib%discipline/)
1502
1503CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1504 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1505 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1506 ' not found in table')
1507
1508END FUNCTION vargrib2varbufr_convert
1509
1510
1526SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1527TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1528TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1529TYPE(conv_func),POINTER :: c_func(:)
1530TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1531
1532INTEGER :: i, n, stallo
1533
1534n = min(SIZE(varbufr), SIZE(vargrib))
1535ALLOCATE(c_func(n),stat=stallo)
1536IF (stallo /= 0) THEN
1537 CALL l4f_log(l4f_fatal,"allocating memory")
1538 CALL raise_fatal_error()
1539ENDIF
1540
1541DO i = 1, n
1542 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1543ENDDO
1544
1545END SUBROUTINE varbufr2vargrib
1546
1547
1561FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1562TYPE(vol7d_var),INTENT(in) :: varbufr
1563TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1564TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1565TYPE(volgrid6d_var) :: convert
1566
1567INTEGER :: i
1568#ifdef HAVE_LIBGRIBAPI
1569INTEGER :: gaid, editionnumber, category, centre
1570#endif
1571
1572IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1573
1574#ifdef HAVE_LIBGRIBAPI
1575editionnumber=255; category=255; centre=255
1576#endif
1577IF (PRESENT(grid_id_template)) THEN
1578#ifdef HAVE_LIBGRIBAPI
1579 gaid = grid_id_get_gaid(grid_id_template)
1580 IF (c_e(gaid)) THEN
1581 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1582 IF (editionnumber == 1) THEN
1583 CALL grib_get(gaid,'gribTablesVersionNo',category)
1584 ENDIF
1585 CALL grib_get(gaid,'centre',centre)
1586 ENDIF
1587#endif
1588ENDIF
1589
1590DO i = 1, SIZE(conv_bwd)
1591 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1592#ifdef HAVE_LIBGRIBAPI
1593 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1594 IF (editionnumber == 1) THEN
1595 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1596 ELSE IF (editionnumber == 2) THEN
1597 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1598 ENDIF
1599 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1600 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1601 ENDIF
1602#endif
1603 convert = conv_bwd(i)%vg6d_var
1604 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1605 RETURN
1606 ENDIF
1607ENDDO
1608! not found
1609convert = volgrid6d_var_miss
1610IF (PRESENT(c_func)) c_func = conv_func_miss
1611
1612! if hint available use it as a fallback
1613IF (any(varbufr%gribhint /= imiss)) THEN
1614 convert%centre = varbufr%gribhint(1)
1615 convert%category = varbufr%gribhint(2)
1616 convert%number = varbufr%gribhint(3)
1617 convert%discipline = varbufr%gribhint(4)
1618ENDIF
1619
1620CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1621 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1622 ' not found in table')
1623
1624END FUNCTION varbufr2vargrib_convert
1625
1626
1634SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1635TYPE(volgrid6d_var),INTENT(inout) :: this
1636TYPE(conv_func),INTENT(out) :: c_func
1637TYPE(grid_id),INTENT(in) :: grid_id_template
1638
1639LOGICAL :: eqed, eqcentre
1640INTEGER :: gaid, editionnumber, centre
1641TYPE(volgrid6d_var) :: tmpgrib
1642TYPE(vol7d_var) :: tmpbufr
1643TYPE(conv_func) tmpc_func1, tmpc_func2
1644
1645eqed = .true.
1646eqcentre = .true.
1647c_func = conv_func_miss
1648
1649#ifdef HAVE_LIBGRIBAPI
1650gaid = grid_id_get_gaid(grid_id_template)
1651IF (c_e(gaid)) THEN
1652 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1653 CALL grib_get(gaid, 'centre', centre)
1654 eqed = editionnumber == 1 .EQV. this%discipline == 255
1655 eqcentre = centre == this%centre
1656ENDIF
1657#endif
1658
1659IF (eqed .AND. eqcentre) RETURN ! nothing to do
1660
1661tmpbufr = convert(this, tmpc_func1)
1662tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1663
1664IF (tmpgrib /= volgrid6d_var_miss) THEN
1665! conversion back and forth successful, set also conversion function
1666 this = tmpgrib
1667 c_func = tmpc_func1 * tmpc_func2
1668! set to missing in common case to avoid useless computation
1669 IF (c_func == conv_func_identity) c_func = conv_func_miss
1670ELSE IF (.NOT.eqed) THEN
1671! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1672 this = tmpgrib
1673ENDIF
1674
1675END SUBROUTINE volgrid6d_var_normalize
1676
1677
1678! Private subroutine for reading forward and backward conversion tables
1679! todo: better error handling
1680SUBROUTINE vg6d_v7d_var_conv_setup()
1681INTEGER :: un, i, n, stallo
1682
1683! forward, grib to bufr
1684un = open_package_file('vargrib2bufr.csv', filetype_data)
1685n=0
1686DO WHILE(.true.)
1687 READ(un,*,END=100)
1688 n = n + 1
1689ENDDO
1690
1691100 CONTINUE
1692
1693rewind(un)
1694ALLOCATE(conv_fwd(n),stat=stallo)
1695IF (stallo /= 0) THEN
1696 CALL l4f_log(l4f_fatal,"allocating memory")
1697 CALL raise_fatal_error()
1698ENDIF
1699
1700conv_fwd(:) = vg6d_v7d_var_conv_miss
1701CALL import_var_conv(un, conv_fwd)
1702CLOSE(un)
1703
1704! backward, bufr to grib
1705un = open_package_file('vargrib2bufr.csv', filetype_data)
1706! use the same file for now
1707!un = open_package_file('varbufr2grib.csv', filetype_data)
1708n=0
1709DO WHILE(.true.)
1710 READ(un,*,END=300)
1711 n = n + 1
1712ENDDO
1713
1714300 CONTINUE
1715
1716rewind(un)
1717ALLOCATE(conv_bwd(n),stat=stallo)
1718IF (stallo /= 0) THEN
1719 CALL l4f_log(l4f_fatal,"allocating memory")
1720 CALL raise_fatal_error()
1721end if
1722
1723conv_bwd(:) = vg6d_v7d_var_conv_miss
1724CALL import_var_conv(un, conv_bwd)
1725DO i = 1, n
1726 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1727 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1728ENDDO
1729CLOSE(un)
1730
1731CONTAINS
1732
1733SUBROUTINE import_var_conv(un, conv_type)
1734INTEGER, INTENT(in) :: un
1735TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1736
1737INTEGER :: i
1738TYPE(csv_record) :: csv
1739CHARACTER(len=1024) :: line
1740CHARACTER(len=10) :: btable
1741INTEGER :: centre, category, number, discipline
1742
1743DO i = 1, SIZE(conv_type)
1744 READ(un,'(A)',END=200)line
1746 CALL csv_record_getfield(csv, btable)
1747 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1748 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1750
1751 CALL csv_record_getfield(csv, centre)
1752 CALL csv_record_getfield(csv, category)
1753 CALL csv_record_getfield(csv, number)
1754 CALL csv_record_getfield(csv, discipline)
1756 number=number, discipline=discipline) ! controllare l'ordine
1757
1758 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1759 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1761ENDDO
1762
1763200 CONTINUE
1764
1765END SUBROUTINE import_var_conv
1766
1767END SUBROUTINE vg6d_v7d_var_conv_setup
1768
1769
1770ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1771TYPE(conv_func),INTENT(IN) :: this, that
1772LOGICAL :: res
1773
1774res = this%a == that%a .AND. this%b == that%b
1775
1776END FUNCTION conv_func_eq
1777
1778
1779ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1780TYPE(conv_func),INTENT(IN) :: this, that
1781LOGICAL :: res
1782
1783res = .NOT.(this == that)
1784
1785END FUNCTION conv_func_ne
1786
1787
1788FUNCTION conv_func_mult(this, that) RESULT(mult)
1789TYPE(conv_func),INTENT(in) :: this
1790TYPE(conv_func),INTENT(in) :: that
1791
1792TYPE(conv_func) :: mult
1793
1794IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1795 mult = conv_func_miss
1796ELSE
1797 mult%a = this%a*that%a
1798 mult%b = this%a*that%b+this%b
1799ENDIF
1800
1801END FUNCTION conv_func_mult
1802
1810ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1811TYPE(conv_func),INTENT(in) :: this
1812REAL,INTENT(inout) :: values
1813
1814IF (this /= conv_func_miss) THEN
1815 IF (c_e(values)) values = values*this%a + this%b
1816ELSE
1817 values=rmiss
1818ENDIF
1819
1820END SUBROUTINE conv_func_compute
1821
1822
1830ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1831TYPE(conv_func),intent(in) :: this
1832REAL,INTENT(in) :: values
1833REAL :: convert
1834
1835convert = values
1837
1838END FUNCTION conv_func_convert
1839
1840
1854SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1855TYPE(volgrid6d_var),INTENT(in) :: this(:)
1856INTEGER,POINTER :: xind(:), yind(:)
1857
1858TYPE(vol7d_var) :: varbufr(SIZE(this))
1859TYPE(conv_func),POINTER :: c_func(:)
1860INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1861
1862NULLIFY(xind, yind)
1863counts(:) = 0
1864
1865CALL vargrib2varbufr(this, varbufr, c_func)
1866
1867DO i = 1, SIZE(vol7d_var_horcomp)
1868 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1869ENDDO
1870
1871IF (any(counts(1::2) > 1)) THEN
1872 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1873 DEALLOCATE(c_func)
1874 RETURN
1875ENDIF
1876IF (any(counts(2::2) > 1)) THEN
1877 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1878 DEALLOCATE(c_func)
1879 RETURN
1880ENDIF
1881
1882! check that variables are paired and count pairs
1883nv = 0
1884DO i = 1, SIZE(vol7d_var_horcomp), 2
1885 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
1886 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
1887 ' present but the corresponding x-component '// &
1888 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
1889 RETURN
1890 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
1891 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
1892 ' present but the corresponding y-component '// &
1893 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
1894 RETURN
1895 ENDIF
1896 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
1897ENDDO
1898
1899! repeat the loop storing indices
1900ALLOCATE(xind(nv), yind(nv))
1901nv = 0
1902DO i = 1, SIZE(vol7d_var_horcomp), 2
1903 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
1904 nv = nv + 1
1905 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
1906 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
1907 ENDIF
1908ENDDO
1909DEALLOCATE(c_func)
1910
1911END SUBROUTINE volgrid6d_var_hor_comp_index
1912
1913
1918FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
1919TYPE(volgrid6d_var),INTENT(in) :: this
1920LOGICAL :: is_hor_comp
1921
1922TYPE(vol7d_var) :: varbufr
1923
1924varbufr = convert(this)
1925is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
1926
1927END FUNCTION volgrid6d_var_is_hor_comp
1928
1929! before unstaggering??
1930
1931!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1932!
1933!call init(varu,btable="B11003")
1934!call init(varv,btable="B11004")
1935!
1936! test about presence of u and v in standard table
1937!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
1938! call l4f_category_log(this%category,L4F_FATAL, &
1939! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
1940! CALL raise_error()
1941! RETURN
1942!end if
1943!
1944!if (associated(this%var))then
1945! nvar=size(this%var)
1946! allocate(varbufr(nvar),stat=stallo)
1947! if (stallo /=0)then
1948! call l4f_log(L4F_FATAL,"allocating memory")
1949! call raise_fatal_error("allocating memory")
1950! end if
1951!
1952! CALL vargrib2varbufr(this%var, varbufr)
1953!ELSE
1954! CALL l4f_category_log(this%category, L4F_ERROR, &
1955! "trying to destagger an incomplete volgrid6d object")
1956! CALL raise_error()
1957! RETURN
1958!end if
1959!
1960!nvaru=COUNT(varbufr==varu)
1961!nvarv=COUNT(varbufr==varv)
1962!
1963!if (nvaru > 1 )then
1964! call l4f_category_log(this%category,L4F_WARN, &
1965! ">1 variables refer to u wind component, destaggering will not be done ")
1966! DEALLOCATE(varbufr)
1967! RETURN
1968!endif
1969!
1970!if (nvarv > 1 )then
1971! call l4f_category_log(this%category,L4F_WARN, &
1972! ">1 variables refer to v wind component, destaggering will not be done ")
1973! DEALLOCATE(varbufr)
1974! RETURN
1975!endif
1976!
1977!if (nvaru == 0 .and. nvarv == 0) then
1978! call l4f_category_log(this%category,L4F_WARN, &
1979! "no u or v wind component found in volume, nothing to do")
1980! DEALLOCATE(varbufr)
1981! RETURN
1982!endif
1983!
1984!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
1985! call l4f_category_log(this%category,L4F_WARN, &
1986! "there are variables different from u and v wind component in C grid")
1987!endif
1988
1989
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 |