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