libsim Versione 7.1.11
|
◆ map_inv_distinct_var6d()
map inv distinct Definizione alla linea 916 del file volgrid6d_var_class.F90. 918! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
919! authors:
920! Davide Cesari <dcesari@arpa.emr.it>
921! Paolo Patruno <ppatruno@arpa.emr.it>
922
923! This program is free software; you can redistribute it and/or
924! modify it under the terms of the GNU General Public License as
925! published by the Free Software Foundation; either version 2 of
926! the License, or (at your option) any later version.
927
928! This program is distributed in the hope that it will be useful,
929! but WITHOUT ANY WARRANTY; without even the implied warranty of
930! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
931! GNU General Public License for more details.
932
933! You should have received a copy of the GNU General Public License
934! along with this program. If not, see <http://www.gnu.org/licenses/>.
935#include "config.h"
936
954
955IMPLICIT NONE
956
962 integer :: centre
963 integer :: category
964 integer :: number
965 integer :: discipline
966 CHARACTER(len=65) :: description
967 CHARACTER(len=24) :: unit
969
970TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
971 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
972
973TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
976 /)
977
978TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
983/)
984!/), (/2,2/)) ! bug in gfortran
985
995 PRIVATE
996 REAL :: a, b
998
1001
1002TYPE vg6d_v7d_var_conv
1003 TYPE(volgrid6d_var) :: vg6d_var
1004 TYPE(vol7d_var) :: v7d_var
1005 TYPE(conv_func) :: c_func
1006! aggiungere informazioni ad es. su rotazione del vento
1007END TYPE vg6d_v7d_var_conv
1008
1009TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1010 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1011
1012TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1013
1028 MODULE PROCEDURE volgrid6d_var_init
1029END INTERFACE
1030
1034 MODULE PROCEDURE volgrid6d_var_delete
1035END INTERFACE
1036
1037INTERFACE c_e
1038 MODULE PROCEDURE volgrid6d_var_c_e
1039END INTERFACE
1040
1041
1046INTERFACE OPERATOR (==)
1047 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1048END INTERFACE
1049
1054INTERFACE OPERATOR (/=)
1055 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1056END INTERFACE
1057
1058#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1059#define VOL7D_POLY_TYPES _var6d
1060#include "array_utilities_pre.F90"
1061
1064 MODULE PROCEDURE display_volgrid6d_var
1065END INTERFACE
1066
1071INTERFACE OPERATOR (*)
1072 MODULE PROCEDURE conv_func_mult
1073END INTERFACE OPERATOR (*)
1074
1078 MODULE PROCEDURE conv_func_compute
1079END INTERFACE
1080
1084 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1085 conv_func_convert
1086END INTERFACE
1087
1088PRIVATE
1090 c_e, volgrid6d_var_normalize, &
1091 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1092 count_distinct, pack_distinct, count_and_pack_distinct, &
1093 map_distinct, map_inv_distinct, &
1095 vargrib2varbufr, varbufr2vargrib, &
1097 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1098
1099
1100CONTAINS
1101
1102
1103ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1104 discipline, description, unit) RESULT(this)
1105integer,INTENT(in),OPTIONAL :: centre
1106integer,INTENT(in),OPTIONAL :: category
1107integer,INTENT(in),OPTIONAL :: number
1108integer,INTENT(in),OPTIONAL :: discipline
1109CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1110CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1111
1112TYPE(volgrid6d_var) :: this
1113
1115
1116END FUNCTION volgrid6d_var_new
1117
1118
1119! documented in the interface
1120ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1121TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1122INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1123INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1124INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1125INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1126CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1127CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1128
1129IF (PRESENT(centre)) THEN
1130 this%centre = centre
1131ELSE
1132 this%centre = imiss
1133 this%category = imiss
1134 this%number = imiss
1135 this%discipline = imiss
1136 RETURN
1137ENDIF
1138
1139IF (PRESENT(category)) THEN
1140 this%category = category
1141ELSE
1142 this%category = imiss
1143 this%number = imiss
1144 this%discipline = imiss
1145 RETURN
1146ENDIF
1147
1148
1149IF (PRESENT(number)) THEN
1150 this%number = number
1151ELSE
1152 this%number = imiss
1153 this%discipline = imiss
1154 RETURN
1155ENDIF
1156
1157! se sono arrivato fino a qui ho impostato centre, category e number
1158!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1159
1160IF (PRESENT(discipline)) THEN
1161 this%discipline = discipline
1162ELSE
1163 this%discipline = 255
1164ENDIF
1165
1166IF (PRESENT(description)) THEN
1167 this%description = description
1168ELSE
1169 this%description = cmiss
1170ENDIF
1171
1172IF (PRESENT(unit)) THEN
1173 this%unit = unit
1174ELSE
1175 this%unit = cmiss
1176ENDIF
1177
1178
1179
1180END SUBROUTINE volgrid6d_var_init
1181
1182
1183! documented in the interface
1184SUBROUTINE volgrid6d_var_delete(this)
1185TYPE(volgrid6d_var),INTENT(INOUT) :: this
1186
1187this%centre = imiss
1188this%category = imiss
1189this%number = imiss
1190this%discipline = imiss
1191this%description = cmiss
1192this%unit = cmiss
1193
1194END SUBROUTINE volgrid6d_var_delete
1195
1196
1197ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1198TYPE(volgrid6d_var),INTENT(IN) :: this
1199LOGICAL :: c_e
1200c_e = this /= volgrid6d_var_miss
1201END FUNCTION volgrid6d_var_c_e
1202
1203
1204ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1205TYPE(volgrid6d_var),INTENT(IN) :: this, that
1206LOGICAL :: res
1207
1208IF (this%discipline == that%discipline) THEN
1209
1210 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1211 res = ((this%category == that%category) .OR. &
1212 (this%category >= 1 .AND. this%category <=3 .AND. &
1213 that%category >= 1 .AND. that%category <=3)) .AND. &
1214 this%number == that%number
1215
1216 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1217 (this%number >= 128 .AND. this%number <= 254)) THEN
1218 res = res .AND. this%centre == that%centre ! local definition, centre matters
1219 ENDIF
1220
1221 ELSE ! grib2
1222 res = this%category == that%category .AND. &
1223 this%number == that%number
1224
1225 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1226 (this%category >= 192 .AND. this%category <= 254) .OR. &
1227 (this%number >= 192 .AND. this%number <= 254)) THEN
1228 res = res .AND. this%centre == that%centre ! local definition, centre matters
1229 ENDIF
1230 ENDIF
1231
1232ELSE ! different edition or different discipline
1233 res = .false.
1234ENDIF
1235
1236END FUNCTION volgrid6d_var_eq
1237
1238
1239ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1240TYPE(volgrid6d_var),INTENT(IN) :: this, that
1241LOGICAL :: res
1242
1243res = .NOT.(this == that)
1244
1245END FUNCTION volgrid6d_var_ne
1246
1247
1248#include "array_utilities_inc.F90"
1249
1250
1252SUBROUTINE display_volgrid6d_var(this)
1253TYPE(volgrid6d_var),INTENT(in) :: this
1254
1255print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1256
1257END SUBROUTINE display_volgrid6d_var
1258
1259
1272SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1273TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
1274TYPE(vol7d_var),INTENT(out) :: varbufr(:)
1275TYPE(conv_func),POINTER :: c_func(:)
1276
1277INTEGER :: i, n, stallo
1278
1279n = min(SIZE(varbufr), SIZE(vargrib))
1280ALLOCATE(c_func(n),stat=stallo)
1281IF (stallo /= 0) THEN
1282 call l4f_log(l4f_fatal,"allocating memory")
1283 call raise_fatal_error()
1284ENDIF
1285
1286DO i = 1, n
1287 varbufr(i) = convert(vargrib(i), c_func(i))
1288ENDDO
1289
1290END SUBROUTINE vargrib2varbufr
1291
1292
1303FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1304TYPE(volgrid6d_var),INTENT(in) :: vargrib
1305TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1306TYPE(vol7d_var) :: convert
1307
1308INTEGER :: i
1309
1310IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1311
1312DO i = 1, SIZE(conv_fwd)
1313 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1314 convert = conv_fwd(i)%v7d_var
1315 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1316 RETURN
1317 ENDIF
1318ENDDO
1319! not found
1320convert = vol7d_var_miss
1321IF (PRESENT(c_func)) c_func = conv_func_miss
1322
1323! set hint for backwards conversion
1324convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1325 vargrib%discipline/)
1326
1327CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1328 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1329 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1330 ' not found in table')
1331
1332END FUNCTION vargrib2varbufr_convert
1333
1334
1350SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1351TYPE(vol7d_var),INTENT(in) :: varbufr(:)
1352TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
1353TYPE(conv_func),POINTER :: c_func(:)
1354TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1355
1356INTEGER :: i, n, stallo
1357
1358n = min(SIZE(varbufr), SIZE(vargrib))
1359ALLOCATE(c_func(n),stat=stallo)
1360IF (stallo /= 0) THEN
1361 CALL l4f_log(l4f_fatal,"allocating memory")
1362 CALL raise_fatal_error()
1363ENDIF
1364
1365DO i = 1, n
1366 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1367ENDDO
1368
1369END SUBROUTINE varbufr2vargrib
1370
1371
1385FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1386TYPE(vol7d_var),INTENT(in) :: varbufr
1387TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
1388TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
1389TYPE(volgrid6d_var) :: convert
1390
1391INTEGER :: i
1392#ifdef HAVE_LIBGRIBAPI
1393INTEGER :: gaid, editionnumber, category, centre
1394#endif
1395
1396IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1397
1398#ifdef HAVE_LIBGRIBAPI
1399editionnumber=255; category=255; centre=255
1400#endif
1401IF (PRESENT(grid_id_template)) THEN
1402#ifdef HAVE_LIBGRIBAPI
1403 gaid = grid_id_get_gaid(grid_id_template)
1404 IF (c_e(gaid)) THEN
1405 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1406 IF (editionnumber == 1) THEN
1407 CALL grib_get(gaid,'gribTablesVersionNo',category)
1408 ENDIF
1409 CALL grib_get(gaid,'centre',centre)
1410 ENDIF
1411#endif
1412ENDIF
1413
1414DO i = 1, SIZE(conv_bwd)
1415 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1416#ifdef HAVE_LIBGRIBAPI
1417 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1418 IF (editionnumber == 1) THEN
1419 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1420 ELSE IF (editionnumber == 2) THEN
1421 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1422 ENDIF
1423 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1424 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1425 ENDIF
1426#endif
1427 convert = conv_bwd(i)%vg6d_var
1428 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1429 RETURN
1430 ENDIF
1431ENDDO
1432! not found
1433convert = volgrid6d_var_miss
1434IF (PRESENT(c_func)) c_func = conv_func_miss
1435
1436! if hint available use it as a fallback
1437IF (any(varbufr%gribhint /= imiss)) THEN
1438 convert%centre = varbufr%gribhint(1)
1439 convert%category = varbufr%gribhint(2)
1440 convert%number = varbufr%gribhint(3)
1441 convert%discipline = varbufr%gribhint(4)
1442ENDIF
1443
1444CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1445 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1446 ' not found in table')
1447
1448END FUNCTION varbufr2vargrib_convert
1449
1450
1458SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1459TYPE(volgrid6d_var),INTENT(inout) :: this
1460TYPE(conv_func),INTENT(out) :: c_func
1461TYPE(grid_id),INTENT(in) :: grid_id_template
1462
1463LOGICAL :: eqed, eqcentre
1464INTEGER :: gaid, editionnumber, centre
1465TYPE(volgrid6d_var) :: tmpgrib
1466TYPE(vol7d_var) :: tmpbufr
1467TYPE(conv_func) tmpc_func1, tmpc_func2
1468
1469eqed = .true.
1470eqcentre = .true.
1471c_func = conv_func_miss
1472
1473#ifdef HAVE_LIBGRIBAPI
1474gaid = grid_id_get_gaid(grid_id_template)
1475IF (c_e(gaid)) THEN
1476 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1477 CALL grib_get(gaid, 'centre', centre)
1478 eqed = editionnumber == 1 .EQV. this%discipline == 255
1479 eqcentre = centre == this%centre
1480ENDIF
1481#endif
1482
1483IF (eqed .AND. eqcentre) RETURN ! nothing to do
1484
1485tmpbufr = convert(this, tmpc_func1)
1486tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1487
1488IF (tmpgrib /= volgrid6d_var_miss) THEN
1489! conversion back and forth successful, set also conversion function
1490 this = tmpgrib
1491 c_func = tmpc_func1 * tmpc_func2
1492! set to missing in common case to avoid useless computation
1493 IF (c_func == conv_func_identity) c_func = conv_func_miss
1494ELSE IF (.NOT.eqed) THEN
1495! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1496 this = tmpgrib
1497ENDIF
1498
1499END SUBROUTINE volgrid6d_var_normalize
1500
1501
1502! Private subroutine for reading forward and backward conversion tables
1503! todo: better error handling
1504SUBROUTINE vg6d_v7d_var_conv_setup()
1505INTEGER :: un, i, n, stallo
1506
1507! forward, grib to bufr
1508un = open_package_file('vargrib2bufr.csv', filetype_data)
1509n=0
1510DO WHILE(.true.)
1511 READ(un,*,END=100)
1512 n = n + 1
1513ENDDO
1514
1515100 CONTINUE
1516
1517rewind(un)
1518ALLOCATE(conv_fwd(n),stat=stallo)
1519IF (stallo /= 0) THEN
1520 CALL l4f_log(l4f_fatal,"allocating memory")
1521 CALL raise_fatal_error()
1522ENDIF
1523
1524conv_fwd(:) = vg6d_v7d_var_conv_miss
1525CALL import_var_conv(un, conv_fwd)
1526CLOSE(un)
1527
1528! backward, bufr to grib
1529un = open_package_file('vargrib2bufr.csv', filetype_data)
1530! use the same file for now
1531!un = open_package_file('varbufr2grib.csv', filetype_data)
1532n=0
1533DO WHILE(.true.)
1534 READ(un,*,END=300)
1535 n = n + 1
1536ENDDO
1537
1538300 CONTINUE
1539
1540rewind(un)
1541ALLOCATE(conv_bwd(n),stat=stallo)
1542IF (stallo /= 0) THEN
1543 CALL l4f_log(l4f_fatal,"allocating memory")
1544 CALL raise_fatal_error()
1545end if
1546
1547conv_bwd(:) = vg6d_v7d_var_conv_miss
1548CALL import_var_conv(un, conv_bwd)
1549DO i = 1, n
1550 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1551 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1552ENDDO
1553CLOSE(un)
1554
1555CONTAINS
1556
1557SUBROUTINE import_var_conv(un, conv_type)
1558INTEGER, INTENT(in) :: un
1559TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1560
1561INTEGER :: i
1562TYPE(csv_record) :: csv
1563CHARACTER(len=1024) :: line
1564CHARACTER(len=10) :: btable
1565INTEGER :: centre, category, number, discipline
1566
1567DO i = 1, SIZE(conv_type)
1568 READ(un,'(A)',END=200)line
1570 CALL csv_record_getfield(csv, btable)
1571 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1572 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1574
1575 CALL csv_record_getfield(csv, centre)
1576 CALL csv_record_getfield(csv, category)
1577 CALL csv_record_getfield(csv, number)
1578 CALL csv_record_getfield(csv, discipline)
1580 number=number, discipline=discipline) ! controllare l'ordine
1581
1582 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1583 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1585ENDDO
1586
1587200 CONTINUE
1588
1589END SUBROUTINE import_var_conv
1590
1591END SUBROUTINE vg6d_v7d_var_conv_setup
1592
1593
1594ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1595TYPE(conv_func),INTENT(IN) :: this, that
1596LOGICAL :: res
1597
1598res = this%a == that%a .AND. this%b == that%b
1599
1600END FUNCTION conv_func_eq
1601
1602
1603ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1604TYPE(conv_func),INTENT(IN) :: this, that
1605LOGICAL :: res
1606
1607res = .NOT.(this == that)
1608
1609END FUNCTION conv_func_ne
1610
1611
1612FUNCTION conv_func_mult(this, that) RESULT(mult)
1613TYPE(conv_func),INTENT(in) :: this
1614TYPE(conv_func),INTENT(in) :: that
1615
1616TYPE(conv_func) :: mult
1617
1618IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1619 mult = conv_func_miss
1620ELSE
1621 mult%a = this%a*that%a
1622 mult%b = this%a*that%b+this%b
1623ENDIF
1624
1625END FUNCTION conv_func_mult
1626
1634ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1635TYPE(conv_func),INTENT(in) :: this
1636REAL,INTENT(inout) :: values
1637
1638IF (this /= conv_func_miss) THEN
1639 IF (c_e(values)) values = values*this%a + this%b
1640ELSE
1641 values=rmiss
1642ENDIF
1643
1644END SUBROUTINE conv_func_compute
1645
1646
1654ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1655TYPE(conv_func),intent(in) :: this
1656REAL,INTENT(in) :: values
1657REAL :: convert
1658
1659convert = values
1661
1662END FUNCTION conv_func_convert
1663
1664
1678SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1679TYPE(volgrid6d_var),INTENT(in) :: this(:)
1680INTEGER,POINTER :: xind(:), yind(:)
1681
1682TYPE(vol7d_var) :: varbufr(SIZE(this))
1683TYPE(conv_func),POINTER :: c_func(:)
1684INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1685
1686NULLIFY(xind, yind)
1687counts(:) = 0
1688
1689CALL vargrib2varbufr(this, varbufr, c_func)
1690
1691DO i = 1, SIZE(vol7d_var_horcomp)
1692 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1693ENDDO
1694
1695IF (any(counts(1::2) > 1)) THEN
1696 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1697 DEALLOCATE(c_func)
1698 RETURN
1699ENDIF
1700IF (any(counts(2::2) > 1)) THEN
1701 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1702 DEALLOCATE(c_func)
1703 RETURN
1704ENDIF
1705
1706! check that variables are paired and count pairs
1707nv = 0
1708DO i = 1, SIZE(vol7d_var_horcomp), 2
1709 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
1710 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
1711 ' present but the corresponding x-component '// &
1712 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
1713 RETURN
1714 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
1715 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
1716 ' present but the corresponding y-component '// &
1717 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
1718 RETURN
1719 ENDIF
1720 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
1721ENDDO
1722
1723! repeat the loop storing indices
1724ALLOCATE(xind(nv), yind(nv))
1725nv = 0
1726DO i = 1, SIZE(vol7d_var_horcomp), 2
1727 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
1728 nv = nv + 1
1729 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
1730 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
1731 ENDIF
1732ENDDO
1733DEALLOCATE(c_func)
1734
1735END SUBROUTINE volgrid6d_var_hor_comp_index
1736
1737
1742FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
1743TYPE(volgrid6d_var),INTENT(in) :: this
1744LOGICAL :: is_hor_comp
1745
1746TYPE(vol7d_var) :: varbufr
1747
1748varbufr = convert(this)
1749is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
1750
1751END FUNCTION volgrid6d_var_is_hor_comp
1752
1753! before unstaggering??
1754
1755!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1756!
1757!call init(varu,btable="B11003")
1758!call init(varv,btable="B11004")
1759!
1760! test about presence of u and v in standard table
1761!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
1762! call l4f_category_log(this%category,L4F_FATAL, &
1763! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
1764! CALL raise_error()
1765! RETURN
1766!end if
1767!
1768!if (associated(this%var))then
1769! nvar=size(this%var)
1770! allocate(varbufr(nvar),stat=stallo)
1771! if (stallo /=0)then
1772! call l4f_log(L4F_FATAL,"allocating memory")
1773! call raise_fatal_error("allocating memory")
1774! end if
1775!
1776! CALL vargrib2varbufr(this%var, varbufr)
1777!ELSE
1778! CALL l4f_category_log(this%category, L4F_ERROR, &
1779! "trying to destagger an incomplete volgrid6d object")
1780! CALL raise_error()
1781! RETURN
1782!end if
1783!
1784!nvaru=COUNT(varbufr==varu)
1785!nvarv=COUNT(varbufr==varv)
1786!
1787!if (nvaru > 1 )then
1788! call l4f_category_log(this%category,L4F_WARN, &
1789! ">1 variables refer to u wind component, destaggering will not be done ")
1790! DEALLOCATE(varbufr)
1791! RETURN
1792!endif
1793!
1794!if (nvarv > 1 )then
1795! call l4f_category_log(this%category,L4F_WARN, &
1796! ">1 variables refer to v wind component, destaggering will not be done ")
1797! DEALLOCATE(varbufr)
1798! RETURN
1799!endif
1800!
1801!if (nvaru == 0 .and. nvarv == 0) then
1802! call l4f_category_log(this%category,L4F_WARN, &
1803! "no u or v wind component found in volume, nothing to do")
1804! DEALLOCATE(varbufr)
1805! RETURN
1806!endif
1807!
1808!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
1809! call l4f_category_log(this%category,L4F_WARN, &
1810! "there are variables different from u and v wind component in C grid")
1811!endif
1812
1813
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 |