libsim Versione 7.1.11
|
◆ display_volgrid6d_var()
Display on the screen a brief content of volgrid6d_var object.
Definizione alla linea 1079 del file volgrid6d_var_class.F90. 1080! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1081! authors:
1082! Davide Cesari <dcesari@arpa.emr.it>
1083! Paolo Patruno <ppatruno@arpa.emr.it>
1084
1085! This program is free software; you can redistribute it and/or
1086! modify it under the terms of the GNU General Public License as
1087! published by the Free Software Foundation; either version 2 of
1088! the License, or (at your option) any later version.
1089
1090! This program is distributed in the hope that it will be useful,
1091! but WITHOUT ANY WARRANTY; without even the implied warranty of
1092! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1093! GNU General Public License for more details.
1094
1095! You should have received a copy of the GNU General Public License
1096! along with this program. If not, see <http://www.gnu.org/licenses/>.
1097#include "config.h"
1098
1116
1117IMPLICIT NONE
1118
1124 integer :: centre
1125 integer :: category
1126 integer :: number
1127 integer :: discipline
1128 CHARACTER(len=65) :: description
1129 CHARACTER(len=24) :: unit
1131
1132TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1133 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1134
1135TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1138 /)
1139
1140TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1145/)
1146!/), (/2,2/)) ! bug in gfortran
1147
1157 PRIVATE
1158 REAL :: a, b
1160
1163
1164TYPE vg6d_v7d_var_conv
1165 TYPE(volgrid6d_var) :: vg6d_var
1166 TYPE(vol7d_var) :: v7d_var
1167 TYPE(conv_func) :: c_func
1168! aggiungere informazioni ad es. su rotazione del vento
1169END TYPE vg6d_v7d_var_conv
1170
1171TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1172 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1173
1174TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1175
1190 MODULE PROCEDURE volgrid6d_var_init
1191END INTERFACE
1192
1196 MODULE PROCEDURE volgrid6d_var_delete
1197END INTERFACE
1198
1199INTERFACE c_e
1200 MODULE PROCEDURE volgrid6d_var_c_e
1201END INTERFACE
1202
1203
1208INTERFACE OPERATOR (==)
1209 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1210END INTERFACE
1211
1216INTERFACE OPERATOR (/=)
1217 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1218END INTERFACE
1219
1220#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1221#define VOL7D_POLY_TYPES _var6d
1222#include "array_utilities_pre.F90"
1223
1226 MODULE PROCEDURE display_volgrid6d_var
1227END INTERFACE
1228
1233INTERFACE OPERATOR (*)
1234 MODULE PROCEDURE conv_func_mult
1235END INTERFACE OPERATOR (*)
1236
1240 MODULE PROCEDURE conv_func_compute
1241END INTERFACE
1242
1246 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1247 conv_func_convert
1248END INTERFACE
1249
1250PRIVATE
1252 c_e, volgrid6d_var_normalize, &
1253 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1254 count_distinct, pack_distinct, count_and_pack_distinct, &
1255 map_distinct, map_inv_distinct, &
1257 vargrib2varbufr, varbufr2vargrib, &
1259 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1260
1261
1262CONTAINS
1263
1264
1265ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1266 discipline, description, unit) RESULT(this)
1267integer,INTENT(in),OPTIONAL :: centre
1268integer,INTENT(in),OPTIONAL :: category
1269integer,INTENT(in),OPTIONAL :: number
1270integer,INTENT(in),OPTIONAL :: discipline
1271CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1272CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1273
1274TYPE(volgrid6d_var) :: this
1275
1277
1278END FUNCTION volgrid6d_var_new
1279
1280
1281! documented in the interface
1282ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1283TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1284INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1285INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1286INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1287INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1288CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1289CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1290
1291IF (PRESENT(centre)) THEN
1292 this%centre = centre
1293ELSE
1294 this%centre = imiss
1295 this%category = imiss
1296 this%number = imiss
1297 this%discipline = imiss
1298 RETURN
1299ENDIF
1300
1301IF (PRESENT(category)) THEN
1302 this%category = category
1303ELSE
1304 this%category = imiss
1305 this%number = imiss
1306 this%discipline = imiss
1307 RETURN
1308ENDIF
1309
1310
1311IF (PRESENT(number)) THEN
1312 this%number = number
1313ELSE
1314 this%number = imiss
1315 this%discipline = imiss
1316 RETURN
1317ENDIF
1318
1319! se sono arrivato fino a qui ho impostato centre, category e number
1320!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1321
1322IF (PRESENT(discipline)) THEN
1323 this%discipline = discipline
1324ELSE
1325 this%discipline = 255
1326ENDIF
1327
1328IF (PRESENT(description)) THEN
1329 this%description = description
1330ELSE
1331 this%description = cmiss
1332ENDIF
1333
1334IF (PRESENT(unit)) THEN
1335 this%unit = unit
1336ELSE
1337 this%unit = cmiss
1338ENDIF
1339
1340
1341
1342END SUBROUTINE volgrid6d_var_init
1343
1344
1345! documented in the interface
1346SUBROUTINE volgrid6d_var_delete(this)
1347TYPE(volgrid6d_var),INTENT(INOUT) :: this
1348
1349this%centre = imiss
1350this%category = imiss
1351this%number = imiss
1352this%discipline = imiss
1353this%description = cmiss
1354this%unit = cmiss
1355
1356END SUBROUTINE volgrid6d_var_delete
1357
1358
1359ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1360TYPE(volgrid6d_var),INTENT(IN) :: this
1361LOGICAL :: c_e
1362c_e = this /= volgrid6d_var_miss
1363END FUNCTION volgrid6d_var_c_e
1364
1365
1366ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1367TYPE(volgrid6d_var),INTENT(IN) :: this, that
1368LOGICAL :: res
1369
1370IF (this%discipline == that%discipline) THEN
1371
1372 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1373 res = ((this%category == that%category) .OR. &
1374 (this%category >= 1 .AND. this%category <=3 .AND. &
1375 that%category >= 1 .AND. that%category <=3)) .AND. &
1376 this%number == that%number
1377
1378 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1379 (this%number >= 128 .AND. this%number <= 254)) THEN
1380 res = res .AND. this%centre == that%centre ! local definition, centre matters
1381 ENDIF
1382
1383 ELSE ! grib2
1384 res = this%category == that%category .AND. &
1385 this%number == that%number
1386
1387 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1388 (this%category >= 192 .AND. this%category <= 254) .OR. &
1389 (this%number >= 192 .AND. this%number <= 254)) THEN
1390 res = res .AND. this%centre == that%centre ! local definition, centre matters
1391 ENDIF
1392 ENDIF
1393
1394ELSE ! different edition or different discipline
1395 res = .false.
1396ENDIF
1397
1398END FUNCTION volgrid6d_var_eq
1399
1400
1401ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1402TYPE(volgrid6d_var),INTENT(IN) :: this, that
1403LOGICAL :: res
1404
1405res = .NOT.(this == that)
1406
1407END FUNCTION volgrid6d_var_ne
1408
1409
1410#include "array_utilities_inc.F90"
1411
1412
1414SUBROUTINE display_volgrid6d_var(this)
1415TYPE(volgrid6d_var),INTENT(in) :: this
1416
1417print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1418
1419END SUBROUTINE display_volgrid6d_var
1420
1421
1434SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1435TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1436TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1437TYPE(conv_func),POINTER :: c_func(:)
1438
1439INTEGER :: i, n, stallo
1440
1441n = min(SIZE(varbufr), SIZE(vargrib))
1442ALLOCATE(c_func(n),stat=stallo)
1443IF (stallo /= 0) THEN
1444 call l4f_log(l4f_fatal,"allocating memory")
1445 call raise_fatal_error()
1446ENDIF
1447
1448DO i = 1, n
1449 varbufr(i) = convert(vargrib(i), c_func(i))
1450ENDDO
1451
1452END SUBROUTINE vargrib2varbufr
1453
1454
1465FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1466TYPE(volgrid6d_var),INTENT(in) :: vargrib
1467TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1468TYPE(vol7d_var) :: convert
1469
1470INTEGER :: i
1471
1472IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1473
1474DO i = 1, SIZE(conv_fwd)
1475 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1476 convert = conv_fwd(i)%v7d_var
1477 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1478 RETURN
1479 ENDIF
1480ENDDO
1481! not found
1482convert = vol7d_var_miss
1483IF (PRESENT(c_func)) c_func = conv_func_miss
1484
1485! set hint for backwards conversion
1486convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1487 vargrib%discipline/)
1488
1489CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1490 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1491 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1492 ' not found in table')
1493
1494END FUNCTION vargrib2varbufr_convert
1495
1496
1512SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1513TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1514TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1515TYPE(conv_func),POINTER :: c_func(:)
1516TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1517
1518INTEGER :: i, n, stallo
1519
1520n = min(SIZE(varbufr), SIZE(vargrib))
1521ALLOCATE(c_func(n),stat=stallo)
1522IF (stallo /= 0) THEN
1523 CALL l4f_log(l4f_fatal,"allocating memory")
1524 CALL raise_fatal_error()
1525ENDIF
1526
1527DO i = 1, n
1528 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1529ENDDO
1530
1531END SUBROUTINE varbufr2vargrib
1532
1533
1547FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1548TYPE(vol7d_var),INTENT(in) :: varbufr
1549TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1550TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1551TYPE(volgrid6d_var) :: convert
1552
1553INTEGER :: i
1554#ifdef HAVE_LIBGRIBAPI
1555INTEGER :: gaid, editionnumber, category, centre
1556#endif
1557
1558IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1559
1560#ifdef HAVE_LIBGRIBAPI
1561editionnumber=255; category=255; centre=255
1562#endif
1563IF (PRESENT(grid_id_template)) THEN
1564#ifdef HAVE_LIBGRIBAPI
1565 gaid = grid_id_get_gaid(grid_id_template)
1566 IF (c_e(gaid)) THEN
1567 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1568 IF (editionnumber == 1) THEN
1569 CALL grib_get(gaid,'gribTablesVersionNo',category)
1570 ENDIF
1571 CALL grib_get(gaid,'centre',centre)
1572 ENDIF
1573#endif
1574ENDIF
1575
1576DO i = 1, SIZE(conv_bwd)
1577 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1578#ifdef HAVE_LIBGRIBAPI
1579 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1580 IF (editionnumber == 1) THEN
1581 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1582 ELSE IF (editionnumber == 2) THEN
1583 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1584 ENDIF
1585 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1586 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1587 ENDIF
1588#endif
1589 convert = conv_bwd(i)%vg6d_var
1590 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1591 RETURN
1592 ENDIF
1593ENDDO
1594! not found
1595convert = volgrid6d_var_miss
1596IF (PRESENT(c_func)) c_func = conv_func_miss
1597
1598! if hint available use it as a fallback
1599IF (any(varbufr%gribhint /= imiss)) THEN
1600 convert%centre = varbufr%gribhint(1)
1601 convert%category = varbufr%gribhint(2)
1602 convert%number = varbufr%gribhint(3)
1603 convert%discipline = varbufr%gribhint(4)
1604ENDIF
1605
1606CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1607 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1608 ' not found in table')
1609
1610END FUNCTION varbufr2vargrib_convert
1611
1612
1620SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1621TYPE(volgrid6d_var),INTENT(inout) :: this
1622TYPE(conv_func),INTENT(out) :: c_func
1623TYPE(grid_id),INTENT(in) :: grid_id_template
1624
1625LOGICAL :: eqed, eqcentre
1626INTEGER :: gaid, editionnumber, centre
1627TYPE(volgrid6d_var) :: tmpgrib
1628TYPE(vol7d_var) :: tmpbufr
1629TYPE(conv_func) tmpc_func1, tmpc_func2
1630
1631eqed = .true.
1632eqcentre = .true.
1633c_func = conv_func_miss
1634
1635#ifdef HAVE_LIBGRIBAPI
1636gaid = grid_id_get_gaid(grid_id_template)
1637IF (c_e(gaid)) THEN
1638 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1639 CALL grib_get(gaid, 'centre', centre)
1640 eqed = editionnumber == 1 .EQV. this%discipline == 255
1641 eqcentre = centre == this%centre
1642ENDIF
1643#endif
1644
1645IF (eqed .AND. eqcentre) RETURN ! nothing to do
1646
1647tmpbufr = convert(this, tmpc_func1)
1648tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1649
1650IF (tmpgrib /= volgrid6d_var_miss) THEN
1651! conversion back and forth successful, set also conversion function
1652 this = tmpgrib
1653 c_func = tmpc_func1 * tmpc_func2
1654! set to missing in common case to avoid useless computation
1655 IF (c_func == conv_func_identity) c_func = conv_func_miss
1656ELSE IF (.NOT.eqed) THEN
1657! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1658 this = tmpgrib
1659ENDIF
1660
1661END SUBROUTINE volgrid6d_var_normalize
1662
1663
1664! Private subroutine for reading forward and backward conversion tables
1665! todo: better error handling
1666SUBROUTINE vg6d_v7d_var_conv_setup()
1667INTEGER :: un, i, n, stallo
1668
1669! forward, grib to bufr
1670un = open_package_file('vargrib2bufr.csv', filetype_data)
1671n=0
1672DO WHILE(.true.)
1673 READ(un,*,END=100)
1674 n = n + 1
1675ENDDO
1676
1677100 CONTINUE
1678
1679rewind(un)
1680ALLOCATE(conv_fwd(n),stat=stallo)
1681IF (stallo /= 0) THEN
1682 CALL l4f_log(l4f_fatal,"allocating memory")
1683 CALL raise_fatal_error()
1684ENDIF
1685
1686conv_fwd(:) = vg6d_v7d_var_conv_miss
1687CALL import_var_conv(un, conv_fwd)
1688CLOSE(un)
1689
1690! backward, bufr to grib
1691un = open_package_file('vargrib2bufr.csv', filetype_data)
1692! use the same file for now
1693!un = open_package_file('varbufr2grib.csv', filetype_data)
1694n=0
1695DO WHILE(.true.)
1696 READ(un,*,END=300)
1697 n = n + 1
1698ENDDO
1699
1700300 CONTINUE
1701
1702rewind(un)
1703ALLOCATE(conv_bwd(n),stat=stallo)
1704IF (stallo /= 0) THEN
1705 CALL l4f_log(l4f_fatal,"allocating memory")
1706 CALL raise_fatal_error()
1707end if
1708
1709conv_bwd(:) = vg6d_v7d_var_conv_miss
1710CALL import_var_conv(un, conv_bwd)
1711DO i = 1, n
1712 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1713 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1714ENDDO
1715CLOSE(un)
1716
1717CONTAINS
1718
1719SUBROUTINE import_var_conv(un, conv_type)
1720INTEGER, INTENT(in) :: un
1721TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1722
1723INTEGER :: i
1724TYPE(csv_record) :: csv
1725CHARACTER(len=1024) :: line
1726CHARACTER(len=10) :: btable
1727INTEGER :: centre, category, number, discipline
1728
1729DO i = 1, SIZE(conv_type)
1730 READ(un,'(A)',END=200)line
1732 CALL csv_record_getfield(csv, btable)
1733 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1734 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1736
1737 CALL csv_record_getfield(csv, centre)
1738 CALL csv_record_getfield(csv, category)
1739 CALL csv_record_getfield(csv, number)
1740 CALL csv_record_getfield(csv, discipline)
1742 number=number, discipline=discipline) ! controllare l'ordine
1743
1744 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1745 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1747ENDDO
1748
1749200 CONTINUE
1750
1751END SUBROUTINE import_var_conv
1752
1753END SUBROUTINE vg6d_v7d_var_conv_setup
1754
1755
1756ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1757TYPE(conv_func),INTENT(IN) :: this, that
1758LOGICAL :: res
1759
1760res = this%a == that%a .AND. this%b == that%b
1761
1762END FUNCTION conv_func_eq
1763
1764
1765ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1766TYPE(conv_func),INTENT(IN) :: this, that
1767LOGICAL :: res
1768
1769res = .NOT.(this == that)
1770
1771END FUNCTION conv_func_ne
1772
1773
1774FUNCTION conv_func_mult(this, that) RESULT(mult)
1775TYPE(conv_func),INTENT(in) :: this
1776TYPE(conv_func),INTENT(in) :: that
1777
1778TYPE(conv_func) :: mult
1779
1780IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1781 mult = conv_func_miss
1782ELSE
1783 mult%a = this%a*that%a
1784 mult%b = this%a*that%b+this%b
1785ENDIF
1786
1787END FUNCTION conv_func_mult
1788
1796ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1797TYPE(conv_func),INTENT(in) :: this
1798REAL,INTENT(inout) :: values
1799
1800IF (this /= conv_func_miss) THEN
1801 IF (c_e(values)) values = values*this%a + this%b
1802ELSE
1803 values=rmiss
1804ENDIF
1805
1806END SUBROUTINE conv_func_compute
1807
1808
1816ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1817TYPE(conv_func),intent(in) :: this
1818REAL,INTENT(in) :: values
1819REAL :: convert
1820
1821convert = values
1823
1824END FUNCTION conv_func_convert
1825
1826
1840SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1841TYPE(volgrid6d_var),INTENT(in) :: this(:)
1842INTEGER,POINTER :: xind(:), yind(:)
1843
1844TYPE(vol7d_var) :: varbufr(SIZE(this))
1845TYPE(conv_func),POINTER :: c_func(:)
1846INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1847
1848NULLIFY(xind, yind)
1849counts(:) = 0
1850
1851CALL vargrib2varbufr(this, varbufr, c_func)
1852
1853DO i = 1, SIZE(vol7d_var_horcomp)
1854 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1855ENDDO
1856
1857IF (any(counts(1::2) > 1)) THEN
1858 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1859 DEALLOCATE(c_func)
1860 RETURN
1861ENDIF
1862IF (any(counts(2::2) > 1)) THEN
1863 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1864 DEALLOCATE(c_func)
1865 RETURN
1866ENDIF
1867
1868! check that variables are paired and count pairs
1869nv = 0
1870DO i = 1, SIZE(vol7d_var_horcomp), 2
1871 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
1872 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
1873 ' present but the corresponding x-component '// &
1874 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
1875 RETURN
1876 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
1877 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
1878 ' present but the corresponding y-component '// &
1879 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
1880 RETURN
1881 ENDIF
1882 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
1883ENDDO
1884
1885! repeat the loop storing indices
1886ALLOCATE(xind(nv), yind(nv))
1887nv = 0
1888DO i = 1, SIZE(vol7d_var_horcomp), 2
1889 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
1890 nv = nv + 1
1891 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
1892 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
1893 ENDIF
1894ENDDO
1895DEALLOCATE(c_func)
1896
1897END SUBROUTINE volgrid6d_var_hor_comp_index
1898
1899
1904FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
1905TYPE(volgrid6d_var),INTENT(in) :: this
1906LOGICAL :: is_hor_comp
1907
1908TYPE(vol7d_var) :: varbufr
1909
1910varbufr = convert(this)
1911is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
1912
1913END FUNCTION volgrid6d_var_is_hor_comp
1914
1915! before unstaggering??
1916
1917!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1918!
1919!call init(varu,btable="B11003")
1920!call init(varv,btable="B11004")
1921!
1922! test about presence of u and v in standard table
1923!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
1924! call l4f_category_log(this%category,L4F_FATAL, &
1925! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
1926! CALL raise_error()
1927! RETURN
1928!end if
1929!
1930!if (associated(this%var))then
1931! nvar=size(this%var)
1932! allocate(varbufr(nvar),stat=stallo)
1933! if (stallo /=0)then
1934! call l4f_log(L4F_FATAL,"allocating memory")
1935! call raise_fatal_error("allocating memory")
1936! end if
1937!
1938! CALL vargrib2varbufr(this%var, varbufr)
1939!ELSE
1940! CALL l4f_category_log(this%category, L4F_ERROR, &
1941! "trying to destagger an incomplete volgrid6d object")
1942! CALL raise_error()
1943! RETURN
1944!end if
1945!
1946!nvaru=COUNT(varbufr==varu)
1947!nvarv=COUNT(varbufr==varv)
1948!
1949!if (nvaru > 1 )then
1950! call l4f_category_log(this%category,L4F_WARN, &
1951! ">1 variables refer to u wind component, destaggering will not be done ")
1952! DEALLOCATE(varbufr)
1953! RETURN
1954!endif
1955!
1956!if (nvarv > 1 )then
1957! call l4f_category_log(this%category,L4F_WARN, &
1958! ">1 variables refer to v wind component, destaggering will not be done ")
1959! DEALLOCATE(varbufr)
1960! RETURN
1961!endif
1962!
1963!if (nvaru == 0 .and. nvarv == 0) then
1964! call l4f_category_log(this%category,L4F_WARN, &
1965! "no u or v wind component found in volume, nothing to do")
1966! DEALLOCATE(varbufr)
1967! RETURN
1968!endif
1969!
1970!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
1971! call l4f_category_log(this%category,L4F_WARN, &
1972! "there are variables different from u and v wind component in C grid")
1973!endif
1974
1975
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 |