libsim Versione 7.2.1

◆ map_inv_distinct_var6d()

integer function, dimension(dim) map_inv_distinct_var6d ( type(volgrid6d_var), dimension(:), intent(in) vect,
integer, intent(in) dim,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back )
private

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
942USE kinds
944USE err_handling
948
949IMPLICIT NONE
950
955TYPE volgrid6d_var
956 integer :: centre
957 integer :: category
958 integer :: number
959 integer :: discipline
960 CHARACTER(len=65) :: description
961 CHARACTER(len=24) :: unit
962END TYPE volgrid6d_var
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) = (/ &
968 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
969 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
970 /)
971
972TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
973 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
974 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
975 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
976 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
977/)
978!/), (/2,2/)) ! bug in gfortran
979
988TYPE conv_func
989 PRIVATE
990 REAL :: a, b
991END TYPE conv_func
992
993TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
994TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
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
1021INTERFACE init
1022 MODULE PROCEDURE volgrid6d_var_init
1023END INTERFACE
1024
1027INTERFACE delete
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
1057INTERFACE display
1058 MODULE PROCEDURE display_volgrid6d_var
1059END INTERFACE
1060
1065INTERFACE OPERATOR (*)
1066 MODULE PROCEDURE conv_func_mult
1067END INTERFACE OPERATOR (*)
1068
1071INTERFACE compute
1072 MODULE PROCEDURE conv_func_compute
1073END INTERFACE
1074
1077INTERFACE convert
1078 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1079 conv_func_convert
1080END INTERFACE
1081
1082PRIVATE
1083PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
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, &
1088 index, display, &
1089 vargrib2varbufr, varbufr2vargrib, &
1090 conv_func, conv_func_miss, compute, convert, &
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
1108CALL init(this, centre, category, number, discipline, description, unit)
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
1563 CALL init(csv, 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
1567 CALL init(conv_type(i)%v7d_var, btable=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)
1573 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
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)
1578 CALL delete(csv)
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
1654CALL compute(this, convert)
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
1808END MODULE volgrid6d_var_class
Index method.
Apply the conversion function this to values.
Apply the conversion function this to values.
Destructor for the corresponding object, it assigns it to a missing value.
Display on the screen a brief content of object.
Initialize a volgrid6d_var object with the optional arguments provided.
Gestione degli errori.
Utilities for managing files.
This module defines an abstract interface to different drivers for access to files containing gridded...
Definition of constants to be used for declaring variables of a desired type.
Definition kinds.F90:245
Definitions of constants and functions for working with missing values.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Class for managing physical variables in a grib 1/2 fashion.
Definisce una variabile meteorologica osservata o un suo attributo.
Class defining a real conversion function between units.
Definition of a physical variable in grib coding style.

Generated with Doxygen.