libsim Versione 7.1.11
|
◆ volgrid6d_compute_stat_proc_metamorph()
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:
Input volume may have any value of thistime_definition, and that value will be conserved in the output volume.
Definizione alla linea 942 del file volgrid6d_class_compute.F90. 943! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
944! authors:
945! Davide Cesari <dcesari@arpa.emr.it>
946! Paolo Patruno <ppatruno@arpa.emr.it>
947
948! This program is free software; you can redistribute it and/or
949! modify it under the terms of the GNU General Public License as
950! published by the Free Software Foundation; either version 2 of
951! the License, or (at your option) any later version.
952
953! This program is distributed in the hope that it will be useful,
954! but WITHOUT ANY WARRANTY; without even the implied warranty of
955! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
956! GNU General Public License for more details.
957
958! You should have received a copy of the GNU General Public License
959! along with this program. If not, see <http://www.gnu.org/licenses/>.
960#include "config.h"
961
975IMPLICIT NONE
976
977CONTAINS
978
1044SUBROUTINE volgrid6d_compute_stat_proc(this, that, stat_proc_input, stat_proc, &
1045 step, start, full_steps, frac_valid, max_step, weighted, clone)
1046TYPE(volgrid6d),INTENT(inout) :: this
1047TYPE(volgrid6d),INTENT(out) :: that
1048INTEGER,INTENT(in) :: stat_proc_input
1049INTEGER,INTENT(in) :: stat_proc
1050TYPE(timedelta),INTENT(in) :: step
1051TYPE(datetime),INTENT(in),OPTIONAL :: start
1052LOGICAL,INTENT(in),OPTIONAL :: full_steps
1053REAL,INTENT(in),OPTIONAL :: frac_valid
1054TYPE(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
1055LOGICAL,INTENT(in),OPTIONAL :: weighted
1056LOGICAL , INTENT(in),OPTIONAL :: clone
1057
1058INTEGER :: dtmax, dtstep
1059
1060
1061IF (stat_proc_input == 254) THEN
1062 CALL l4f_category_log(this%category, l4f_info, &
1063 'computing statistical processing by aggregation '//&
1065
1066 CALL volgrid6d_compute_stat_proc_agg(this, that, stat_proc, &
1067 step, start, full_steps, max_step, clone)
1068
1069ELSE IF (stat_proc == 254) THEN
1070 CALL l4f_category_log(this%category, l4f_error, &
1071 'statistical processing to instantaneous data not implemented for gridded fields')
1072 CALL raise_error()
1073
1074ELSE IF (stat_proc_input /= stat_proc) THEN
1075 IF ((stat_proc_input == 0 .AND. stat_proc == 1) .OR. &
1076 (stat_proc_input == 1 .AND. stat_proc == 0)) THEN
1077 CALL l4f_category_log(this%category, l4f_info, &
1078 'computing statistically processed data by integration/differentiation '// &
1080 CALL volgrid6d_compute_stat_proc_metamorph(this, that, stat_proc_input, &
1081 stat_proc, clone)
1082 ELSE
1083 CALL l4f_category_log(this%category, l4f_error, &
1085 ' not implemented or does not make sense')
1086 CALL raise_error()
1087 ENDIF
1088
1089ELSE IF (count(this%timerange(:)%timerange == stat_proc) == 0) THEN
1090 CALL l4f_category_log(this%category, l4f_warn, &
1092! return an empty volume, without signaling error
1094 CALL volgrid6d_alloc_vol(that)
1095
1096ELSE
1097! euristically determine whether aggregation or difference is more suitable
1098 dtmax = maxval(this%timerange(:)%p2, &
1099 mask=(this%timerange(:)%timerange == stat_proc))
1101
1102#ifdef DEBUG
1103 CALL l4f_category_log(this%category, l4f_debug, &
1105#endif
1106
1107 IF (dtstep < dtmax) THEN
1108 CALL l4f_category_log(this%category, l4f_info, &
1109 'recomputing statistically processed data by difference '// &
1111 CALL volgrid6d_recompute_stat_proc_diff(this, that, stat_proc, step, &
1112 full_steps, start, clone)
1113 ELSE
1114 CALL l4f_category_log(this%category, l4f_info, &
1115 'recomputing statistically processed data by aggregation '// &
1117 CALL volgrid6d_recompute_stat_proc_agg(this, that, stat_proc, step, start, &
1118 full_steps, frac_valid, clone)
1119 ENDIF
1120
1121ENDIF
1122
1123END SUBROUTINE volgrid6d_compute_stat_proc
1124
1125
1168SUBROUTINE volgrid6d_recompute_stat_proc_agg(this, that, stat_proc, &
1169 step, start, full_steps, frac_valid, clone)
1170TYPE(volgrid6d),INTENT(inout) :: this
1171TYPE(volgrid6d),INTENT(out) :: that
1172INTEGER,INTENT(in) :: stat_proc
1173TYPE(timedelta),INTENT(in) :: step
1174TYPE(datetime),INTENT(in),OPTIONAL :: start
1175LOGICAL,INTENT(in),OPTIONAL :: full_steps
1176REAL,INTENT(in),OPTIONAL :: frac_valid
1177LOGICAL, INTENT(in),OPTIONAL :: clone
1178
1179INTEGER :: tri
1180INTEGER i, j, n, n1, ndtr, i3, i6
1181TYPE(arrayof_ttr_mapper),POINTER :: map_ttr(:,:)
1182INTEGER,POINTER :: dtratio(:)
1183REAL :: lfrac_valid
1184LOGICAL :: lclone
1185REAL,POINTER :: voldatiin(:,:), voldatiout(:,:)
1186
1187
1188NULLIFY(voldatiin, voldatiout)
1189tri = stat_proc
1190IF (PRESENT(frac_valid)) THEN
1191 lfrac_valid = frac_valid
1192ELSE
1193 lfrac_valid = 1.0
1194ENDIF
1195
1197! be safe
1198CALL volgrid6d_alloc_vol(this)
1199
1200! when volume is not decoded it is better to clone anyway to avoid
1201! overwriting fields
1202lclone = optio_log(clone) .OR. .NOT.ASSOCIATED(this%voldati)
1203! initialise the output volume
1205CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntimerange=1, &
1206 nlevel=SIZE(this%level), nvar=SIZE(this%var), ini=.false.)
1207that%level = this%level
1208that%var = this%var
1209
1210CALL recompute_stat_proc_agg_common(this%time, this%timerange, stat_proc, tri, &
1211 step, this%time_definition, that%time, that%timerange, map_ttr, &
1212 dtratio=dtratio, start=start, full_steps=full_steps)
1213
1214CALL volgrid6d_alloc_vol(that, decode=ASSOCIATED(this%voldati))
1215
1216do_otimerange: DO j = 1, SIZE(that%timerange)
1217 do_otime: DO i = 1, SIZE(that%time)
1218
1219 DO n1 = 1, SIZE(dtratio)
1220 IF (dtratio(n1) <= 0) cycle ! safety check
1221
1222 DO i6 = 1, SIZE(this%var)
1223 DO i3 = 1, SIZE(this%level)
1224 CALL volgrid_get_vol_2d(that, i3, i, j, i6, voldatiout)
1225 ndtr = 0
1226 DO n = 1, map_ttr(i,j)%arraysize
1227 IF (map_ttr(i,j)%array(n)%extra_info == dtratio(n1)) THEN
1228 ndtr = ndtr + 1
1229 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(n)%it, &
1230 map_ttr(i,j)%array(n)%itr, i6, voldatiin)
1231
1232 IF (ndtr == 1) THEN
1233 voldatiout = voldatiin
1234 IF (lclone) THEN
1236 map_ttr(i,j)%array(n)%itr,i6), that%gaid(i3,i,j,i6))
1237 ELSE
1238 that%gaid(i3,i,j,i6) = this%gaid(i3, map_ttr(i,j)%array(n)%it, &
1239 map_ttr(i,j)%array(n)%itr,i6)
1240 ENDIF
1241
1242 ELSE ! second or more time
1243 SELECT CASE(stat_proc)
1244 CASE (0, 200, 1, 4) ! average, vectorial mean, accumulation, difference
1246 voldatiout(:,:) = voldatiout(:,:) + voldatiin(:,:)
1247 ELSEWHERE
1248 voldatiout(:,:) = rmiss
1249 END WHERE
1250 CASE(2) ! maximum
1252 voldatiout(:,:) = max(voldatiout(:,:), voldatiin(:,:))
1253 ELSEWHERE
1254 voldatiout(:,:) = rmiss
1255 END WHERE
1256 CASE(3) ! minimum
1258 voldatiout(:,:) = min(voldatiout(:,:), voldatiin(:,:))
1259 ELSEWHERE
1260 voldatiout(:,:) = rmiss
1261 END WHERE
1262 END SELECT
1263
1264 ENDIF ! first time
1265 ENDIF ! dtratio(n1)
1266 ENDDO ! ttr
1267
1268#ifdef DEBUG
1269 CALL l4f_log(l4f_debug, &
1270 'compute_stat_proc_agg, ndtr/dtratio/frac_valid: '// &
1272#endif
1273 IF (ndtr > 0) THEN ! why this condition was not here before?
1274 IF (real(ndtr)/real(dtratio(n1)) >= lfrac_valid) THEN ! success
1275 IF (stat_proc == 0) THEN ! average
1277 voldatiout(:,:) = voldatiout(:,:)/ndtr
1278 END WHERE
1279 ENDIF
1280 CALL volgrid_set_vol_2d(that, i3, i, j, i6, voldatiout)
1281#ifdef DEBUG
1282 CALL l4f_log(l4f_debug, &
1283 'compute_stat_proc_agg, coding lev/t/tr/var: '// &
1285#endif
1286 ELSE
1287! must nullify the output gaid here, otherwise an incomplete field will be output
1288 IF (lclone) THEN
1290 ELSE
1292 ENDIF
1293#ifdef DEBUG
1294 CALL l4f_log(l4f_debug, &
1295 'compute_stat_proc_agg, skipping lev/t/tr/var: '// &
1297#endif
1298 ENDIF
1299 ENDIF ! ndtr > 0
1300
1301 ENDDO ! level
1302 ENDDO ! var
1303 ENDDO ! dtratio
1305 ENDDO do_otime
1306ENDDO do_otimerange
1307
1308DEALLOCATE(dtratio, map_ttr)
1309
1310END SUBROUTINE volgrid6d_recompute_stat_proc_agg
1311
1312
1336SUBROUTINE volgrid6d_compute_stat_proc_agg(this, that, stat_proc, &
1337 step, start, full_steps, max_step, clone)
1338TYPE(volgrid6d),INTENT(inout) :: this
1339TYPE(volgrid6d),INTENT(out) :: that
1340INTEGER,INTENT(in) :: stat_proc
1341TYPE(timedelta),INTENT(in) :: step
1342TYPE(datetime),INTENT(in),OPTIONAL :: start
1343LOGICAL,INTENT(in),OPTIONAL :: full_steps
1344TYPE(timedelta),INTENT(in),OPTIONAL :: max_step
1345LOGICAL , INTENT(in),OPTIONAL :: clone
1346
1347INTEGER :: tri
1348INTEGER i, j, n, ninp, i3, i6
1349TYPE(arrayof_ttr_mapper),POINTER :: map_ttr(:,:)
1350TYPE(timedelta) :: lmax_step
1351LOGICAL :: lclone
1352REAL,POINTER :: voldatiin(:,:), voldatiout(:,:)
1353
1354
1355NULLIFY(voldatiin, voldatiout)
1356tri = 254
1357IF (PRESENT(max_step)) THEN
1358 lmax_step = max_step
1359ELSE
1360 lmax_step = timedelta_max
1361ENDIF
1362
1364! be safe
1365CALL volgrid6d_alloc_vol(this)
1366
1367! when volume is not decoded it is better to clone anyway to avoid
1368! overwriting fields
1369lclone = optio_log(clone) .OR. .NOT.ASSOCIATED(this%voldati)
1370! initialise the output volume
1372CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntimerange=1, &
1373 nlevel=SIZE(this%level), nvar=SIZE(this%var), ini=.false.)
1374that%level = this%level
1375that%var = this%var
1376
1377CALL recompute_stat_proc_agg_common(this%time, this%timerange, stat_proc, tri, &
1378 step, this%time_definition, that%time, that%timerange, map_ttr, &
1379 start=start, full_steps=full_steps)
1380
1381CALL volgrid6d_alloc_vol(that, decode=ASSOCIATED(this%voldati))
1382
1383do_otimerange: DO j = 1, SIZE(that%timerange)
1384 do_otime: DO i = 1, SIZE(that%time)
1385 ninp = map_ttr(i,j)%arraysize
1386 IF (ninp <= 0) cycle do_otime
1387
1388 IF (stat_proc == 4) THEN ! check validity for difference
1389 IF (map_ttr(i,j)%array(1)%extra_info /= 1 .OR. &
1390 map_ttr(i,j)%array(ninp)%extra_info /= 2) THEN
1392 cycle do_otime
1393 ENDIF
1394 ELSE
1395! check validity condition (missing values in volume are not accounted for)
1396 DO n = 2, ninp
1397 IF (map_ttr(i,j)%array(n)%time - map_ttr(i,j)%array(n-1)%time > &
1398 lmax_step) THEN
1400 cycle do_otime
1401 ENDIF
1402 ENDDO
1403 ENDIF
1404
1405 DO i6 = 1, SIZE(this%var)
1406 DO i3 = 1, SIZE(this%level)
1407 CALL volgrid_get_vol_2d(that, i3, i, j, i6, voldatiout)
1408
1409 IF (stat_proc == 4) THEN ! special treatment for difference
1410 IF (lclone) THEN
1412 map_ttr(i,j)%array(1)%itr,i6), that%gaid(i3,i,j,i6))
1413 ELSE
1414 that%gaid(i3,i,j,i6) = this%gaid(i3, map_ttr(i,j)%array(1)%it, &
1415 map_ttr(i,j)%array(1)%itr,i6)
1416 ENDIF
1417! improve the next workflow?
1418 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(ninp)%it, &
1419 map_ttr(i,j)%array(ninp)%itr, i6, voldatiin)
1420 voldatiout = voldatiin
1421 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(1)%it, &
1422 map_ttr(i,j)%array(1)%itr, i6, voldatiin)
1423
1425 voldatiout(:,:) = voldatiout(:,:) - voldatiin(:,:)
1426 ELSEWHERE
1427 voldatiout(:,:) = rmiss
1428 END WHERE
1429
1430 ELSE ! other stat_proc
1431 DO n = 1, ninp
1432 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(n)%it, &
1433 map_ttr(i,j)%array(n)%itr, i6, voldatiin)
1434
1435 IF (n == 1) THEN
1436 voldatiout = voldatiin
1437 IF (lclone) THEN
1439 map_ttr(i,j)%array(n)%itr,i6), that%gaid(i3,i,j,i6))
1440 ELSE
1441 that%gaid(i3,i,j,i6) = this%gaid(i3, map_ttr(i,j)%array(n)%it, &
1442 map_ttr(i,j)%array(n)%itr,i6)
1443 ENDIF
1444
1445 ELSE ! second or more time
1446 SELECT CASE(stat_proc)
1447 CASE (0, 1) ! average, accumulation
1449 voldatiout(:,:) = voldatiout(:,:) + voldatiin(:,:)
1450 ELSEWHERE
1451 voldatiout(:,:) = rmiss
1452 END WHERE
1453 CASE(2) ! maximum
1455 voldatiout(:,:) = max(voldatiout(:,:), voldatiin(:,:))
1456 ELSEWHERE
1457 voldatiout(:,:) = rmiss
1458 END WHERE
1459 CASE(3) ! minimum
1461 voldatiout(:,:) = min(voldatiout(:,:), voldatiin(:,:))
1462 ELSEWHERE
1463 voldatiout(:,:) = rmiss
1464 END WHERE
1465 END SELECT
1466
1467 ENDIF ! first time
1468 ENDDO
1469 IF (stat_proc == 0) THEN ! average
1471 voldatiout(:,:) = voldatiout(:,:)/ninp
1472 END WHERE
1473 ENDIF
1474 ENDIF
1475 CALL volgrid_set_vol_2d(that, i3, i, j, i6, voldatiout)
1476 ENDDO ! level
1477 ENDDO ! var
1479 ENDDO do_otime
1480ENDDO do_otimerange
1481
1482DEALLOCATE(map_ttr)
1483
1484
1485END SUBROUTINE volgrid6d_compute_stat_proc_agg
1486
1487
1512SUBROUTINE volgrid6d_recompute_stat_proc_diff(this, that, stat_proc, step, full_steps, start, clone)
1513TYPE(volgrid6d),INTENT(inout) :: this
1514TYPE(volgrid6d),INTENT(out) :: that
1515INTEGER,INTENT(in) :: stat_proc
1516TYPE(timedelta),INTENT(in) :: step
1517LOGICAL,INTENT(in),OPTIONAL :: full_steps
1518TYPE(datetime),INTENT(in),OPTIONAL :: start
1519LOGICAL,INTENT(in),OPTIONAL :: clone
1520INTEGER :: i3, i4, i6, i, j, k, l, nitr, steps
1521INTEGER,ALLOCATABLE :: map_tr(:,:,:,:,:), f(:), keep_tr(:,:,:)
1522REAL,POINTER :: voldatiin1(:,:), voldatiin2(:,:), voldatiout(:,:)
1523!LOGICAL,POINTER :: mask_timerange(:)
1524LOGICAL :: lclone
1525TYPE(vol7d_var),ALLOCATABLE :: varbufr(:)
1526
1527
1528! be safe
1529CALL volgrid6d_alloc_vol(this)
1530! when volume is not decoded it is better to clone anyway to avoid
1531! overwriting fields
1532lclone = optio_log(clone) .OR. .NOT.ASSOCIATED(this%voldati)
1533! initialise the output volume
1535CALL volgrid6d_alloc(that, dim=this%griddim%dim, &
1536 nlevel=SIZE(this%level), nvar=SIZE(this%var), ini=.false.)
1537that%level = this%level
1538that%var = this%var
1539
1540! compute length of cumulation step in seconds
1542
1543! compute the statistical processing relations, output time and
1544! timerange are defined here
1545CALL recompute_stat_proc_diff_common(this%time, this%timerange, stat_proc, step, &
1546 that%time, that%timerange, map_tr, f, keep_tr, &
1547 this%time_definition, full_steps, start)
1548nitr = SIZE(f)
1549
1550! complete the definition of the output volume
1551CALL volgrid6d_alloc_vol(that, decode=ASSOCIATED(this%voldati))
1552! allocate workspace once
1553IF (.NOT.ASSOCIATED(that%voldati)) THEN
1554 ALLOCATE(voldatiin1(this%griddim%dim%nx, this%griddim%dim%ny), &
1555 voldatiin2(this%griddim%dim%nx, this%griddim%dim%ny), &
1556 voldatiout(this%griddim%dim%nx, this%griddim%dim%ny))
1557ENDIF
1558
1559! copy the timeranges already satisfying the requested step, if any
1560DO i4 = 1, SIZE(this%time)
1561 DO i = 1, nitr
1563 l = keep_tr(i, i4, 1)
1564 k = keep_tr(i, i4, 2)
1565#ifdef DEBUG
1566 CALL l4f_category_log(this%category, l4f_debug, &
1569#endif
1570 DO i6 = 1, SIZE(this%var)
1571 DO i3 = 1, SIZE(this%level)
1573 IF (lclone) THEN
1575 ELSE
1576 that%gaid(i3,l,k,i6) = this%gaid(i3,i4,f(i),i6)
1577 ENDIF
1578 IF (ASSOCIATED(that%voldati)) THEN
1579 that%voldati(:,:,i3,l,k,i6) = this%voldati(:,:,i3,i4,f(i),i6)
1580 ELSE
1581 CALL volgrid_get_vol_2d(this, i3, i4, f(i), i6, voldatiout)
1582 CALL volgrid_set_vol_2d(that, i3, l, k, i6, voldatiout)
1583 ENDIF
1584 ENDIF
1585 ENDDO
1586 ENDDO
1587 ENDIF
1588 ENDDO
1589ENDDO
1590
1591! varbufr required for setting posdef, optimize with an array
1592ALLOCATE(varbufr(SIZE(this%var)))
1593DO i6 = 1, SIZE(this%var)
1594 varbufr(i6) = convert(this%var(i6))
1595ENDDO
1596! compute statistical processing
1597DO l = 1, SIZE(this%time)
1598 DO k = 1, nitr
1599 DO j = 1, SIZE(this%time)
1600 DO i = 1, nitr
1602 DO i6 = 1, SIZE(this%var)
1603 DO i3 = 1, SIZE(this%level)
1604
1607! take the gaid from the second time/timerange contributing to the
1608! result (l,f(k))
1609 IF (lclone) THEN
1611 that%gaid(i3,map_tr(i,j,k,l,1),map_tr(i,j,k,l,2),i6))
1612 ELSE
1613 that%gaid(i3,map_tr(i,j,k,l,1),map_tr(i,j,k,l,2),i6) = &
1614 this%gaid(i3,l,f(k),i6)
1615 ENDIF
1616
1617! get/set 2d sections API is used
1618 CALL volgrid_get_vol_2d(this, i3, l, f(k), i6, voldatiin1)
1619 CALL volgrid_get_vol_2d(this, i3, j, f(i), i6, voldatiin2)
1620 IF (ASSOCIATED(that%voldati)) &
1621 CALL volgrid_get_vol_2d(that, i3, &
1622 map_tr(i,j,k,l,1), map_tr(i,j,k,l,2), i6, voldatiout)
1623
1624 IF (stat_proc == 0) THEN ! average
1626 voldatiout(:,:) = &
1627 (voldatiin1(:,:)*this%timerange(f(k))%p2 - &
1628 voldatiin2(:,:)*this%timerange(f(i))%p2)/ &
1629 steps
1630 ELSEWHERE
1631 voldatiout(:,:) = rmiss
1632 END WHERE
1633 ELSE IF (stat_proc == 1 .OR. stat_proc == 4) THEN ! acc, diff
1635 voldatiout(:,:) = voldatiin1(:,:) - voldatiin2(:,:)
1636 ELSEWHERE
1637 voldatiout(:,:) = rmiss
1638 END WHERE
1639 IF (stat_proc == 1) THEN
1640 CALL vol7d_var_features_posdef_apply(varbufr(i6), voldatiout)
1641 ENDIF
1642 ENDIF
1643
1644 CALL volgrid_set_vol_2d(that, i3, &
1645 map_tr(i,j,k,l,1), map_tr(i,j,k,l,2), i6, voldatiout)
1646
1647 ENDIF
1648 ENDDO
1649 ENDDO
1650 ENDIF
1651 ENDDO
1652 ENDDO
1653 ENDDO
1654ENDDO
1655
1656IF (.NOT.ASSOCIATED(that%voldati)) THEN
1657 DEALLOCATE(voldatiin1, voldatiin2, voldatiout)
1658ENDIF
1659
1660END SUBROUTINE volgrid6d_recompute_stat_proc_diff
1661
1662
1690SUBROUTINE volgrid6d_compute_stat_proc_metamorph(this, that, stat_proc_input, stat_proc, clone)
1691TYPE(volgrid6d),INTENT(inout) :: this
1692TYPE(volgrid6d),INTENT(out) :: that
1693INTEGER,INTENT(in) :: stat_proc_input
1694INTEGER,INTENT(in) :: stat_proc
1695LOGICAL , INTENT(in),OPTIONAL :: clone
1696
1697INTEGER :: j, i3, i4, i6
1698INTEGER,POINTER :: map_tr(:)
1699REAL,POINTER :: voldatiin(:,:), voldatiout(:,:)
1700REAL,ALLOCATABLE :: int_ratio(:)
1701LOGICAL :: lclone
1702
1703NULLIFY(voldatiin, voldatiout)
1704
1705! be safe
1706CALL volgrid6d_alloc_vol(this)
1707! when volume is not decoded it is better to clone anyway to avoid
1708! overwriting fields
1709lclone = optio_log(clone) .OR. .NOT.ASSOCIATED(this%voldati)
1710
1711IF (.NOT.((stat_proc_input == 0 .AND. stat_proc == 1) .OR. &
1712 (stat_proc_input == 1 .AND. stat_proc == 0))) THEN
1713
1714 CALL l4f_category_log(this%category, l4f_warn, &
1715 'compute_stat_proc_metamorph, can only be applied to average->accumulated timerange and viceversa')
1716! return an empty volume, without signaling error
1718 CALL volgrid6d_alloc_vol(that)
1719 RETURN
1720ENDIF
1721
1722! initialise the output volume
1724CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntime=SIZE(this%time), &
1725 nlevel=SIZE(this%level), nvar=SIZE(this%var), ini=.false.)
1726that%time = this%time
1727that%level = this%level
1728that%var = this%var
1729
1730CALL compute_stat_proc_metamorph_common(stat_proc_input, this%timerange, stat_proc, &
1731 that%timerange, map_tr)
1732
1733! complete the definition of the output volume
1734CALL volgrid6d_alloc_vol(that, decode=ASSOCIATED(this%voldati))
1735
1736IF (stat_proc == 0) THEN ! average -> integral
1737 int_ratio = 1./real(that%timerange(:)%p2)
1738ELSE ! cumulation
1739 int_ratio = real(that%timerange(:)%p2)
1740ENDIF
1741
1742DO i6 = 1, SIZE(this%var)
1743 DO j = 1, SIZE(map_tr)
1744 DO i4 = 1, SIZE(that%time)
1745 DO i3 = 1, SIZE(this%level)
1746
1747 IF (lclone) THEN
1749 ELSE
1750 that%gaid(i3,i4,map_tr(j),i6) = this%gaid(i3,i4,j,i6)
1751 ENDIF
1752 CALL volgrid_get_vol_2d(this, i3, i4, map_tr(j), i6, voldatiin)
1753 CALL volgrid_get_vol_2d(that, i3, i4, j, i6, voldatiout)
1755 voldatiout = voldatiin*int_ratio(j)
1756 ELSEWHERE
1757 voldatiout = rmiss
1758 END WHERE
1759 CALL volgrid_set_vol_2d(that, i3, i4, j, i6, voldatiout)
1760 ENDDO
1761 ENDDO
1762 ENDDO
1763ENDDO
1764
1765
1766END SUBROUTINE volgrid6d_compute_stat_proc_metamorph
1767
1782SUBROUTINE volgrid6d_compute_vert_coord_var(this, level, volgrid_lev)
1783TYPE(volgrid6d),INTENT(in) :: this
1784TYPE(vol7d_level),INTENT(in) :: level
1785TYPE(volgrid6d),INTENT(out) :: volgrid_lev
1786
1787INTEGER :: nlev, i, ii, iii, iiii
1788TYPE(grid_id) :: out_gaid
1789LOGICAL,ALLOCATABLE :: levmask(:)
1790TYPE(volgrid6d_var) :: lev_var
1791
1793IF (.NOT.ASSOCIATED(this%gaid)) THEN
1794 CALL l4f_log(l4f_error, 'volgrid6d_compute_vert_coord_var: input volume not allocated')
1795 RETURN
1796ENDIF
1797! if layer, both surfaces must be of the same type
1799 CALL l4f_log(l4f_error, 'volgrid6d_compute_vert_coord_var: requested (mixed) layer type not valid')
1800 RETURN
1801ENDIF
1802
1803! look for valid levels to be converted to vars
1804ALLOCATE(levmask(SIZE(this%level)))
1805levmask = this%level%level1 == level%level1 .AND. &
1806 this%level%level2 == level%level2 .AND. c_e(this%level%l1)
1808nlev = count(levmask)
1809IF (nlev == 0) THEN
1810 CALL l4f_log(l4f_error, 'volgrid6d_compute_vert_coord_var: requested level type not available')
1811 RETURN
1812ENDIF
1813
1814out_gaid = grid_id_new()
1815gaidloop: DO i=1 ,SIZE(this%gaid,1)
1816 DO ii=1 ,SIZE(this%gaid,2)
1817 DO iii=1 ,SIZE(this%gaid,3)
1818 DO iiii=1 ,SIZE(this%gaid,4)
1821 EXIT gaidloop
1822 ENDIF
1823 ENDDO
1824 ENDDO
1825 ENDDO
1826ENDDO gaidloop
1827
1828! look for variable corresponding to level
1829lev_var = convert(vol7d_var_new(btable=vol7d_level_to_var(level)), &
1830 grid_id_template=out_gaid)
1832 CALL l4f_log(l4f_error, 'volgrid6d_compute_vert_coord_var: no variable corresponds to requested level type')
1833 RETURN
1834ENDIF
1835
1836! prepare output volume
1838 time_definition=this%time_definition) !, categoryappend=categoryappend)
1839CALL volgrid6d_alloc(volgrid_lev, ntime=SIZE(this%time), nlevel=nlev, &
1840 ntimerange=SIZE(this%timerange), nvar=1)
1841! fill metadata
1842volgrid_lev%time = this%time
1843volgrid_lev%level = pack(this%level, mask=levmask)
1844volgrid_lev%timerange = this%timerange
1845volgrid_lev%var(1) = lev_var
1846
1847CALL volgrid6d_alloc_vol(volgrid_lev, decode=.true.)
1848! fill data
1849DO i = 1, nlev
1851 volgrid_lev%voldati(:,:,i,:,:,:) = real(volgrid_lev%level(i)%l1 + &
1852 volgrid_lev%level(i)%l2)* &
1853 vol7d_level_to_var_factor(volgrid_lev%level(i))/2.
1854 ELSE
1855 volgrid_lev%voldati(:,:,i,:,:,:) = real(volgrid_lev%level(i)%l1)* &
1856 vol7d_level_to_var_factor(volgrid_lev%level(i))
1857 ENDIF
1858ENDDO
1859! fill gaid for subsequent export
1861 DO i=1 ,SIZE(volgrid_lev%gaid,1)
1862 DO ii=1 ,SIZE(volgrid_lev%gaid,2)
1863 DO iii=1 ,SIZE(volgrid_lev%gaid,3)
1864 DO iiii=1 ,SIZE(volgrid_lev%gaid,4)
1866 ENDDO
1867 ENDDO
1868 ENDDO
1869 ENDDO
1871ENDIF
1872
1873END SUBROUTINE volgrid6d_compute_vert_coord_var
1874
Restituiscono il valore dell'oggetto nella forma desiderata. Definition: datetime_class.F90:328 Costruttori per le classi datetime e timedelta. Definition: datetime_class.F90:317 Functions that return a trimmed CHARACTER representation of the input variable. Definition: datetime_class.F90:355 Restituiscono il valore dell'oggetto in forma di stringa stampabile. Definition: datetime_class.F90:333 Make a deep copy, if possible, of the grid identifier. Definition: grid_id_class.F90:342 Apply the conversion function this to values. Definition: volgrid6d_var_class.F90:402 This module defines an abstract interface to different drivers for access to files containing gridded... Definition: grid_id_class.F90:255 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. Definition: stat_proc_engine.F90:217 Extension of volgrid6d_class with methods for performing simple statistical operations on entire volu... Definition: volgrid6d_class_compute.F90:220 This module defines objects and methods for managing data volumes on rectangular georeferenced grids. Definition: volgrid6d_class.F90:246 Class for managing physical variables in a grib 1/2 fashion. Definition: volgrid6d_var_class.F90:224 |