101 SUBROUTINE volgrid6d_compute_stat_proc(this, that, stat_proc_input, stat_proc, &
102 step, start, full_steps, frac_valid, max_step, weighted, clone)
103 TYPE(volgrid6d),
INTENT(inout) :: this
104 TYPE(volgrid6d),
INTENT(out) :: that
105 INTEGER,
INTENT(in) :: stat_proc_input
106 INTEGER,
INTENT(in) :: stat_proc
107 TYPE(timedelta),
INTENT(in) :: step
108 TYPE(datetime),
INTENT(in),
OPTIONAL :: start
109 LOGICAL,
INTENT(in),
OPTIONAL :: full_steps
110 REAL,
INTENT(in),
OPTIONAL :: frac_valid
111 TYPE(timedelta),
INTENT(in),
OPTIONAL :: max_step
112 LOGICAL,
INTENT(in),
OPTIONAL :: weighted
113 LOGICAL ,
INTENT(in),
OPTIONAL :: clone
115 INTEGER :: dtmax, dtstep
118 IF (stat_proc_input == 254)
THEN 120 'computing statistical processing by aggregation '//&
123 CALL volgrid6d_compute_stat_proc_agg(this, that, stat_proc, &
124 step, start, max_step,
clone)
126 ELSE IF (stat_proc == 254)
THEN 128 'statistical processing to instantaneous data not implemented for gridded fields')
131 ELSE IF (stat_proc_input /= stat_proc)
THEN 132 IF ((stat_proc_input == 0 .AND. stat_proc == 1) .OR. &
133 (stat_proc_input == 1 .AND. stat_proc == 0))
THEN 135 'computing statistically processed data by integration/differentiation '// &
136 t2c(stat_proc_input)//
':'//
t2c(stat_proc))
137 CALL volgrid6d_compute_stat_proc_metamorph(this, that, stat_proc_input, &
141 'statistical processing '//
t2c(stat_proc_input)//
':'//
t2c(stat_proc)// &
142 ' not implemented or does not make sense')
146 ELSE IF (count(this%timerange(:)%timerange == stat_proc) == 0)
THEN 148 'no timeranges of the desired statistical processing type '//
t2c(stat_proc)//
' available')
151 CALL volgrid6d_alloc_vol(that)
155 dtmax = maxval(this%timerange(:)%p2, &
156 mask=(this%timerange(:)%timerange == stat_proc))
157 CALL getval(step, asec=dtstep)
161 'stat_proc='//
t2c(stat_proc)//
' dtmax='//
t2c(dtmax)//
' dtstep='//
t2c(dtstep))
164 IF (dtstep < dtmax)
THEN 166 'recomputing statistically processed data by difference '// &
167 t2c(stat_proc_input)//
':'//
t2c(stat_proc))
168 CALL volgrid6d_recompute_stat_proc_diff(this, that, stat_proc, step, &
169 full_steps, start,
clone)
172 'recomputing statistically processed data by aggregation '// &
173 t2c(stat_proc_input)//
':'//
t2c(stat_proc))
174 CALL volgrid6d_recompute_stat_proc_agg(this, that, stat_proc, step, start, &
180 END SUBROUTINE volgrid6d_compute_stat_proc
224 SUBROUTINE volgrid6d_recompute_stat_proc_agg(this, that, stat_proc, step, start, frac_valid, clone)
225 TYPE(volgrid6d),
INTENT(inout) :: this
226 TYPE(volgrid6d),
INTENT(out) :: that
227 INTEGER,
INTENT(in) :: stat_proc
228 TYPE(timedelta),
INTENT(in) :: step
229 TYPE(datetime),
INTENT(in),
OPTIONAL :: start
230 REAL,
INTENT(in),
OPTIONAL :: frac_valid
231 LOGICAL,
INTENT(in),
OPTIONAL :: clone
234 INTEGER i, j, n, n1, ndtr, i3, i6
235 TYPE(arrayof_ttr_mapper),
POINTER :: map_ttr(:,:)
236 INTEGER,
POINTER :: dtratio(:)
239 REAL,
POINTER :: voldatiin(:,:), voldatiout(:,:)
242 NULLIFY(voldatiin, voldatiout)
244 IF (
PRESENT(frac_valid))
THEN 245 lfrac_valid = frac_valid
252 CALL volgrid6d_alloc_vol(this)
256 lclone = optio_log(
clone) .OR. .NOT.
ASSOCIATED(this%voldati)
258 CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
259 CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntimerange=1, &
260 nlevel=
SIZE(this%level), nvar=
SIZE(this%var), ini=.false.)
261 that%level = this%level
264 CALL recompute_stat_proc_agg_common(this%time, this%timerange, stat_proc, tri, &
265 step, this%time_definition, that%time, that%timerange, map_ttr, &
266 dtratio=dtratio, start=start)
268 CALL volgrid6d_alloc_vol(that, decode=
ASSOCIATED(this%voldati))
270 do_otimerange:
DO j = 1,
SIZE(that%timerange)
271 do_otime:
DO i = 1,
SIZE(that%time)
273 DO n1 = 1,
SIZE(dtratio)
274 IF (dtratio(n1) <= 0) cycle
276 DO i6 = 1,
SIZE(this%var)
277 DO i3 = 1,
SIZE(this%level)
278 CALL volgrid_get_vol_2d(that, i3, i, j, i6, voldatiout)
280 DO n = 1, map_ttr(i,j)%arraysize
281 IF (map_ttr(i,j)%array(n)%extra_info == dtratio(n1))
THEN 283 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(n)%it, &
284 map_ttr(i,j)%array(n)%itr, i6, voldatiin)
287 voldatiout = voldatiin
289 CALL copy(this%gaid(i3, map_ttr(i,j)%array(n)%it,&
290 map_ttr(i,j)%array(n)%itr,i6), that%gaid(i3,i,j,i6))
292 that%gaid(i3,i,j,i6) = this%gaid(i3, map_ttr(i,j)%array(n)%it, &
293 map_ttr(i,j)%array(n)%itr,i6)
297 SELECT CASE(stat_proc)
299 WHERE(
c_e(voldatiin(:,:)) .AND.
c_e(voldatiout(:,:)))
300 voldatiout(:,:) = voldatiout(:,:) + voldatiin(:,:)
302 voldatiout(:,:) = rmiss
305 WHERE(
c_e(voldatiin(:,:)) .AND.
c_e(voldatiout(:,:)))
306 voldatiout(:,:) = max(voldatiout(:,:), voldatiin(:,:))
308 voldatiout(:,:) = rmiss
311 WHERE(
c_e(voldatiin(:,:)) .AND.
c_e(voldatiout(:,:)))
312 voldatiout(:,:) = min(voldatiout(:,:), voldatiin(:,:))
314 voldatiout(:,:) = rmiss
322 IF (
REAL(ndtr)/
REAL(dtratio(n1)) >= lfrac_valid)
THEN 323 IF (stat_proc == 0)
THEN 324 WHERE(
c_e(voldatiout(:,:)))
325 voldatiout(:,:) = voldatiout(:,:)/ndtr
328 CALL volgrid_set_vol_2d(that, i3, i, j, i6, voldatiout)
338 DEALLOCATE(dtratio, map_ttr)
340 END SUBROUTINE volgrid6d_recompute_stat_proc_agg
366 SUBROUTINE volgrid6d_compute_stat_proc_agg(this, that, stat_proc, step, start, max_step, clone)
367 TYPE(volgrid6d),
INTENT(inout) :: this
368 TYPE(volgrid6d),
INTENT(out) :: that
369 INTEGER,
INTENT(in) :: stat_proc
370 TYPE(timedelta),
INTENT(in) :: step
371 TYPE(datetime),
INTENT(in),
OPTIONAL :: start
372 TYPE(timedelta),
INTENT(in),
OPTIONAL :: max_step
373 LOGICAL ,
INTENT(in),
OPTIONAL :: clone
376 INTEGER i, j, n, ninp, i3, i6
377 TYPE(arrayof_ttr_mapper),
POINTER :: map_ttr(:,:)
378 TYPE(timedelta) :: lmax_step
380 REAL,
POINTER :: voldatiin(:,:), voldatiout(:,:)
383 NULLIFY(voldatiin, voldatiout)
385 IF (
PRESENT(max_step))
THEN 388 lmax_step = timedelta_max
393 CALL volgrid6d_alloc_vol(this)
397 lclone = optio_log(
clone) .OR. .NOT.
ASSOCIATED(this%voldati)
399 CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
400 CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntimerange=1, &
401 nlevel=
SIZE(this%level), nvar=
SIZE(this%var), ini=.false.)
402 that%level = this%level
405 CALL recompute_stat_proc_agg_common(this%time, this%timerange, stat_proc, tri, &
406 step, this%time_definition, that%time, that%timerange, map_ttr, start=start)
408 CALL volgrid6d_alloc_vol(that, decode=
ASSOCIATED(this%voldati))
410 do_otimerange:
DO j = 1,
SIZE(that%timerange)
411 do_otime:
DO i = 1,
SIZE(that%time)
412 ninp = map_ttr(i,j)%arraysize
413 IF (ninp <= 0) cycle do_otime
415 IF (stat_proc == 4)
THEN 416 IF (map_ttr(i,j)%array(1)%extra_info /= 1 .OR. &
417 map_ttr(i,j)%array(ninp)%extra_info /= 2)
THEN 424 IF (map_ttr(i,j)%array(n)%time - map_ttr(i,j)%array(n-1)%time > &
432 DO i6 = 1,
SIZE(this%var)
433 DO i3 = 1,
SIZE(this%level)
434 CALL volgrid_get_vol_2d(that, i3, i, j, i6, voldatiout)
436 IF (stat_proc == 4)
THEN 438 CALL copy(this%gaid(i3, map_ttr(i,j)%array(1)%it,&
439 map_ttr(i,j)%array(1)%itr,i6), that%gaid(i3,i,j,i6))
441 that%gaid(i3,i,j,i6) = this%gaid(i3, map_ttr(i,j)%array(1)%it, &
442 map_ttr(i,j)%array(1)%itr,i6)
445 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(ninp)%it, &
446 map_ttr(i,j)%array(ninp)%itr, i6, voldatiin)
447 voldatiout = voldatiin
448 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(1)%it, &
449 map_ttr(i,j)%array(1)%itr, i6, voldatiin)
451 WHERE(
c_e(voldatiin(:,:)) .AND.
c_e(voldatiout(:,:)))
452 voldatiout(:,:) = voldatiout(:,:) - voldatiin(:,:)
454 voldatiout(:,:) = rmiss
459 CALL volgrid_get_vol_2d(this, i3, map_ttr(i,j)%array(n)%it, &
460 map_ttr(i,j)%array(n)%itr, i6, voldatiin)
463 voldatiout = voldatiin
465 CALL copy(this%gaid(i3, map_ttr(i,j)%array(n)%it,&
466 map_ttr(i,j)%array(n)%itr,i6), that%gaid(i3,i,j,i6))
468 that%gaid(i3,i,j,i6) = this%gaid(i3, map_ttr(i,j)%array(n)%it, &
469 map_ttr(i,j)%array(n)%itr,i6)
473 SELECT CASE(stat_proc)
475 WHERE(
c_e(voldatiin(:,:)) .AND.
c_e(voldatiout(:,:)))
476 voldatiout(:,:) = voldatiout(:,:) + voldatiin(:,:)
478 voldatiout(:,:) = rmiss
481 WHERE(
c_e(voldatiin(:,:)) .AND.
c_e(voldatiout(:,:)))
482 voldatiout(:,:) = max(voldatiout(:,:), voldatiin(:,:))
484 voldatiout(:,:) = rmiss
487 WHERE(
c_e(voldatiin(:,:)) .AND.
c_e(voldatiout(:,:)))
488 voldatiout(:,:) = min(voldatiout(:,:), voldatiin(:,:))
490 voldatiout(:,:) = rmiss
496 IF (stat_proc == 0)
THEN 497 WHERE(
c_e(voldatiout(:,:)))
498 voldatiout(:,:) = voldatiout(:,:)/ninp
502 CALL volgrid_set_vol_2d(that, i3, i, j, i6, voldatiout)
512 END SUBROUTINE volgrid6d_compute_stat_proc_agg
539 SUBROUTINE volgrid6d_recompute_stat_proc_diff(this, that, stat_proc, step, full_steps, start, clone)
540 TYPE(volgrid6d),
INTENT(inout) :: this
541 TYPE(volgrid6d),
INTENT(out) :: that
542 INTEGER,
INTENT(in) :: stat_proc
543 TYPE(timedelta),
INTENT(in) :: step
544 LOGICAL,
INTENT(in),
OPTIONAL :: full_steps
545 TYPE(datetime),
INTENT(in),
OPTIONAL :: start
546 LOGICAL,
INTENT(in),
OPTIONAL :: clone
547 INTEGER :: i3, i4, i6, i, j, k, l, nitr, steps
548 INTEGER,
POINTER :: map_tr(:,:,:,:,:), f(:)
549 REAL,
POINTER :: voldatiin1(:,:), voldatiin2(:,:), voldatiout(:,:)
550 LOGICAL,
POINTER :: mask_timerange(:)
555 CALL volgrid6d_alloc_vol(this)
558 lclone = optio_log(
clone) .OR. .NOT.
ASSOCIATED(this%voldati)
560 CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
561 CALL volgrid6d_alloc(that, dim=this%griddim%dim, &
562 nlevel=
SIZE(this%level), nvar=
SIZE(this%var), ini=.false.)
563 that%level = this%level
567 CALL getval(step, asec=steps)
571 CALL recompute_stat_proc_diff_common(this%time, this%timerange, stat_proc, step, &
572 nitr, that%time, that%timerange, map_tr, f, mask_timerange, &
573 this%time_definition, full_steps, start)
576 CALL volgrid6d_alloc_vol(that, decode=
ASSOCIATED(this%voldati))
578 IF (.NOT.
ASSOCIATED(that%voldati))
THEN 579 ALLOCATE(voldatiin1(this%griddim%dim%nx, this%griddim%dim%ny), &
580 voldatiin2(this%griddim%dim%nx, this%griddim%dim%ny), &
581 voldatiout(this%griddim%dim%nx, this%griddim%dim%ny))
585 DO i = 1,
SIZE(mask_timerange)
586 IF (mask_timerange(i))
THEN 587 k = firsttrue(that%timerange(:) == this%timerange(i))
590 'volgrid6d_recompute_stat_proc_diff, good timerange: '//
t2c(i)// &
595 DO i6 = 1,
SIZE(this%var)
596 DO i4 = 1,
SIZE(this%time)
597 l = firsttrue(that%time(:) == this%time(i4))
599 DO i3 = 1,
SIZE(this%level)
600 IF (
c_e(this%gaid(i3,i4,i,i6)))
THEN 602 CALL copy(this%gaid(i3,i4,i,i6), that%gaid(i3,l,k,i6))
604 that%gaid(i3,l,k,i6) = this%gaid(i3,i4,i,i6)
606 IF (
ASSOCIATED(that%voldati))
THEN 607 that%voldati(:,:,i3,l,k,i6) = this%voldati(:,:,i3,i4,i,i6)
609 CALL volgrid_get_vol_2d(this, i3, i4, i, i6, voldatiout)
610 CALL volgrid_set_vol_2d(that, i3, l, k, i6, voldatiout)
623 DO l = 1,
SIZE(this%time)
625 DO j = 1,
SIZE(this%time)
627 IF (
c_e(map_tr(i,j,k,l,1)))
THEN 628 DO i6 = 1,
SIZE(this%var)
629 DO i3 = 1,
SIZE(this%level)
631 IF (
c_e(this%gaid(i3,j,f(i),i6)) .AND. &
632 c_e(this%gaid(i3,l,f(k),i6)))
THEN 636 CALL copy(this%gaid(i3,l,f(k),i6), &
637 that%gaid(i3,map_tr(i,j,k,l,1),map_tr(i,j,k,l,2),i6))
639 that%gaid(i3,map_tr(i,j,k,l,1),map_tr(i,j,k,l,2),i6) = &
640 this%gaid(i3,l,f(k),i6)
644 CALL volgrid_get_vol_2d(this, i3, l, f(k), i6, voldatiin1)
645 CALL volgrid_get_vol_2d(this, i3, j, f(i), i6, voldatiin2)
646 IF (
ASSOCIATED(that%voldati)) &
647 CALL volgrid_get_vol_2d(that, i3, &
648 map_tr(i,j,k,l,1), map_tr(i,j,k,l,2), i6, voldatiout)
650 IF (stat_proc == 0)
THEN 651 WHERE(
c_e(voldatiin1(:,:)) .AND.
c_e(voldatiin2(:,:)))
653 (voldatiin1(:,:)*this%timerange(f(k))%p2 - &
654 voldatiin2(:,:)*this%timerange(f(i))%p2)/ &
657 voldatiout(:,:) = rmiss
659 ELSE IF (stat_proc == 1 .OR. stat_proc == 4)
THEN 660 WHERE(
c_e(voldatiin1(:,:)) .AND.
c_e(voldatiin2(:,:)))
661 voldatiout(:,:) = voldatiin1(:,:) - voldatiin2(:,:)
663 voldatiout(:,:) = rmiss
667 CALL volgrid_set_vol_2d(that, i3, &
668 map_tr(i,j,k,l,1), map_tr(i,j,k,l,2), i6, voldatiout)
679 IF (.NOT.
ASSOCIATED(that%voldati))
THEN 680 DEALLOCATE(voldatiin1, voldatiin2, voldatiout)
683 END SUBROUTINE volgrid6d_recompute_stat_proc_diff
713 SUBROUTINE volgrid6d_compute_stat_proc_metamorph(this, that, stat_proc_input, stat_proc, clone)
714 TYPE(volgrid6d),
INTENT(inout) :: this
715 TYPE(volgrid6d),
INTENT(out) :: that
716 INTEGER,
INTENT(in) :: stat_proc_input
717 INTEGER,
INTENT(in) :: stat_proc
718 LOGICAL ,
INTENT(in),
OPTIONAL :: clone
720 INTEGER i, j, n, i3, i4, i6
721 INTEGER,
POINTER :: map_tr(:), map_trc(:,:), count_trc(:,:)
722 REAL,
POINTER :: voldatiin(:,:), voldatiout(:,:)
723 REAL,
ALLOCATABLE :: int_ratio(:)
726 NULLIFY(voldatiin, voldatiout)
729 CALL volgrid6d_alloc_vol(this)
732 lclone = optio_log(
clone) .OR. .NOT.
ASSOCIATED(this%voldati)
734 IF (.NOT.((stat_proc_input == 0 .AND. stat_proc == 1) .OR. &
735 (stat_proc_input == 1 .AND. stat_proc == 0)))
THEN 738 'compute_stat_proc_metamorph, can only be applied to average->accumulated timerange and viceversa')
741 CALL volgrid6d_alloc_vol(that)
746 CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
747 CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntime=
SIZE(this%time), &
748 nlevel=
SIZE(this%level), nvar=
SIZE(this%var), ini=.false.)
749 that%time = this%time
750 that%level = this%level
753 CALL compute_stat_proc_metamorph_common(stat_proc_input, this%timerange, stat_proc, &
754 that%timerange, map_tr)
757 CALL volgrid6d_alloc_vol(that, decode=
ASSOCIATED(this%voldati))
759 IF (stat_proc == 0)
THEN 760 int_ratio = 1./
REAL(that%timerange(:)%p2)
762 int_ratio =
REAL(that%timerange(:)%p2)
765 DO i6 = 1,
SIZE(this%var)
766 DO j = 1,
SIZE(map_tr)
767 DO i4 = 1,
SIZE(that%time)
768 DO i3 = 1,
SIZE(this%level)
771 CALL copy(this%gaid(i3,i4,map_tr(j),i6), that%gaid(i3,i4,j,i6))
773 that%gaid(i3,i4,map_tr(j),i6) = this%gaid(i3,i4,j,i6)
775 CALL volgrid_get_vol_2d(this, i3, i4, map_tr(j), i6, voldatiin)
776 CALL volgrid_get_vol_2d(that, i3, i4, j, i6, voldatiout)
777 WHERE (
c_e(voldatiin))
778 voldatiout = voldatiin*int_ratio(j)
782 CALL volgrid_set_vol_2d(that, i3, i4, j, i6, voldatiout)
789 END SUBROUTINE volgrid6d_compute_stat_proc_metamorph
Costruttore per la classe vol7d_level.
Distruttore per la classe vol7d_level.
Functions that return a trimmed CHARACTER representation of the input variable.
Represent level object in a pretty string.
This module contains functions that are only for internal use of the library.
This module defines an abstract interface to different drivers for access to files containing gridded...
Classi per la gestione delle coordinate temporali.
This module defines objects and methods for managing data volumes on rectangular georeferenced grids...
Restituiscono il valore dell'oggetto nella forma desiderata.
Clone the object, creating a new independent instance of the object exactly equal to the starting one...
Module for basic statistical computations taking into account missing data.
Extension of volgrid6d_class with methods for performing simple statistical operations on entire volu...
Emit log message for a category with specific priority.