libsim Versione 7.2.0
|
◆ index_var6d()
Cerca l'indice del primo o ultimo elemento di vect uguale a search. Definizione alla linea 996 del file volgrid6d_var_class.F90. 998! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
999! authors:
1000! Davide Cesari <dcesari@arpa.emr.it>
1001! Paolo Patruno <ppatruno@arpa.emr.it>
1002
1003! This program is free software; you can redistribute it and/or
1004! modify it under the terms of the GNU General Public License as
1005! published by the Free Software Foundation; either version 2 of
1006! the License, or (at your option) any later version.
1007
1008! This program is distributed in the hope that it will be useful,
1009! but WITHOUT ANY WARRANTY; without even the implied warranty of
1010! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1011! GNU General Public License for more details.
1012
1013! You should have received a copy of the GNU General Public License
1014! along with this program. If not, see <http://www.gnu.org/licenses/>.
1015#include "config.h"
1016
1034
1035IMPLICIT NONE
1036
1042 integer :: centre
1043 integer :: category
1044 integer :: number
1045 integer :: discipline
1046 CHARACTER(len=65) :: description
1047 CHARACTER(len=24) :: unit
1049
1050TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1051 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
1052
1053TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1056 /)
1057
1058TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1063/)
1064!/), (/2,2/)) ! bug in gfortran
1065
1075 PRIVATE
1076 REAL :: a, b
1078
1081
1082TYPE vg6d_v7d_var_conv
1083 TYPE(volgrid6d_var) :: vg6d_var
1084 TYPE(vol7d_var) :: v7d_var
1085 TYPE(conv_func) :: c_func
1086! aggiungere informazioni ad es. su rotazione del vento
1087END TYPE vg6d_v7d_var_conv
1088
1089TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1090 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1091
1092TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1093
1108 MODULE PROCEDURE volgrid6d_var_init
1109END INTERFACE
1110
1114 MODULE PROCEDURE volgrid6d_var_delete
1115END INTERFACE
1116
1117INTERFACE c_e
1118 MODULE PROCEDURE volgrid6d_var_c_e
1119END INTERFACE
1120
1121
1126INTERFACE OPERATOR (==)
1127 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1128END INTERFACE
1129
1134INTERFACE OPERATOR (/=)
1135 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1136END INTERFACE
1137
1138#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1139#define VOL7D_POLY_TYPES _var6d
1140#include "array_utilities_pre.F90"
1141
1144 MODULE PROCEDURE display_volgrid6d_var
1145END INTERFACE
1146
1151INTERFACE OPERATOR (*)
1152 MODULE PROCEDURE conv_func_mult
1153END INTERFACE OPERATOR (*)
1154
1158 MODULE PROCEDURE conv_func_compute
1159END INTERFACE
1160
1164 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1165 conv_func_convert
1166END INTERFACE
1167
1168PRIVATE
1170 c_e, volgrid6d_var_normalize, &
1171 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1172 count_distinct, pack_distinct, count_and_pack_distinct, &
1173 map_distinct, map_inv_distinct, &
1175 vargrib2varbufr, varbufr2vargrib, &
1177 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1178
1179
1180CONTAINS
1181
1182
1183ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1184 discipline, description, unit) RESULT(this)
1185integer,INTENT(in),OPTIONAL :: centre
1186integer,INTENT(in),OPTIONAL :: category
1187integer,INTENT(in),OPTIONAL :: number
1188integer,INTENT(in),OPTIONAL :: discipline
1189CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1190CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1191
1192TYPE(volgrid6d_var) :: this
1193
1195
1196END FUNCTION volgrid6d_var_new
1197
1198
1199! documented in the interface
1200ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1201TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1202INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1203INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1204INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1205INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1206CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1207CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1208
1209IF (PRESENT(centre)) THEN
1210 this%centre = centre
1211ELSE
1212 this%centre = imiss
1213 this%category = imiss
1214 this%number = imiss
1215 this%discipline = imiss
1216 RETURN
1217ENDIF
1218
1219IF (PRESENT(category)) THEN
1220 this%category = category
1221ELSE
1222 this%category = imiss
1223 this%number = imiss
1224 this%discipline = imiss
1225 RETURN
1226ENDIF
1227
1228
1229IF (PRESENT(number)) THEN
1230 this%number = number
1231ELSE
1232 this%number = imiss
1233 this%discipline = imiss
1234 RETURN
1235ENDIF
1236
1237! se sono arrivato fino a qui ho impostato centre, category e number
1238!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1239
1240IF (PRESENT(discipline)) THEN
1241 this%discipline = discipline
1242ELSE
1243 this%discipline = 255
1244ENDIF
1245
1246IF (PRESENT(description)) THEN
1247 this%description = description
1248ELSE
1249 this%description = cmiss
1250ENDIF
1251
1252IF (PRESENT(unit)) THEN
1253 this%unit = unit
1254ELSE
1255 this%unit = cmiss
1256ENDIF
1257
1258
1259
1260END SUBROUTINE volgrid6d_var_init
1261
1262
1263! documented in the interface
1264SUBROUTINE volgrid6d_var_delete(this)
1265TYPE(volgrid6d_var),INTENT(INOUT) :: this
1266
1267this%centre = imiss
1268this%category = imiss
1269this%number = imiss
1270this%discipline = imiss
1271this%description = cmiss
1272this%unit = cmiss
1273
1274END SUBROUTINE volgrid6d_var_delete
1275
1276
1277ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1278TYPE(volgrid6d_var),INTENT(IN) :: this
1279LOGICAL :: c_e
1280c_e = this /= volgrid6d_var_miss
1281END FUNCTION volgrid6d_var_c_e
1282
1283
1284ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1285TYPE(volgrid6d_var),INTENT(IN) :: this, that
1286LOGICAL :: res
1287
1288IF (this%discipline == that%discipline) THEN
1289
1290 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1291 res = ((this%category == that%category) .OR. &
1292 (this%category >= 1 .AND. this%category <=3 .AND. &
1293 that%category >= 1 .AND. that%category <=3)) .AND. &
1294 this%number == that%number
1295
1296 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1297 (this%number >= 128 .AND. this%number <= 254)) THEN
1298 res = res .AND. this%centre == that%centre ! local definition, centre matters
1299 ENDIF
1300
1301 ELSE ! grib2
1302 res = this%category == that%category .AND. &
1303 this%number == that%number
1304
1305 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1306 (this%category >= 192 .AND. this%category <= 254) .OR. &
1307 (this%number >= 192 .AND. this%number <= 254)) THEN
1308 res = res .AND. this%centre == that%centre ! local definition, centre matters
1309 ENDIF
1310 ENDIF
1311
1312ELSE ! different edition or different discipline
1313 res = .false.
1314ENDIF
1315
1316END FUNCTION volgrid6d_var_eq
1317
1318
1319ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1320TYPE(volgrid6d_var),INTENT(IN) :: this, that
1321LOGICAL :: res
1322
1323res = .NOT.(this == that)
1324
1325END FUNCTION volgrid6d_var_ne
1326
1327
1328#include "array_utilities_inc.F90"
1329
1330
1332SUBROUTINE display_volgrid6d_var(this)
1333TYPE(volgrid6d_var),INTENT(in) :: this
1334
1335print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1336
1337END SUBROUTINE display_volgrid6d_var
1338
1339
1352SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1353TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1354TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1355TYPE(conv_func),POINTER :: c_func(:)
1356
1357INTEGER :: i, n, stallo
1358
1359n = min(SIZE(varbufr), SIZE(vargrib))
1360ALLOCATE(c_func(n),stat=stallo)
1361IF (stallo /= 0) THEN
1362 call l4f_log(l4f_fatal,"allocating memory")
1363 call raise_fatal_error()
1364ENDIF
1365
1366DO i = 1, n
1367 varbufr(i) = convert(vargrib(i), c_func(i))
1368ENDDO
1369
1370END SUBROUTINE vargrib2varbufr
1371
1372
1383FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1384TYPE(volgrid6d_var),INTENT(in) :: vargrib
1385TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1386TYPE(vol7d_var) :: convert
1387
1388INTEGER :: i
1389
1390IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1391
1392DO i = 1, SIZE(conv_fwd)
1393 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1394 convert = conv_fwd(i)%v7d_var
1395 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1396 RETURN
1397 ENDIF
1398ENDDO
1399! not found
1400convert = vol7d_var_miss
1401IF (PRESENT(c_func)) c_func = conv_func_miss
1402
1403! set hint for backwards conversion
1404convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1405 vargrib%discipline/)
1406
1407CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1408 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1409 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1410 ' not found in table')
1411
1412END FUNCTION vargrib2varbufr_convert
1413
1414
1430SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1431TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1432TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1433TYPE(conv_func),POINTER :: c_func(:)
1434TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1435
1436INTEGER :: i, n, stallo
1437
1438n = min(SIZE(varbufr), SIZE(vargrib))
1439ALLOCATE(c_func(n),stat=stallo)
1440IF (stallo /= 0) THEN
1441 CALL l4f_log(l4f_fatal,"allocating memory")
1442 CALL raise_fatal_error()
1443ENDIF
1444
1445DO i = 1, n
1446 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1447ENDDO
1448
1449END SUBROUTINE varbufr2vargrib
1450
1451
1465FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1466TYPE(vol7d_var),INTENT(in) :: varbufr
1467TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1468TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1469TYPE(volgrid6d_var) :: convert
1470
1471INTEGER :: i
1472#ifdef HAVE_LIBGRIBAPI
1473INTEGER :: gaid, editionnumber, category, centre
1474#endif
1475
1476IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1477
1478#ifdef HAVE_LIBGRIBAPI
1479editionnumber=255; category=255; centre=255
1480#endif
1481IF (PRESENT(grid_id_template)) THEN
1482#ifdef HAVE_LIBGRIBAPI
1483 gaid = grid_id_get_gaid(grid_id_template)
1484 IF (c_e(gaid)) THEN
1485 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1486 IF (editionnumber == 1) THEN
1487 CALL grib_get(gaid,'gribTablesVersionNo',category)
1488 ENDIF
1489 CALL grib_get(gaid,'centre',centre)
1490 ENDIF
1491#endif
1492ENDIF
1493
1494DO i = 1, SIZE(conv_bwd)
1495 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1496#ifdef HAVE_LIBGRIBAPI
1497 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1498 IF (editionnumber == 1) THEN
1499 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1500 ELSE IF (editionnumber == 2) THEN
1501 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1502 ENDIF
1503 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1504 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1505 ENDIF
1506#endif
1507 convert = conv_bwd(i)%vg6d_var
1508 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1509 RETURN
1510 ENDIF
1511ENDDO
1512! not found
1513convert = volgrid6d_var_miss
1514IF (PRESENT(c_func)) c_func = conv_func_miss
1515
1516! if hint available use it as a fallback
1517IF (any(varbufr%gribhint /= imiss)) THEN
1518 convert%centre = varbufr%gribhint(1)
1519 convert%category = varbufr%gribhint(2)
1520 convert%number = varbufr%gribhint(3)
1521 convert%discipline = varbufr%gribhint(4)
1522ENDIF
1523
1524CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1525 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1526 ' not found in table')
1527
1528END FUNCTION varbufr2vargrib_convert
1529
1530
1538SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1539TYPE(volgrid6d_var),INTENT(inout) :: this
1540TYPE(conv_func),INTENT(out) :: c_func
1541TYPE(grid_id),INTENT(in) :: grid_id_template
1542
1543LOGICAL :: eqed, eqcentre
1544INTEGER :: gaid, editionnumber, centre
1545TYPE(volgrid6d_var) :: tmpgrib
1546TYPE(vol7d_var) :: tmpbufr
1547TYPE(conv_func) tmpc_func1, tmpc_func2
1548
1549eqed = .true.
1550eqcentre = .true.
1551c_func = conv_func_miss
1552
1553#ifdef HAVE_LIBGRIBAPI
1554gaid = grid_id_get_gaid(grid_id_template)
1555IF (c_e(gaid)) THEN
1556 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1557 CALL grib_get(gaid, 'centre', centre)
1558 eqed = editionnumber == 1 .EQV. this%discipline == 255
1559 eqcentre = centre == this%centre
1560ENDIF
1561#endif
1562
1563IF (eqed .AND. eqcentre) RETURN ! nothing to do
1564
1565tmpbufr = convert(this, tmpc_func1)
1566tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1567
1568IF (tmpgrib /= volgrid6d_var_miss) THEN
1569! conversion back and forth successful, set also conversion function
1570 this = tmpgrib
1571 c_func = tmpc_func1 * tmpc_func2
1572! set to missing in common case to avoid useless computation
1573 IF (c_func == conv_func_identity) c_func = conv_func_miss
1574ELSE IF (.NOT.eqed) THEN
1575! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1576 this = tmpgrib
1577ENDIF
1578
1579END SUBROUTINE volgrid6d_var_normalize
1580
1581
1582! Private subroutine for reading forward and backward conversion tables
1583! todo: better error handling
1584SUBROUTINE vg6d_v7d_var_conv_setup()
1585INTEGER :: un, i, n, stallo
1586
1587! forward, grib to bufr
1588un = open_package_file('vargrib2bufr.csv', filetype_data)
1589n=0
1590DO WHILE(.true.)
1591 READ(un,*,END=100)
1592 n = n + 1
1593ENDDO
1594
1595100 CONTINUE
1596
1597rewind(un)
1598ALLOCATE(conv_fwd(n),stat=stallo)
1599IF (stallo /= 0) THEN
1600 CALL l4f_log(l4f_fatal,"allocating memory")
1601 CALL raise_fatal_error()
1602ENDIF
1603
1604conv_fwd(:) = vg6d_v7d_var_conv_miss
1605CALL import_var_conv(un, conv_fwd)
1606CLOSE(un)
1607
1608! backward, bufr to grib
1609un = open_package_file('vargrib2bufr.csv', filetype_data)
1610! use the same file for now
1611!un = open_package_file('varbufr2grib.csv', filetype_data)
1612n=0
1613DO WHILE(.true.)
1614 READ(un,*,END=300)
1615 n = n + 1
1616ENDDO
1617
1618300 CONTINUE
1619
1620rewind(un)
1621ALLOCATE(conv_bwd(n),stat=stallo)
1622IF (stallo /= 0) THEN
1623 CALL l4f_log(l4f_fatal,"allocating memory")
1624 CALL raise_fatal_error()
1625end if
1626
1627conv_bwd(:) = vg6d_v7d_var_conv_miss
1628CALL import_var_conv(un, conv_bwd)
1629DO i = 1, n
1630 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1631 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1632ENDDO
1633CLOSE(un)
1634
1635CONTAINS
1636
1637SUBROUTINE import_var_conv(un, conv_type)
1638INTEGER, INTENT(in) :: un
1639TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1640
1641INTEGER :: i
1642TYPE(csv_record) :: csv
1643CHARACTER(len=1024) :: line
1644CHARACTER(len=10) :: btable
1645INTEGER :: centre, category, number, discipline
1646
1647DO i = 1, SIZE(conv_type)
1648 READ(un,'(A)',END=200)line
1650 CALL csv_record_getfield(csv, btable)
1651 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1652 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1654
1655 CALL csv_record_getfield(csv, centre)
1656 CALL csv_record_getfield(csv, category)
1657 CALL csv_record_getfield(csv, number)
1658 CALL csv_record_getfield(csv, discipline)
1660 number=number, discipline=discipline) ! controllare l'ordine
1661
1662 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1663 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1665ENDDO
1666
1667200 CONTINUE
1668
1669END SUBROUTINE import_var_conv
1670
1671END SUBROUTINE vg6d_v7d_var_conv_setup
1672
1673
1674ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1675TYPE(conv_func),INTENT(IN) :: this, that
1676LOGICAL :: res
1677
1678res = this%a == that%a .AND. this%b == that%b
1679
1680END FUNCTION conv_func_eq
1681
1682
1683ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1684TYPE(conv_func),INTENT(IN) :: this, that
1685LOGICAL :: res
1686
1687res = .NOT.(this == that)
1688
1689END FUNCTION conv_func_ne
1690
1691
1692FUNCTION conv_func_mult(this, that) RESULT(mult)
1693TYPE(conv_func),INTENT(in) :: this
1694TYPE(conv_func),INTENT(in) :: that
1695
1696TYPE(conv_func) :: mult
1697
1698IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1699 mult = conv_func_miss
1700ELSE
1701 mult%a = this%a*that%a
1702 mult%b = this%a*that%b+this%b
1703ENDIF
1704
1705END FUNCTION conv_func_mult
1706
1714ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1715TYPE(conv_func),INTENT(in) :: this
1716REAL,INTENT(inout) :: values
1717
1718IF (this /= conv_func_miss) THEN
1719 IF (c_e(values)) values = values*this%a + this%b
1720ELSE
1721 values=rmiss
1722ENDIF
1723
1724END SUBROUTINE conv_func_compute
1725
1726
1734ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1735TYPE(conv_func),intent(in) :: this
1736REAL,INTENT(in) :: values
1737REAL :: convert
1738
1739convert = values
1741
1742END FUNCTION conv_func_convert
1743
1744
1758SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1759TYPE(volgrid6d_var),INTENT(in) :: this(:)
1760INTEGER,POINTER :: xind(:), yind(:)
1761
1762TYPE(vol7d_var) :: varbufr(SIZE(this))
1763TYPE(conv_func),POINTER :: c_func(:)
1764INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1765
1766NULLIFY(xind, yind)
1767counts(:) = 0
1768
1769CALL vargrib2varbufr(this, varbufr, c_func)
1770
1771DO i = 1, SIZE(vol7d_var_horcomp)
1772 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1773ENDDO
1774
1775IF (any(counts(1::2) > 1)) THEN
1776 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1777 DEALLOCATE(c_func)
1778 RETURN
1779ENDIF
1780IF (any(counts(2::2) > 1)) THEN
1781 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1782 DEALLOCATE(c_func)
1783 RETURN
1784ENDIF
1785
1786! check that variables are paired and count pairs
1787nv = 0
1788DO i = 1, SIZE(vol7d_var_horcomp), 2
1789 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
1790 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
1791 ' present but the corresponding x-component '// &
1792 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
1793 RETURN
1794 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
1795 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
1796 ' present but the corresponding y-component '// &
1797 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
1798 RETURN
1799 ENDIF
1800 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
1801ENDDO
1802
1803! repeat the loop storing indices
1804ALLOCATE(xind(nv), yind(nv))
1805nv = 0
1806DO i = 1, SIZE(vol7d_var_horcomp), 2
1807 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
1808 nv = nv + 1
1809 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
1810 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
1811 ENDIF
1812ENDDO
1813DEALLOCATE(c_func)
1814
1815END SUBROUTINE volgrid6d_var_hor_comp_index
1816
1817
1822FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
1823TYPE(volgrid6d_var),INTENT(in) :: this
1824LOGICAL :: is_hor_comp
1825
1826TYPE(vol7d_var) :: varbufr
1827
1828varbufr = convert(this)
1829is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
1830
1831END FUNCTION volgrid6d_var_is_hor_comp
1832
1833! before unstaggering??
1834
1835!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1836!
1837!call init(varu,btable="B11003")
1838!call init(varv,btable="B11004")
1839!
1840! test about presence of u and v in standard table
1841!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
1842! call l4f_category_log(this%category,L4F_FATAL, &
1843! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
1844! CALL raise_error()
1845! RETURN
1846!end if
1847!
1848!if (associated(this%var))then
1849! nvar=size(this%var)
1850! allocate(varbufr(nvar),stat=stallo)
1851! if (stallo /=0)then
1852! call l4f_log(L4F_FATAL,"allocating memory")
1853! call raise_fatal_error("allocating memory")
1854! end if
1855!
1856! CALL vargrib2varbufr(this%var, varbufr)
1857!ELSE
1858! CALL l4f_category_log(this%category, L4F_ERROR, &
1859! "trying to destagger an incomplete volgrid6d object")
1860! CALL raise_error()
1861! RETURN
1862!end if
1863!
1864!nvaru=COUNT(varbufr==varu)
1865!nvarv=COUNT(varbufr==varv)
1866!
1867!if (nvaru > 1 )then
1868! call l4f_category_log(this%category,L4F_WARN, &
1869! ">1 variables refer to u wind component, destaggering will not be done ")
1870! DEALLOCATE(varbufr)
1871! RETURN
1872!endif
1873!
1874!if (nvarv > 1 )then
1875! call l4f_category_log(this%category,L4F_WARN, &
1876! ">1 variables refer to v wind component, destaggering will not be done ")
1877! DEALLOCATE(varbufr)
1878! RETURN
1879!endif
1880!
1881!if (nvaru == 0 .and. nvarv == 0) then
1882! call l4f_category_log(this%category,L4F_WARN, &
1883! "no u or v wind component found in volume, nothing to do")
1884! DEALLOCATE(varbufr)
1885! RETURN
1886!endif
1887!
1888!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
1889! call l4f_category_log(this%category,L4F_WARN, &
1890! "there are variables different from u and v wind component in C grid")
1891!endif
1892
1893
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 |