libsim Versione 7.2.4
|
◆ v7d_v7d_transform()
Performs the specified abstract transformation on the data provided. The abstract transformation is specified by this parameter; the corresponding specifical transformation (grid_transform object) is created and destroyed internally. The output transformed object is created internally and it does not require preliminary initialisation. The success of the transformation can be checked with the c_e method: c_e(vol7d_out).
Definizione alla linea 2716 del file volgrid6d_class.F90. 2718
2719 CALL get_val(grid_trans, point_mask=point_mask, output_point_index=point_index)
2720
2721 IF (ALLOCATED(point_index)) THEN
2722 CALL vol7d_alloc(vol7d_out, nanavari=1)
2723 CALL init(vol7d_out%anavar%i(1), 'B01192')
2724 ENDIF
2725
2726 CALL vol7d_alloc_vol(vol7d_out)
2727
2728 IF (ALLOCATED(point_index)) THEN
2729 DO inetwork = 1, SIZE(vol7d_in%network)
2730 vol7d_out%volanai(:,1,inetwork) = point_index(:)
2731 ENDDO
2732 ENDIF
2733 CALL compute(grid_trans, vol7d_in, vol7d_out)
2734
2735 IF (ALLOCATED(point_mask)) THEN ! keep full ana
2736 IF (SIZE(point_mask) /= SIZE(vol7d_in%ana)) THEN
2737 CALL l4f_log(l4f_warn, &
2738 'v7d_v7d_transform: inconsistency in point size: '//t2c(SIZE(point_mask)) &
2739 //':'//t2c(SIZE(vol7d_in%ana)))
2740 ELSE
2741#ifdef DEBUG
2742 CALL l4f_log(l4f_debug, 'v7d_v7d_transform: merging ana from in to out')
2743#endif
2744 CALL vol7d_copy(vol7d_in, vol7d_tmpana, &
2745 lana=point_mask, lnetwork=(/.true./), &
2746 ltime=(/.false./), ltimerange=(/.false./), llevel=(/.false./))
2747 CALL vol7d_append(vol7d_out, vol7d_tmpana)
2748 ENDIF
2749 ENDIF
2750
2751 ELSE
2752 CALL l4f_log(l4f_error, 'v7d_v7d_transform: transformation not valid')
2753 CALL raise_error()
2754 ENDIF
2755
2756ENDIF
2757
2758CALL delete (grid_trans)
2759IF (.NOT. PRESENT(v7d)) CALL delete(v7d_locana)
2760
2761END SUBROUTINE v7d_v7d_transform
2762
2763
2771subroutine vg6d_wind_unrot(this)
2772type(volgrid6d) :: this
2773
2774integer :: component_flag
2775
2776call get_val(this%griddim,component_flag=component_flag)
2777
2778if (component_flag == 1) then
2779 call l4f_category_log(this%category,l4f_info, &
2780 "unrotating vector components")
2781 call vg6d_wind__un_rot(this,.false.)
2782 call set_val(this%griddim,component_flag=0)
2783else
2784 call l4f_category_log(this%category,l4f_info, &
2785 "no need to unrotate vector components")
2786end if
2787
2788end subroutine vg6d_wind_unrot
2789
2790
2796subroutine vg6d_wind_rot(this)
2797type(volgrid6d) :: this
2798
2799integer :: component_flag
2800
2801call get_val(this%griddim,component_flag=component_flag)
2802
2803if (component_flag == 0) then
2804 call l4f_category_log(this%category,l4f_info, &
2805 "rotating vector components")
2806 call vg6d_wind__un_rot(this,.true.)
2807 call set_val(this%griddim,component_flag=1)
2808else
2809 call l4f_category_log(this%category,l4f_info, &
2810 "no need to rotate vector components")
2811end if
2812
2813end subroutine vg6d_wind_rot
2814
2815
2816! Generic UnRotate the wind components.
2817SUBROUTINE vg6d_wind__un_rot(this,rot)
2818TYPE(volgrid6d) :: this ! object containing wind to be (un)rotated
2819LOGICAL :: rot ! if .true. rotate else unrotate
2820
2821INTEGER :: i, j, k, l, a11, a12, a21, a22, stallo
2822double precision,pointer :: rot_mat(:,:,:)
2823real,allocatable :: tmp_arr(:,:)
2824REAL,POINTER :: voldatiu(:,:), voldativ(:,:)
2825INTEGER,POINTER :: iu(:), iv(:)
2826
2827IF (.NOT.ASSOCIATED(this%var)) THEN
2828 CALL l4f_category_log(this%category, l4f_error, &
2829 "trying to unrotate an incomplete volgrid6d object")
2830 CALL raise_fatal_error()
2831! RETURN
2832ENDIF
2833
2834CALL volgrid6d_var_hor_comp_index(this%var, iu, iv)
2835IF (.NOT.ASSOCIATED(iu)) THEN
2836 CALL l4f_category_log(this%category,l4f_error, &
2837 "unrotation impossible")
2838 CALL raise_fatal_error()
2839! RETURN
2840ENDIF
2841
2842! Temporary workspace
2843ALLOCATE(tmp_arr(this%griddim%dim%nx, this%griddim%dim%ny),stat=stallo)
2844IF (stallo /= 0) THEN
2845 CALL l4f_category_log(this%category, l4f_fatal, "allocating memory")
2846 CALL raise_fatal_error()
2847ENDIF
2848! allocate once for speed
2849IF (.NOT.ASSOCIATED(this%voldati)) THEN
2850 ALLOCATE(voldatiu(this%griddim%dim%nx, this%griddim%dim%ny), &
2851 voldativ(this%griddim%dim%nx, this%griddim%dim%ny))
2852ENDIF
2853
2854CALL griddim_unproj(this%griddim)
2855CALL wind_unrot(this%griddim, rot_mat)
2856
2857a11=1
2858if (rot)then
2859 a12=2
2860 a21=3
2861else
2862 a12=3
2863 a21=2
2864end if
2865a22=4
2866
2867DO l = 1, SIZE(iu)
2868 DO k = 1, SIZE(this%timerange)
2869 DO j = 1, SIZE(this%time)
2870 DO i = 1, SIZE(this%level)
2871! get data
2872 CALL volgrid_get_vol_2d(this, i, j, k, iu(l), voldatiu)
2873 CALL volgrid_get_vol_2d(this, i, j, k, iv(l), voldativ)
2874! convert units forward
2875! CALL compute(conv_fwd(iu(l)), voldatiu)
2876! CALL compute(conv_fwd(iv(l)), voldativ)
2877
2878! multiply wind components by rotation matrix
2879 WHERE(voldatiu /= rmiss .AND. voldativ /= rmiss)
2880 tmp_arr(:,:) = real(voldatiu(:,:)*rot_mat(:,:,a11) + &
2881 voldativ(:,:)*rot_mat(:,:,a12))
2882 voldativ(:,:) = real(voldatiu(:,:)*rot_mat(:,:,a21) + &
2883 voldativ(:,:)*rot_mat(:,:,a22))
2884 voldatiu(:,:) = tmp_arr(:,:)
2885 END WHERE
2886! convert units backward
2887! CALL uncompute(conv_fwd(iu(l)), voldatiu)
2888! CALL uncompute(conv_fwd(iv(l)), voldativ)
2889! put data
2890 CALL volgrid_set_vol_2d(this, i, j, k, iu(l), voldatiu)
2891 CALL volgrid_set_vol_2d(this, i, j, k, iv(l), voldativ)
2892 ENDDO
2893 ENDDO
2894 ENDDO
2895ENDDO
2896
2897IF (.NOT.ASSOCIATED(this%voldati)) THEN
2898 DEALLOCATE(voldatiu, voldativ)
2899ENDIF
2900DEALLOCATE(rot_mat, tmp_arr, iu, iv)
2901
2902END SUBROUTINE vg6d_wind__un_rot
2903
2904
2905!!$ try to understand the problem:
2906!!$
2907!!$ case:
2908!!$
2909!!$ 1) we have only one volume: we have to provide the direction of shift
2910!!$ compute H and traslate on it
2911!!$ 2) we have two volumes:
2912!!$ 1) volume U and volume V: compute H and traslate on it
2913!!$ 2) volume U/V and volume H : translate U/V on H
2914!!$ 3) we have tree volumes: translate U and V on H
2915!!$
2916!!$ strange cases:
2917!!$ 1) do not have U in volume U
2918!!$ 2) do not have V in volume V
2919!!$ 3) we have others variables more than U and V in volumes U e V
2920!!$
2921!!$
2922!!$ so the steps are:
2923!!$ 1) find the volumes
2924!!$ 2) define or compute H grid
2925!!$ 3) trasform the volumes in H
2926
2927!!$ N.B.
2928!!$ case 1) for only one vg6d (U or V) is not managed, but
2929!!$ the not pubblic subroutines will work but you have to know what you want to do
2930
2931
2948subroutine vg6d_c2a (this)
|