libsim Versione 7.2.1

◆ volgrid6d_compute_stat_proc_metamorph()

subroutine volgrid6d_compute_stat_proc_metamorph ( type(volgrid6d), intent(inout)  this,
type(volgrid6d), intent(out)  that,
integer, intent(in)  stat_proc_input,
integer, intent(in)  stat_proc,
logical, intent(in), optional  clone 
)

Specialized method for statistically processing a set of data by integration/differentiation.

This method performs statistical processing by integrating (accumulating) in time values representing time-average rates or fluxes, (stat_proc_input=0 stat_proc=1) or by transforming a time-integrated (accumulated) value in a time-average rate or flux (stat_proc_input=1 stat_proc=0). Analysis/observation or forecast timeranges are processed. The only operation performed is respectively multiplying or dividing the values by the length of the time interval in seconds.

The output that volgrid6d object contains elements from the original volume this satisfying the conditions

Output data will have timerange of type stat_proc (1 or 0) and p1 and p2 equal to the corresponding input values. The supported statistical processing methods (parameter stat_proc) are:

  • 0 average
  • 1 accumulation

Input volume may have any value of thistime_definition, and that value will be conserved in the output volume.

Parametri
[in,out]thisvolume providing data to be recomputed, it is not modified by the method, apart from performing a volgrid6d_alloc_vol on it
[out]thatoutput volume which will contain the recomputed data
[in]stat_proc_inputtype of statistical processing of data that has to be processed (from grib2 table), only data having timerange of this type will be processed, the actual statistical processing performed and which will appear in the output volume, is however determined by stat_proc argument
[in]stat_proctype of statistical processing to be recomputed (from grib2 table), data in output volume that will have a timerange of this type
[in]cloneif provided and .TRUE. , clone the gaid's from this to that

Definizione alla linea 946 del file volgrid6d_class_compute.F90.

947! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
948! authors:
949! Davide Cesari <dcesari@arpa.emr.it>
950! Paolo Patruno <ppatruno@arpa.emr.it>
951
952! This program is free software; you can redistribute it and/or
953! modify it under the terms of the GNU General Public License as
954! published by the Free Software Foundation; either version 2 of
955! the License, or (at your option) any later version.
956
957! This program is distributed in the hope that it will be useful,
958! but WITHOUT ANY WARRANTY; without even the implied warranty of
959! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
960! GNU General Public License for more details.
961
962! You should have received a copy of the GNU General Public License
963! along with this program. If not, see <http://www.gnu.org/licenses/>.
964#include "config.h"
965
978USE simple_stat
979IMPLICIT NONE
980
981CONTAINS
982
1048SUBROUTINE volgrid6d_compute_stat_proc(this, that, stat_proc_input, stat_proc, &
1049 step, start, full_steps, frac_valid, max_step, weighted, clone)
1050TYPE(volgrid6d),INTENT(inout) :: this
1051TYPE(volgrid6d),INTENT(out) :: that
1052INTEGER,INTENT(in) :: stat_proc_input
1053INTEGER,INTENT(in) :: stat_proc
1054TYPE(timedelta),INTENT(in) :: step
1055TYPE(datetime),INTENT(in),OPTIONAL :: start
1056LOGICAL,INTENT(in),OPTIONAL :: full_steps
1057REAL,INTENT(in),OPTIONAL :: frac_valid
1058TYPE(timedelta),INTENT(in),OPTIONAL :: max_step ! maximum allowed distance in time between two single valid data within a dataset, for the dataset to be eligible for statistical processing
1059LOGICAL,INTENT(in),OPTIONAL :: weighted
1060LOGICAL , INTENT(in),OPTIONAL :: clone
1061
1062INTEGER :: dtmax, dtstep
1063
1064
1065IF (stat_proc_input == 254) THEN
1066 CALL l4f_category_log(this%category, l4f_info, &
1067 'computing statistical processing by aggregation '//&
1068 trim(to_char(stat_proc_input))//':'//trim(to_char(stat_proc)))
1069
1070 CALL volgrid6d_compute_stat_proc_agg(this, that, stat_proc, &
1071 step, start, full_steps, max_step, clone)
1072
1073ELSE IF (stat_proc == 254) THEN
1074 CALL l4f_category_log(this%category, l4f_error, &
1075 'statistical processing to instantaneous data not implemented for gridded fields')
1076 CALL raise_error()
1077
1078ELSE IF (stat_proc_input == stat_proc .OR. &
1079 (stat_proc == 0 .OR. stat_proc == 2 .OR. stat_proc == 3)) THEN
1080! avg, min and max can be computed from any input, with care
1081
1082 IF (count(this%timerange(:)%timerange == stat_proc_input) == 0) THEN
1083 CALL l4f_category_log(this%category, l4f_warn, &
1084 'no timeranges of the desired statistical processing type '//t2c(stat_proc)//' available')
1085! return an empty volume, without signaling error
1086 CALL init(that)
1087 CALL volgrid6d_alloc_vol(that)
1088
1089 ELSE
1090! euristically determine whether aggregation or difference is more suitable
1091 dtmax = maxval(this%timerange(:)%p2, &
1092 mask=(this%timerange(:)%timerange == stat_proc))
1093 CALL getval(step, asec=dtstep)
1094
1095#ifdef DEBUG
1096 CALL l4f_category_log(this%category, l4f_debug, &
1097 'stat_proc='//t2c(stat_proc)//' dtmax='//t2c(dtmax)//' dtstep='//t2c(dtstep))
1098#endif
1099
1100 IF (dtstep <= dtmax) THEN
1101 CALL l4f_category_log(this%category, l4f_info, &
1102 'recomputing statistically processed data by difference '// &
1103 t2c(stat_proc_input)//':'//t2c(stat_proc))
1104 CALL volgrid6d_recompute_stat_proc_diff(this, that, stat_proc, step, &
1105 full_steps, start, clone)
1106 ELSE
1107 CALL l4f_category_log(this%category, l4f_info, &
1108 'recomputing statistically processed data by aggregation '// &
1109 t2c(stat_proc_input)//':'//t2c(stat_proc))
1110 CALL volgrid6d_recompute_stat_proc_agg(this, that, stat_proc, step, start, &
1111 full_steps, frac_valid, clone, stat_proc_input)
1112 ENDIF
1113 ENDIF
1114
1115ELSE ! IF (stat_proc_input /= stat_proc) THEN
1116 IF ((stat_proc_input == 0 .AND. stat_proc == 1) .OR. &
1117 (stat_proc_input == 1 .AND. stat_proc == 0)) THEN
1118 CALL l4f_category_log(this%category, l4f_info, &
1119 'computing statistically processed data by integration/differentiation '// &
1120 t2c(stat_proc_input)//':'//t2c(stat_proc))
1121 CALL volgrid6d_compute_stat_proc_metamorph(this, that, stat_proc_input, &
1122 stat_proc, clone)
1123 ELSE
1124 CALL l4f_category_log(this%category, l4f_error, &
1125 'statistical processing '//t2c(stat_proc_input)//':'//t2c(stat_proc)// &
1126 ' not implemented or does not make sense')
1127 CALL raise_error()
1128 ENDIF
1129
1130ENDIF
1131
1132END SUBROUTINE volgrid6d_compute_stat_proc
1133
1134
1177SUBROUTINE volgrid6d_recompute_stat_proc_agg(this, that, stat_proc, &
1178 step, start, full_steps, frac_valid, clone, stat_proc_input)
1179TYPE(volgrid6d),INTENT(inout) :: this
1180TYPE(volgrid6d),INTENT(out) :: that
1181INTEGER,INTENT(in) :: stat_proc
1182TYPE(timedelta),INTENT(in) :: step
1183TYPE(datetime),INTENT(in),OPTIONAL :: start
1184LOGICAL,INTENT(in),OPTIONAL :: full_steps
1185REAL,INTENT(in),OPTIONAL :: frac_valid
1186LOGICAL, INTENT(in),OPTIONAL :: clone
1187INTEGER,INTENT(in),OPTIONAL :: stat_proc_input
1188
1189INTEGER :: tri
1190INTEGER i, j, n, n1, ndtr, i3, i6
1191TYPE(arrayof_ttr_mapper),POINTER :: map_ttr(:,:)
1192INTEGER,POINTER :: dtratio(:)
1193REAL :: lfrac_valid
1194LOGICAL :: lclone
1195REAL,POINTER :: voldatiin(:,:), voldatiout(:,:)
1196
1197
1198NULLIFY(voldatiin, voldatiout)
1199IF (PRESENT(stat_proc_input)) THEN
1200 tri = stat_proc_input
1201ELSE
1202 tri = stat_proc
1203ENDIF
1204IF (PRESENT(frac_valid)) THEN
1205 lfrac_valid = frac_valid
1206ELSE
1207 lfrac_valid = 1.0
1208ENDIF
1209
1210CALL init(that)
1211! be safe
1212CALL volgrid6d_alloc_vol(this)
1213
1214! when volume is not decoded it is better to clone anyway to avoid
1215! overwriting fields
1216lclone = optio_log(clone) .OR. .NOT.ASSOCIATED(this%voldati)
1217! initialise the output volume
1218CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
1219CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntimerange=1, &
1220 nlevel=SIZE(this%level), nvar=SIZE(this%var), ini=.false.)
1221that%level = this%level
1222that%var = this%var
1223
1224CALL recompute_stat_proc_agg_common(this%time, this%timerange, stat_proc, tri, &
1225 step, this%time_definition, that%time, that%timerange, map_ttr, &
1226 dtratio=dtratio, start=start, full_steps=full_steps)
1227
1228CALL volgrid6d_alloc_vol(that, decode=ASSOCIATED(this%voldati))
1229
1230do_otimerange: DO j = 1, SIZE(that%timerange)
1231 do_otime: DO i = 1, SIZE(that%time)
1232
1233 DO n1 = 1, SIZE(dtratio)
1234 IF (dtratio(n1) <= 0) cycle ! safety check
1235
1236 DO i6 = 1, SIZE(this%var)
1237 DO i3 = 1, SIZE(this%level)
1238 CALL volgrid_get_vol_2d(that, i3, i, j, i6, voldatiout)
1239 ndtr = 0
1240 DO n = 1, map_ttr(i,j)%arraysize
1241 IF (map_ttr(i,j)%array(n)%extra_info == dtratio(n1)) THEN
1242 ndtr = ndtr + 1
1243 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(n)%it, &
1244 map_ttr(i,j)%array(n)%itr, i6, voldatiin)
1245
1246 IF (ndtr == 1) THEN
1247 voldatiout = voldatiin
1248 IF (lclone) THEN
1249 CALL copy(this%gaid(i3, map_ttr(i,j)%array(n)%it,&
1250 map_ttr(i,j)%array(n)%itr,i6), that%gaid(i3,i,j,i6))
1251 ELSE
1252 that%gaid(i3,i,j,i6) = this%gaid(i3, map_ttr(i,j)%array(n)%it, &
1253 map_ttr(i,j)%array(n)%itr,i6)
1254 ENDIF
1255
1256 ELSE ! second or more time
1257 SELECT CASE(stat_proc)
1258 CASE (0, 200, 1, 4) ! average, vectorial mean, accumulation, difference
1259 WHERE(c_e(voldatiin(:,:)) .AND. c_e(voldatiout(:,:)))
1260 voldatiout(:,:) = voldatiout(:,:) + voldatiin(:,:)
1261 ELSEWHERE
1262 voldatiout(:,:) = rmiss
1263 END WHERE
1264 CASE(2) ! maximum
1265 WHERE(c_e(voldatiin(:,:)) .AND. c_e(voldatiout(:,:)))
1266 voldatiout(:,:) = max(voldatiout(:,:), voldatiin(:,:))
1267 ELSEWHERE
1268 voldatiout(:,:) = rmiss
1269 END WHERE
1270 CASE(3) ! minimum
1271 WHERE(c_e(voldatiin(:,:)) .AND. c_e(voldatiout(:,:)))
1272 voldatiout(:,:) = min(voldatiout(:,:), voldatiin(:,:))
1273 ELSEWHERE
1274 voldatiout(:,:) = rmiss
1275 END WHERE
1276 END SELECT
1277
1278 ENDIF ! first time
1279 ENDIF ! dtratio(n1)
1280 ENDDO ! ttr
1281
1282#ifdef DEBUG
1283 CALL l4f_log(l4f_debug, &
1284 'compute_stat_proc_agg, ndtr/dtratio/frac_valid: '// &
1285 t2c(ndtr)//'/'//t2c(dtratio(n1))//'/'//t2c(lfrac_valid))
1286#endif
1287 IF (ndtr > 0) THEN ! why this condition was not here before?
1288 IF (real(ndtr)/real(dtratio(n1)) >= lfrac_valid) THEN ! success
1289 IF (stat_proc == 0) THEN ! average
1290 WHERE(c_e(voldatiout(:,:)))
1291 voldatiout(:,:) = voldatiout(:,:)/ndtr
1292 END WHERE
1293 ENDIF
1294 CALL volgrid_set_vol_2d(that, i3, i, j, i6, voldatiout)
1295#ifdef DEBUG
1296 CALL l4f_log(l4f_debug, &
1297 'compute_stat_proc_agg, coding lev/t/tr/var: '// &
1298 t2c(i3)//'/'//t2c(i)//'/'//t2c(j)//'/'//t2c(i6))
1299#endif
1300 ELSE
1301! must nullify the output gaid here, otherwise an incomplete field will be output
1302 IF (lclone) THEN
1303 CALL delete(that%gaid(i3,i,j,i6))
1304 ELSE
1305 CALL init(that%gaid(i3,i,j,i6)) ! grid_id lacks a nullify method
1306 ENDIF
1307#ifdef DEBUG
1308 CALL l4f_log(l4f_debug, &
1309 'compute_stat_proc_agg, skipping lev/t/tr/var: '// &
1310 t2c(i3)//'/'//t2c(i)//'/'//t2c(j)//'/'//t2c(i6))
1311#endif
1312 ENDIF
1313 ENDIF ! ndtr > 0
1314
1315 ENDDO ! level
1316 ENDDO ! var
1317 ENDDO ! dtratio
1318 CALL delete(map_ttr(i,j))
1319 ENDDO do_otime
1320ENDDO do_otimerange
1321
1322DEALLOCATE(dtratio, map_ttr)
1323
1324END SUBROUTINE volgrid6d_recompute_stat_proc_agg
1325
1326
1350SUBROUTINE volgrid6d_compute_stat_proc_agg(this, that, stat_proc, &
1351 step, start, full_steps, max_step, clone)
1352TYPE(volgrid6d),INTENT(inout) :: this
1353TYPE(volgrid6d),INTENT(out) :: that
1354INTEGER,INTENT(in) :: stat_proc
1355TYPE(timedelta),INTENT(in) :: step
1356TYPE(datetime),INTENT(in),OPTIONAL :: start
1357LOGICAL,INTENT(in),OPTIONAL :: full_steps
1358TYPE(timedelta),INTENT(in),OPTIONAL :: max_step
1359LOGICAL , INTENT(in),OPTIONAL :: clone
1360
1361INTEGER :: tri
1362INTEGER i, j, n, ninp, i3, i6
1363TYPE(arrayof_ttr_mapper),POINTER :: map_ttr(:,:)
1364TYPE(timedelta) :: lmax_step
1365LOGICAL :: lclone
1366REAL,POINTER :: voldatiin(:,:), voldatiout(:,:)
1367
1368
1369NULLIFY(voldatiin, voldatiout)
1370tri = 254
1371IF (PRESENT(max_step)) THEN
1372 lmax_step = max_step
1373ELSE
1374 lmax_step = timedelta_max
1375ENDIF
1376
1377CALL init(that)
1378! be safe
1379CALL volgrid6d_alloc_vol(this)
1380
1381! when volume is not decoded it is better to clone anyway to avoid
1382! overwriting fields
1383lclone = optio_log(clone) .OR. .NOT.ASSOCIATED(this%voldati)
1384! initialise the output volume
1385CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
1386CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntimerange=1, &
1387 nlevel=SIZE(this%level), nvar=SIZE(this%var), ini=.false.)
1388that%level = this%level
1389that%var = this%var
1390
1391CALL recompute_stat_proc_agg_common(this%time, this%timerange, stat_proc, tri, &
1392 step, this%time_definition, that%time, that%timerange, map_ttr, &
1393 start=start, full_steps=full_steps)
1394
1395CALL volgrid6d_alloc_vol(that, decode=ASSOCIATED(this%voldati))
1396
1397do_otimerange: DO j = 1, SIZE(that%timerange)
1398 do_otime: DO i = 1, SIZE(that%time)
1399 ninp = map_ttr(i,j)%arraysize
1400 IF (ninp <= 0) cycle do_otime
1401
1402 IF (stat_proc == 4) THEN ! check validity for difference
1403 IF (map_ttr(i,j)%array(1)%extra_info /= 1 .OR. &
1404 map_ttr(i,j)%array(ninp)%extra_info /= 2) THEN
1405 CALL delete(map_ttr(i,j))
1406 cycle do_otime
1407 ENDIF
1408 ELSE
1409! check validity condition (missing values in volume are not accounted for)
1410 DO n = 2, ninp
1411 IF (map_ttr(i,j)%array(n)%time - map_ttr(i,j)%array(n-1)%time > &
1412 lmax_step) THEN
1413 CALL delete(map_ttr(i,j))
1414 cycle do_otime
1415 ENDIF
1416 ENDDO
1417 ENDIF
1418
1419 DO i6 = 1, SIZE(this%var)
1420 DO i3 = 1, SIZE(this%level)
1421 CALL volgrid_get_vol_2d(that, i3, i, j, i6, voldatiout)
1422
1423 IF (stat_proc == 4) THEN ! special treatment for difference
1424 IF (lclone) THEN
1425 CALL copy(this%gaid(i3, map_ttr(i,j)%array(1)%it,&
1426 map_ttr(i,j)%array(1)%itr,i6), that%gaid(i3,i,j,i6))
1427 ELSE
1428 that%gaid(i3,i,j,i6) = this%gaid(i3, map_ttr(i,j)%array(1)%it, &
1429 map_ttr(i,j)%array(1)%itr,i6)
1430 ENDIF
1431! improve the next workflow?
1432 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(ninp)%it, &
1433 map_ttr(i,j)%array(ninp)%itr, i6, voldatiin)
1434 voldatiout = voldatiin
1435 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(1)%it, &
1436 map_ttr(i,j)%array(1)%itr, i6, voldatiin)
1437
1438 WHERE(c_e(voldatiin(:,:)) .AND. c_e(voldatiout(:,:)))
1439 voldatiout(:,:) = voldatiout(:,:) - voldatiin(:,:)
1440 ELSEWHERE
1441 voldatiout(:,:) = rmiss
1442 END WHERE
1443
1444 ELSE ! other stat_proc
1445 DO n = 1, ninp
1446 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(n)%it, &
1447 map_ttr(i,j)%array(n)%itr, i6, voldatiin)
1448
1449 IF (n == 1) THEN
1450 voldatiout = voldatiin
1451 IF (lclone) THEN
1452 CALL copy(this%gaid(i3, map_ttr(i,j)%array(n)%it,&
1453 map_ttr(i,j)%array(n)%itr,i6), that%gaid(i3,i,j,i6))
1454 ELSE
1455 that%gaid(i3,i,j,i6) = this%gaid(i3, map_ttr(i,j)%array(n)%it, &
1456 map_ttr(i,j)%array(n)%itr,i6)
1457 ENDIF
1458
1459 ELSE ! second or more time
1460 SELECT CASE(stat_proc)
1461 CASE (0, 1) ! average, accumulation
1462 WHERE(c_e(voldatiin(:,:)) .AND. c_e(voldatiout(:,:)))
1463 voldatiout(:,:) = voldatiout(:,:) + voldatiin(:,:)
1464 ELSEWHERE
1465 voldatiout(:,:) = rmiss
1466 END WHERE
1467 CASE(2) ! maximum
1468 WHERE(c_e(voldatiin(:,:)) .AND. c_e(voldatiout(:,:)))
1469 voldatiout(:,:) = max(voldatiout(:,:), voldatiin(:,:))
1470 ELSEWHERE
1471 voldatiout(:,:) = rmiss
1472 END WHERE
1473 CASE(3) ! minimum
1474 WHERE(c_e(voldatiin(:,:)) .AND. c_e(voldatiout(:,:)))
1475 voldatiout(:,:) = min(voldatiout(:,:), voldatiin(:,:))
1476 ELSEWHERE
1477 voldatiout(:,:) = rmiss
1478 END WHERE
1479 END SELECT
1480
1481 ENDIF ! first time
1482 ENDDO
1483 IF (stat_proc == 0) THEN ! average
1484 WHERE(c_e(voldatiout(:,:)))
1485 voldatiout(:,:) = voldatiout(:,:)/ninp
1486 END WHERE
1487 ENDIF
1488 ENDIF
1489 CALL volgrid_set_vol_2d(that, i3, i, j, i6, voldatiout)
1490 ENDDO ! level
1491 ENDDO ! var
1492 CALL delete(map_ttr(i,j))
1493 ENDDO do_otime
1494ENDDO do_otimerange
1495
1496DEALLOCATE(map_ttr)
1497
1498
1499END SUBROUTINE volgrid6d_compute_stat_proc_agg
1500
1501
1526SUBROUTINE volgrid6d_recompute_stat_proc_diff(this, that, stat_proc, step, full_steps, start, clone)
1527TYPE(volgrid6d),INTENT(inout) :: this
1528TYPE(volgrid6d),INTENT(out) :: that
1529INTEGER,INTENT(in) :: stat_proc
1530TYPE(timedelta),INTENT(in) :: step
1531LOGICAL,INTENT(in),OPTIONAL :: full_steps
1532TYPE(datetime),INTENT(in),OPTIONAL :: start
1533LOGICAL,INTENT(in),OPTIONAL :: clone
1534INTEGER :: i3, i4, i6, i, j, k, l, nitr, steps
1535INTEGER,ALLOCATABLE :: map_tr(:,:,:,:,:), f(:), keep_tr(:,:,:)
1536REAL,POINTER :: voldatiin1(:,:), voldatiin2(:,:), voldatiout(:,:)
1537!LOGICAL,POINTER :: mask_timerange(:)
1538LOGICAL :: lclone
1539TYPE(vol7d_var),ALLOCATABLE :: varbufr(:)
1540
1541
1542! be safe
1543CALL volgrid6d_alloc_vol(this)
1544! when volume is not decoded it is better to clone anyway to avoid
1545! overwriting fields
1546lclone = optio_log(clone) .OR. .NOT.ASSOCIATED(this%voldati)
1547! initialise the output volume
1548CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
1549CALL volgrid6d_alloc(that, dim=this%griddim%dim, &
1550 nlevel=SIZE(this%level), nvar=SIZE(this%var), ini=.false.)
1551that%level = this%level
1552that%var = this%var
1553
1554! compute length of cumulation step in seconds
1555CALL getval(step, asec=steps)
1556
1557! compute the statistical processing relations, output time and
1558! timerange are defined here
1559CALL recompute_stat_proc_diff_common(this%time, this%timerange, stat_proc, step, &
1560 that%time, that%timerange, map_tr, f, keep_tr, &
1561 this%time_definition, full_steps, start)
1562nitr = SIZE(f)
1563
1564! complete the definition of the output volume
1565CALL volgrid6d_alloc_vol(that, decode=ASSOCIATED(this%voldati))
1566! allocate workspace once
1567IF (.NOT.ASSOCIATED(that%voldati)) THEN
1568 ALLOCATE(voldatiin1(this%griddim%dim%nx, this%griddim%dim%ny), &
1569 voldatiin2(this%griddim%dim%nx, this%griddim%dim%ny), &
1570 voldatiout(this%griddim%dim%nx, this%griddim%dim%ny))
1571ENDIF
1572
1573! copy the timeranges already satisfying the requested step, if any
1574DO i4 = 1, SIZE(this%time)
1575 DO i = 1, nitr
1576 IF (c_e(keep_tr(i, i4, 2))) THEN
1577 l = keep_tr(i, i4, 1)
1578 k = keep_tr(i, i4, 2)
1579#ifdef DEBUG
1580 CALL l4f_category_log(this%category, l4f_debug, &
1581 'volgrid6d_recompute_stat_proc_diff, good timerange: '//t2c(f(i))// &
1582 '->'//t2c(k))
1583#endif
1584 DO i6 = 1, SIZE(this%var)
1585 DO i3 = 1, SIZE(this%level)
1586 IF (c_e(this%gaid(i3,i4,f(i),i6))) THEN
1587 IF (lclone) THEN
1588 CALL copy(this%gaid(i3,i4,f(i),i6), that%gaid(i3,l,k,i6))
1589 ELSE
1590 that%gaid(i3,l,k,i6) = this%gaid(i3,i4,f(i),i6)
1591 ENDIF
1592 IF (ASSOCIATED(that%voldati)) THEN
1593 that%voldati(:,:,i3,l,k,i6) = this%voldati(:,:,i3,i4,f(i),i6)
1594 ELSE
1595 CALL volgrid_get_vol_2d(this, i3, i4, f(i), i6, voldatiout)
1596 CALL volgrid_set_vol_2d(that, i3, l, k, i6, voldatiout)
1597 ENDIF
1598 ENDIF
1599 ENDDO
1600 ENDDO
1601 ENDIF
1602 ENDDO
1603ENDDO
1604
1605! varbufr required for setting posdef, optimize with an array
1606ALLOCATE(varbufr(SIZE(this%var)))
1607DO i6 = 1, SIZE(this%var)
1608 varbufr(i6) = convert(this%var(i6))
1609ENDDO
1610! compute statistical processing
1611DO l = 1, SIZE(this%time)
1612 DO k = 1, nitr
1613 DO j = 1, SIZE(this%time)
1614 DO i = 1, nitr
1615 IF (c_e(map_tr(i,j,k,l,1))) THEN
1616 DO i6 = 1, SIZE(this%var)
1617 DO i3 = 1, SIZE(this%level)
1618
1619 IF (c_e(this%gaid(i3,j,f(i),i6)) .AND. &
1620 c_e(this%gaid(i3,l,f(k),i6))) THEN
1621! take the gaid from the second time/timerange contributing to the
1622! result (l,f(k))
1623 IF (lclone) THEN
1624 CALL copy(this%gaid(i3,l,f(k),i6), &
1625 that%gaid(i3,map_tr(i,j,k,l,1),map_tr(i,j,k,l,2),i6))
1626 ELSE
1627 that%gaid(i3,map_tr(i,j,k,l,1),map_tr(i,j,k,l,2),i6) = &
1628 this%gaid(i3,l,f(k),i6)
1629 ENDIF
1630
1631! get/set 2d sections API is used
1632 CALL volgrid_get_vol_2d(this, i3, l, f(k), i6, voldatiin1)
1633 CALL volgrid_get_vol_2d(this, i3, j, f(i), i6, voldatiin2)
1634 IF (ASSOCIATED(that%voldati)) &
1635 CALL volgrid_get_vol_2d(that, i3, &
1636 map_tr(i,j,k,l,1), map_tr(i,j,k,l,2), i6, voldatiout)
1637
1638 IF (stat_proc == 0) THEN ! average
1639 WHERE(c_e(voldatiin1(:,:)) .AND. c_e(voldatiin2(:,:)))
1640 voldatiout(:,:) = &
1641 (voldatiin1(:,:)*this%timerange(f(k))%p2 - &
1642 voldatiin2(:,:)*this%timerange(f(i))%p2)/ &
1643 steps
1644 ELSEWHERE
1645 voldatiout(:,:) = rmiss
1646 END WHERE
1647 ELSE IF (stat_proc == 1 .OR. stat_proc == 4) THEN ! acc, diff
1648 WHERE(c_e(voldatiin1(:,:)) .AND. c_e(voldatiin2(:,:)))
1649 voldatiout(:,:) = voldatiin1(:,:) - voldatiin2(:,:)
1650 ELSEWHERE
1651 voldatiout(:,:) = rmiss
1652 END WHERE
1653 IF (stat_proc == 1) THEN
1654 CALL vol7d_var_features_posdef_apply(varbufr(i6), voldatiout)
1655 ENDIF
1656 ENDIF
1657
1658 CALL volgrid_set_vol_2d(that, i3, &
1659 map_tr(i,j,k,l,1), map_tr(i,j,k,l,2), i6, voldatiout)
1660
1661 ENDIF
1662 ENDDO
1663 ENDDO
1664 ENDIF
1665 ENDDO
1666 ENDDO
1667 ENDDO
1668ENDDO
1669
1670IF (.NOT.ASSOCIATED(that%voldati)) THEN
1671 DEALLOCATE(voldatiin1, voldatiin2, voldatiout)
1672ENDIF
1673
1674END SUBROUTINE volgrid6d_recompute_stat_proc_diff
1675
1676
1704SUBROUTINE volgrid6d_compute_stat_proc_metamorph(this, that, stat_proc_input, stat_proc, clone)
1705TYPE(volgrid6d),INTENT(inout) :: this
1706TYPE(volgrid6d),INTENT(out) :: that
1707INTEGER,INTENT(in) :: stat_proc_input
1708INTEGER,INTENT(in) :: stat_proc
1709LOGICAL , INTENT(in),OPTIONAL :: clone
1710
1711INTEGER :: j, i3, i4, i6
1712INTEGER,POINTER :: map_tr(:)
1713REAL,POINTER :: voldatiin(:,:), voldatiout(:,:)
1714REAL,ALLOCATABLE :: int_ratio(:)
1715LOGICAL :: lclone
1716
1717NULLIFY(voldatiin, voldatiout)
1718
1719! be safe
1720CALL volgrid6d_alloc_vol(this)
1721! when volume is not decoded it is better to clone anyway to avoid
1722! overwriting fields
1723lclone = optio_log(clone) .OR. .NOT.ASSOCIATED(this%voldati)
1724
1725IF (.NOT.((stat_proc_input == 0 .AND. stat_proc == 1) .OR. &
1726 (stat_proc_input == 1 .AND. stat_proc == 0))) THEN
1727
1728 CALL l4f_category_log(this%category, l4f_warn, &
1729 'compute_stat_proc_metamorph, can only be applied to average->accumulated timerange and viceversa')
1730! return an empty volume, without signaling error
1731 CALL init(that)
1732 CALL volgrid6d_alloc_vol(that)
1733 RETURN
1734ENDIF
1735
1736! initialise the output volume
1737CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
1738CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntime=SIZE(this%time), &
1739 nlevel=SIZE(this%level), nvar=SIZE(this%var), ini=.false.)
1740that%time = this%time
1741that%level = this%level
1742that%var = this%var
1743
1744CALL compute_stat_proc_metamorph_common(stat_proc_input, this%timerange, stat_proc, &
1745 that%timerange, map_tr)
1746
1747! complete the definition of the output volume
1748CALL volgrid6d_alloc_vol(that, decode=ASSOCIATED(this%voldati))
1749
1750IF (stat_proc == 0) THEN ! average -> integral
1751 int_ratio = 1./real(that%timerange(:)%p2)
1752ELSE ! cumulation
1753 int_ratio = real(that%timerange(:)%p2)
1754ENDIF
1755
1756DO i6 = 1, SIZE(this%var)
1757 DO j = 1, SIZE(map_tr)
1758 DO i4 = 1, SIZE(that%time)
1759 DO i3 = 1, SIZE(this%level)
1760
1761 IF (lclone) THEN
1762 CALL copy(this%gaid(i3,i4,map_tr(j),i6), that%gaid(i3,i4,j,i6))
1763 ELSE
1764 that%gaid(i3,i4,map_tr(j),i6) = this%gaid(i3,i4,j,i6)
1765 ENDIF
1766 CALL volgrid_get_vol_2d(this, i3, i4, map_tr(j), i6, voldatiin)
1767 CALL volgrid_get_vol_2d(that, i3, i4, j, i6, voldatiout)
1768 WHERE (c_e(voldatiin))
1769 voldatiout = voldatiin*int_ratio(j)
1770 ELSEWHERE
1771 voldatiout = rmiss
1772 END WHERE
1773 CALL volgrid_set_vol_2d(that, i3, i4, j, i6, voldatiout)
1774 ENDDO
1775 ENDDO
1776 ENDDO
1777ENDDO
1778
1779
1780END SUBROUTINE volgrid6d_compute_stat_proc_metamorph
1781
1796SUBROUTINE volgrid6d_compute_vert_coord_var(this, level, volgrid_lev)
1797TYPE(volgrid6d),INTENT(in) :: this
1798TYPE(vol7d_level),INTENT(in) :: level
1799TYPE(volgrid6d),INTENT(out) :: volgrid_lev
1800
1801INTEGER :: nlev, i, ii, iii, iiii
1802TYPE(grid_id) :: out_gaid
1803LOGICAL,ALLOCATABLE :: levmask(:)
1804TYPE(volgrid6d_var) :: lev_var
1805
1806CALL init(volgrid_lev) ! initialise to null
1807IF (.NOT.ASSOCIATED(this%gaid)) THEN
1808 CALL l4f_log(l4f_error, 'volgrid6d_compute_vert_coord_var: input volume not allocated')
1809 RETURN
1810ENDIF
1811! if layer, both surfaces must be of the same type
1812IF (c_e(level%level2) .AND. level%level1 /= level%level2) THEN
1813 CALL l4f_log(l4f_error, 'volgrid6d_compute_vert_coord_var: requested (mixed) layer type not valid')
1814 RETURN
1815ENDIF
1816
1817! look for valid levels to be converted to vars
1818ALLOCATE(levmask(SIZE(this%level)))
1819levmask = this%level%level1 == level%level1 .AND. &
1820 this%level%level2 == level%level2 .AND. c_e(this%level%l1)
1821IF (c_e(level%level2)) levmask = levmask .AND. c_e(this%level%l2)
1822nlev = count(levmask)
1823IF (nlev == 0) THEN
1824 CALL l4f_log(l4f_error, 'volgrid6d_compute_vert_coord_var: requested level type not available')
1825 RETURN
1826ENDIF
1827
1828out_gaid = grid_id_new()
1829gaidloop: DO i=1 ,SIZE(this%gaid,1)
1830 DO ii=1 ,SIZE(this%gaid,2)
1831 DO iii=1 ,SIZE(this%gaid,3)
1832 DO iiii=1 ,SIZE(this%gaid,4)
1833 IF (c_e(this%gaid(i,ii,iii,iiii))) THEN ! conserve first valid gaid
1834 CALL copy(this%gaid(i,ii,iii,iiii), out_gaid)
1835 EXIT gaidloop
1836 ENDIF
1837 ENDDO
1838 ENDDO
1839 ENDDO
1840ENDDO gaidloop
1841
1842! look for variable corresponding to level
1843lev_var = convert(vol7d_var_new(btable=vol7d_level_to_var(level)), &
1844 grid_id_template=out_gaid)
1845IF (.NOT.c_e(lev_var)) THEN
1846 CALL l4f_log(l4f_error, 'volgrid6d_compute_vert_coord_var: no variable corresponds to requested level type')
1847 RETURN
1848ENDIF
1849
1850! prepare output volume
1851CALL init(volgrid_lev, griddim=this%griddim, &
1852 time_definition=this%time_definition) !, categoryappend=categoryappend)
1853CALL volgrid6d_alloc(volgrid_lev, ntime=SIZE(this%time), nlevel=nlev, &
1854 ntimerange=SIZE(this%timerange), nvar=1)
1855! fill metadata
1856volgrid_lev%time = this%time
1857volgrid_lev%level = pack(this%level, mask=levmask)
1858volgrid_lev%timerange = this%timerange
1859volgrid_lev%var(1) = lev_var
1860
1861CALL volgrid6d_alloc_vol(volgrid_lev, decode=.true.)
1862! fill data
1863DO i = 1, nlev
1864 IF (c_e(level%level2)) THEN
1865 volgrid_lev%voldati(:,:,i,:,:,:) = real(volgrid_lev%level(i)%l1 + &
1866 volgrid_lev%level(i)%l2)* &
1867 vol7d_level_to_var_factor(volgrid_lev%level(i))/2.
1868 ELSE
1869 volgrid_lev%voldati(:,:,i,:,:,:) = real(volgrid_lev%level(i)%l1)* &
1870 vol7d_level_to_var_factor(volgrid_lev%level(i))
1871 ENDIF
1872ENDDO
1873! fill gaid for subsequent export
1874IF (c_e(out_gaid)) THEN
1875 DO i=1 ,SIZE(volgrid_lev%gaid,1)
1876 DO ii=1 ,SIZE(volgrid_lev%gaid,2)
1877 DO iii=1 ,SIZE(volgrid_lev%gaid,3)
1878 DO iiii=1 ,SIZE(volgrid_lev%gaid,4)
1879 CALL copy(out_gaid, volgrid_lev%gaid(i,ii,iii,iiii))
1880 ENDDO
1881 ENDDO
1882 ENDDO
1883 ENDDO
1884 CALL delete(out_gaid)
1885ENDIF
1886
1887END SUBROUTINE volgrid6d_compute_vert_coord_var
1888
1889END MODULE volgrid6d_class_compute
Distruttori per le 2 classi.
Restituiscono il valore dell'oggetto nella forma desiderata.
Costruttori per le classi datetime e timedelta.
Functions that return a trimmed CHARACTER representation of the input variable.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Make a deep copy, if possible, of the grid identifier.
Apply the conversion function this to values.
Classi per la gestione delle coordinate temporali.
This module defines an abstract interface to different drivers for access to files containing gridded...
Module for basic statistical computations taking into account missing data.
Definition: simple_stat.f90:25
This module contains functions that are only for internal use of the library.
Extension of volgrid6d_class with methods for performing simple statistical operations on entire volu...
This module defines objects and methods for managing data volumes on rectangular georeferenced grids.
Class for managing physical variables in a grib 1/2 fashion.

Generated with Doxygen.