libsim  Versione 7.1.6

◆ v7d_v7d_transform()

subroutine volgrid6d_class::v7d_v7d_transform ( type(transform_def), intent(in)  this,
type(vol7d), intent(inout)  vol7d_in,
type(vol7d), intent(out)  vol7d_out,
type(vol7d), intent(in), optional  v7d,
real, dimension(:), intent(in), optional  maskbounds,
type(vol7d_level), dimension(:), intent(in), optional, target  lev_out,
type(vol7d), intent(in), optional  vol7d_coord_in,
character(len=*), intent(in), optional  categoryappend 
)
private

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).

Parametri
[in]thisobject specifying the abstract transformation
[in,out]vol7d_inobject to be transformed, it is not modified, despite the INTENT(inout)
[out]vol7d_outtransformed object, it does not require initialisation
[in]v7dobject containing a list of points over which transformation has to be done (required by some transformation types)
[in]maskboundsarray of boundary values for defining a subset of valid points where the values of maskgrid are within the first and last value of maskbounds (for transformation type 'metamorphosis:maskfill')
[in]lev_outvol7d_level object defining target vertical grid, for vertical interpolations
[in]vol7d_coord_inobject providing time constant input vertical coordinate for some kind of vertical interpolations
[in]categoryappendappend this suffix to log4fortran namespace category

Definizione alla linea 2722 del file volgrid6d_class.F90.

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 
2756 ENDIF
2757 
2758 CALL delete (grid_trans)
2759 IF (.NOT. PRESENT(v7d)) CALL delete(v7d_locana)
2760 
2761 END SUBROUTINE v7d_v7d_transform
2762 
2763 
2771 subroutine vg6d_wind_unrot(this)
2772 type(volgrid6d) :: this
2773 
2774 integer :: component_flag
2775 
2776 call get_val(this%griddim,component_flag=component_flag)
2777 
2778 if (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)
2783 else
2784  call l4f_category_log(this%category,l4f_info, &
2785  "no need to unrotate vector components")
2786 end if
2787 
2788 end subroutine vg6d_wind_unrot
2789 
2790 
2796 subroutine vg6d_wind_rot(this)
2797 type(volgrid6d) :: this
2798 
2799 integer :: component_flag
2800 
2801 call get_val(this%griddim,component_flag=component_flag)
2802 
2803 if (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)
2808 else
2809  call l4f_category_log(this%category,l4f_info, &
2810  "no need to rotate vector components")
2811 end if
2812 
2813 end subroutine vg6d_wind_rot
2814 
2815 
2816 ! Generic UnRotate the wind components.
2817 SUBROUTINE vg6d_wind__un_rot(this,rot)
2818 TYPE(volgrid6d) :: this ! object containing wind to be (un)rotated
2819 LOGICAL :: rot ! if .true. rotate else unrotate
2820 
2821 INTEGER :: i, j, k, l, a11, a12, a21, a22, stallo
2822 double precision,pointer :: rot_mat(:,:,:)
2823 real,allocatable :: tmp_arr(:,:)
2824 REAL,POINTER :: voldatiu(:,:), voldativ(:,:)
2825 INTEGER,POINTER :: iu(:), iv(:)
2826 
2827 IF (.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
2832 ENDIF
2833 
2834 CALL volgrid6d_var_hor_comp_index(this%var, iu, iv)
2835 IF (.NOT.ASSOCIATED(iu)) THEN
2836  CALL l4f_category_log(this%category,l4f_error, &
2837  "unrotation impossible")
2838  CALL raise_fatal_error()
2839 ! RETURN
2840 ENDIF
2841 
2842 ! Temporary workspace
2843 ALLOCATE(tmp_arr(this%griddim%dim%nx, this%griddim%dim%ny),stat=stallo)
2844 IF (stallo /= 0) THEN
2845  CALL l4f_category_log(this%category, l4f_fatal, "allocating memory")
2846  CALL raise_fatal_error()
2847 ENDIF
2848 ! allocate once for speed
2849 IF (.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))
2852 ENDIF
2853 
2854 CALL griddim_unproj(this%griddim)
2855 CALL wind_unrot(this%griddim, rot_mat)
2856 
2857 a11=1
2858 if (rot)then
2859  a12=2
2860  a21=3
2861 else
2862  a12=3
2863  a21=2
2864 end if
2865 a22=4
2866 
2867 DO 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
2895 ENDDO
2896 
2897 IF (.NOT.ASSOCIATED(this%voldati)) THEN
2898  DEALLOCATE(voldatiu, voldativ)
2899 ENDIF
2900 DEALLOCATE(rot_mat, tmp_arr, iu, iv)
2901 
2902 END 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 
2948 subroutine vg6d_c2a (this)
2949 
2950 TYPE(volgrid6d),INTENT(inout) :: this(:)
2951 
2952 integer :: ngrid,igrid,jgrid,ugrid,vgrid,tgrid
2953 doubleprecision :: xmin, xmax, ymin, ymax
2954 doubleprecision :: xmin_t, xmax_t, ymin_t, ymax_t

Generated with Doxygen.