libsim Versione 7.1.11

◆ display_volgrid6d_var()

subroutine display_volgrid6d_var ( type(volgrid6d_var), intent(in)  this)
private

Display on the screen a brief content of volgrid6d_var object.

Parametri
[in]thisvolgrid6d_var object to display

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
1110USE kinds
1112USE err_handling
1115USE grid_id_class
1116
1117IMPLICIT NONE
1118
1123TYPE volgrid6d_var
1124 integer :: centre
1125 integer :: category
1126 integer :: number
1127 integer :: discipline
1128 CHARACTER(len=65) :: description
1129 CHARACTER(len=24) :: unit
1130END TYPE volgrid6d_var
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) = (/ &
1136 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1137 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
1138 /)
1139
1140TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1141 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1142 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
1143 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
1144 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
1145/)
1146!/), (/2,2/)) ! bug in gfortran
1147
1156TYPE conv_func
1157 PRIVATE
1158 REAL :: a, b
1159END TYPE conv_func
1160
1161TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
1162TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
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
1189INTERFACE init
1190 MODULE PROCEDURE volgrid6d_var_init
1191END INTERFACE
1192
1195INTERFACE delete
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
1225INTERFACE display
1226 MODULE PROCEDURE display_volgrid6d_var
1227END INTERFACE
1228
1233INTERFACE OPERATOR (*)
1234 MODULE PROCEDURE conv_func_mult
1235END INTERFACE OPERATOR (*)
1236
1239INTERFACE compute
1240 MODULE PROCEDURE conv_func_compute
1241END INTERFACE
1242
1245INTERFACE convert
1246 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1247 conv_func_convert
1248END INTERFACE
1249
1250PRIVATE
1251PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
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, &
1256 index, display, &
1257 vargrib2varbufr, varbufr2vargrib, &
1258 conv_func, conv_func_miss, compute, convert, &
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
1276CALL init(this, centre, category, number, discipline, description, unit)
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
1731 CALL init(csv, 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
1735 CALL init(conv_type(i)%v7d_var, btable=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)
1741 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
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)
1746 CALL delete(csv)
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
1822CALL compute(this, convert)
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
1976END MODULE volgrid6d_var_class
Index method.
Apply the conversion function this to values.
Apply the conversion function this to values.
Destructor for the corresponding object, it assigns it to a missing value.
Display on the screen a brief content of object.
Initialize a volgrid6d_var object with the optional arguments provided.
Gestione degli errori.
Utilities for managing files.
This module defines an abstract interface to different drivers for access to files containing gridded...
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.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Class for managing physical variables in a grib 1/2 fashion.
Definisce una variabile meteorologica osservata o un suo attributo.
Class defining a real conversion function between units.
Definition of a physical variable in grib coding style.

Generated with Doxygen.