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