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