101 SUBROUTINE volgrid6d_compute_stat_proc(this, that, stat_proc_input, stat_proc, &
102 step, start, full_steps, frac_valid, max_step, weighted,
clone)
105 INTEGER,
INTENT(in) :: stat_proc_input
106 INTEGER,
INTENT(in) :: stat_proc
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)
227 INTEGER,
INTENT(in) :: stat_proc
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
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)
369 INTEGER,
INTENT(in) :: stat_proc
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
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)
542 INTEGER,
INTENT(in) :: stat_proc
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)
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
Classi per la gestione delle coordinate temporali.
Functions that return a trimmed CHARACTER representation of the input variable.
This module defines an abstract interface to different drivers for access to files containing gridded...
Object describing a rectangular, homogeneous gridded dataset.
Module for basic statistical computations taking into account missing data.
This module defines objects and methods for managing data volumes on rectangular georeferenced grids...
Distruttori per le 2 classi.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Restituiscono il valore dell'oggetto nella forma desiderata.
Costruttori per le classi datetime e timedelta.
Copy an object, creating a fully new instance.
Class for expressing a relative time interval.
Clone the object, creating a new independent instance of the object exactly equal to the starting one...
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...
Emit log message for a category with specific priority.
Derived type defining a dynamically extensible array of TYPE(ttr_mapper) elements.