593TYPE(vol7d_var),
ALLOCATABLE :: varbufr(:)
597CALL volgrid6d_alloc_vol(this)
600lclone = optio_log(clone) .OR. .NOT.
ASSOCIATED(this%voldati)
602CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
603CALL volgrid6d_alloc(that, dim=this%griddim%dim, &
604 nlevel=
SIZE(this%level), nvar=
SIZE(this%var), ini=.false.)
605that%level = this%level
609CALL getval(step, asec=steps)
613CALL recompute_stat_proc_diff_common(this%time, this%timerange, stat_proc, step, &
614 that%time, that%timerange, map_tr, f, keep_tr, &
615 this%time_definition, full_steps, start)
619CALL volgrid6d_alloc_vol(that, decode=
ASSOCIATED(this%voldati))
621IF (.NOT.
ASSOCIATED(that%voldati))
THEN
622 ALLOCATE(voldatiin1(this%griddim%dim%nx, this%griddim%dim%ny), &
623 voldatiin2(this%griddim%dim%nx, this%griddim%dim%ny), &
624 voldatiout(this%griddim%dim%nx, this%griddim%dim%ny))
628DO i4 = 1,
SIZE(this%time)
630 IF (
c_e(keep_tr(i, i4, 2)))
THEN
631 l = keep_tr(i, i4, 1)
632 k = keep_tr(i, i4, 2)
634 CALL l4f_category_log(this%category, l4f_debug, &
635 'volgrid6d_recompute_stat_proc_diff, good timerange: '//
t2c(f(i))// &
638 DO i6 = 1,
SIZE(this%var)
639 DO i3 = 1,
SIZE(this%level)
640 IF (
c_e(this%gaid(i3,i4,f(i),i6)))
THEN
642 CALL copy(this%gaid(i3,i4,f(i),i6), that%gaid(i3,l,k,i6))
644 that%gaid(i3,l,k,i6) = this%gaid(i3,i4,f(i),i6)
646 IF (
ASSOCIATED(that%voldati))
THEN
647 that%voldati(:,:,i3,l,k,i6) = this%voldati(:,:,i3,i4,f(i),i6)
649 CALL volgrid_get_vol_2d(this, i3, i4, f(i), i6, voldatiout)
650 CALL volgrid_set_vol_2d(that, i3, l, k, i6, voldatiout)
660ALLOCATE(varbufr(
SIZE(this%var)))
661DO i6 = 1,
SIZE(this%var)
662 varbufr(i6) =
convert(this%var(i6))
665DO l = 1,
SIZE(this%time)
667 DO j = 1,
SIZE(this%time)
669 IF (
c_e(map_tr(i,j,k,l,1)))
THEN
670 DO i6 = 1,
SIZE(this%var)
671 DO i3 = 1,
SIZE(this%level)
673 IF (
c_e(this%gaid(i3,j,f(i),i6)) .AND. &
674 c_e(this%gaid(i3,l,f(k),i6)))
THEN
678 CALL copy(this%gaid(i3,l,f(k),i6), &
679 that%gaid(i3,map_tr(i,j,k,l,1),map_tr(i,j,k,l,2),i6))
681 that%gaid(i3,map_tr(i,j,k,l,1),map_tr(i,j,k,l,2),i6) = &
682 this%gaid(i3,l,f(k),i6)
686 CALL volgrid_get_vol_2d(this, i3, l, f(k), i6, voldatiin1)
687 CALL volgrid_get_vol_2d(this, i3, j, f(i), i6, voldatiin2)
688 IF (
ASSOCIATED(that%voldati)) &
689 CALL volgrid_get_vol_2d(that, i3, &
690 map_tr(i,j,k,l,1), map_tr(i,j,k,l,2), i6, voldatiout)
692 IF (stat_proc == 0)
THEN
693 WHERE(
c_e(voldatiin1(:,:)) .AND.
c_e(voldatiin2(:,:)))
695 (voldatiin1(:,:)*this%timerange(f(k))%p2 - &
696 voldatiin2(:,:)*this%timerange(f(i))%p2)/ &
699 voldatiout(:,:) = rmiss
701 ELSE IF (stat_proc == 1 .OR. stat_proc == 4)
THEN
702 WHERE(
c_e(voldatiin1(:,:)) .AND.
c_e(voldatiin2(:,:)))
703 voldatiout(:,:) = voldatiin1(:,:) - voldatiin2(:,:)
705 voldatiout(:,:) = rmiss
707 IF (stat_proc == 1)
THEN
708 CALL vol7d_var_features_posdef_apply(varbufr(i6), voldatiout)
712 CALL volgrid_set_vol_2d(that, i3, &
713 map_tr(i,j,k,l,1), map_tr(i,j,k,l,2), i6, voldatiout)
724IF (.NOT.
ASSOCIATED(that%voldati))
THEN
725 DEALLOCATE(voldatiin1, voldatiin2, voldatiout)
728END SUBROUTINE volgrid6d_recompute_stat_proc_diff
758SUBROUTINE volgrid6d_compute_stat_proc_metamorph(this, that, stat_proc_input, stat_proc, clone)
761INTEGER,
INTENT(in) :: stat_proc_input
762INTEGER,
INTENT(in) :: stat_proc
763LOGICAL ,
INTENT(in),
OPTIONAL :: clone
765INTEGER :: j, i3, i4, i6
766INTEGER,
POINTER :: map_tr(:)
767REAL,
POINTER :: voldatiin(:,:), voldatiout(:,:)
768REAL,
ALLOCATABLE :: int_ratio(:)
771NULLIFY(voldatiin, voldatiout)
774CALL volgrid6d_alloc_vol(this)
777lclone = optio_log(clone) .OR. .NOT.
ASSOCIATED(this%voldati)
779IF (.NOT.((stat_proc_input == 0 .AND. stat_proc == 1) .OR. &
780 (stat_proc_input == 1 .AND. stat_proc == 0)))
THEN
782 CALL l4f_category_log(this%category, l4f_warn, &
783 'compute_stat_proc_metamorph, can only be applied to average->accumulated timerange and viceversa')
786 CALL volgrid6d_alloc_vol(that)
791CALL init(that, griddim=this%griddim, time_definition=this%time_definition)
792CALL volgrid6d_alloc(that, dim=this%griddim%dim, ntime=
SIZE(this%time), &
793 nlevel=
SIZE(this%level), nvar=
SIZE(this%var), ini=.false.)
795that%level = this%level
798CALL compute_stat_proc_metamorph_common(stat_proc_input, this%timerange, stat_proc, &
799 that%timerange, map_tr)
802CALL volgrid6d_alloc_vol(that, decode=
ASSOCIATED(this%voldati))
804IF (stat_proc == 0)
THEN
805 int_ratio = 1./real(that%timerange(:)%p2)
807 int_ratio = real(that%timerange(:)%p2)
810DO i6 = 1,
SIZE(this%var)
811 DO j = 1,
SIZE(map_tr)
812 DO i4 = 1,
SIZE(that%time)
813 DO i3 = 1,
SIZE(this%level)
816 CALL copy(this%gaid(i3,i4,map_tr(j),i6), that%gaid(i3,i4,j,i6))
818 that%gaid(i3,i4,map_tr(j),i6) = this%gaid(i3,i4,j,i6)
820 CALL volgrid_get_vol_2d(this, i3, i4, map_tr(j), i6, voldatiin)
821 CALL volgrid_get_vol_2d(that, i3, i4, j, i6, voldatiout)
822 WHERE (
c_e(voldatiin))
823 voldatiout = voldatiin*int_ratio(j)
827 CALL volgrid_set_vol_2d(that, i3, i4, j, i6, voldatiout)
834END SUBROUTINE volgrid6d_compute_stat_proc_metamorph
850SUBROUTINE volgrid6d_compute_vert_coord_var(this, level, volgrid_lev)
852TYPE(vol7d_level),
INTENT(in) :: level
853TYPE(
volgrid6d),
INTENT(out) :: volgrid_lev
855INTEGER :: nlev, i, ii, iii, iiii
857LOGICAL,
ALLOCATABLE :: levmask(:)
860CALL init(volgrid_lev)
861IF (.NOT.
ASSOCIATED(this%gaid))
THEN
862 CALL l4f_log(l4f_error,
'volgrid6d_compute_vert_coord_var: input volume not allocated')
866IF (
c_e(level%level2) .AND. level%level1 /= level%level2)
THEN
867 CALL l4f_log(l4f_error,
'volgrid6d_compute_vert_coord_var: requested (mixed) layer type not valid')
872ALLOCATE(levmask(
SIZE(this%level)))
873levmask = this%level%level1 == level%level1 .AND. &
874 this%level%level2 == level%level2 .AND.
c_e(this%level%l1)
875IF (
c_e(level%level2)) levmask = levmask .AND.
c_e(this%level%l2)
878 CALL l4f_log(l4f_error,
'volgrid6d_compute_vert_coord_var: requested level type not available')
882out_gaid = grid_id_new()
883gaidloop:
DO i=1 ,
SIZE(this%gaid,1)
884 DO ii=1 ,
SIZE(this%gaid,2)
885 DO iii=1 ,
SIZE(this%gaid,3)
886 DO iiii=1 ,
SIZE(this%gaid,4)
887 IF (
c_e(this%gaid(i,ii,iii,iiii)))
THEN
888 CALL copy(this%gaid(i,ii,iii,iiii), out_gaid)
897lev_var =
convert(vol7d_var_new(btable=vol7d_level_to_var(level)), &
898 grid_id_template=out_gaid)
899IF (.NOT.
c_e(lev_var))
THEN
900 CALL l4f_log(l4f_error,
'volgrid6d_compute_vert_coord_var: no variable corresponds to requested level type')
905CALL init(volgrid_lev, griddim=this%griddim, &
906 time_definition=this%time_definition)
907CALL volgrid6d_alloc(volgrid_lev, ntime=
SIZE(this%time), nlevel=nlev, &
908 ntimerange=
SIZE(this%timerange), nvar=1)
910volgrid_lev%time = this%time
911volgrid_lev%level = pack(this%level, mask=levmask)
912volgrid_lev%timerange = this%timerange
913volgrid_lev%var(1) = lev_var
915CALL volgrid6d_alloc_vol(volgrid_lev, decode=.true.)
918 IF (
c_e(level%level2))
THEN
919 volgrid_lev%voldati(:,:,i,:,:,:) = real(volgrid_lev%level(i)%l1 + &
920 volgrid_lev%level(i)%l2)* &
921 vol7d_level_to_var_factor(volgrid_lev%level(i))/2.
923 volgrid_lev%voldati(:,:,i,:,:,:) = real(volgrid_lev%level(i)%l1)* &
924 vol7d_level_to_var_factor(volgrid_lev%level(i))
928IF (
c_e(out_gaid))
THEN
929 DO i=1 ,
SIZE(volgrid_lev%gaid,1)
930 DO ii=1 ,
SIZE(volgrid_lev%gaid,2)
931 DO iii=1 ,
SIZE(volgrid_lev%gaid,3)
932 DO iiii=1 ,
SIZE(volgrid_lev%gaid,4)
933 CALL copy(out_gaid, volgrid_lev%gaid(i,ii,iii,iiii))
941END SUBROUTINE volgrid6d_compute_vert_coord_var