libsim  Versione7.2.6

◆ v7d_v7d_transform()

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

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 2776 del file volgrid6d_class.F90.

2776  IF (ALLOCATED(point_index)) THEN
2777  DO inetwork = 1, SIZE(vol7d_in%network)
2778  vol7d_out%volanai(:,1,inetwork) = point_index(:)
2779  ENDDO
2780  ENDIF
2781  CALL compute(grid_trans, vol7d_in, vol7d_out)
2782 
2783  IF (ALLOCATED(point_mask)) THEN ! keep full ana
2784  IF (SIZE(point_mask) /= SIZE(vol7d_in%ana)) THEN
2785  CALL l4f_log(l4f_warn, &
2786  'v7d_v7d_transform: inconsistency in point size: '//t2c(SIZE(point_mask)) &
2787  //':'//t2c(SIZE(vol7d_in%ana)))
2788  ELSE
2789 #ifdef DEBUG
2790  CALL l4f_log(l4f_debug, 'v7d_v7d_transform: merging ana from in to out')
2791 #endif
2792  CALL vol7d_copy(vol7d_in, vol7d_tmpana, &
2793  lana=point_mask, lnetwork=(/.true./), &
2794  ltime=(/.false./), ltimerange=(/.false./), llevel=(/.false./))
2795  CALL vol7d_append(vol7d_out, vol7d_tmpana)
2796  ENDIF
2797  ENDIF
2798 
2799  ELSE
2800  CALL l4f_log(l4f_error, 'v7d_v7d_transform: transformation not valid')
2801  CALL raise_error()
2802  ENDIF
2803 
2804 ENDIF
2805 
2806 CALL delete (grid_trans)
2807 IF (.NOT. PRESENT(v7d)) CALL delete(v7d_locana)
2808 
2809 END SUBROUTINE v7d_v7d_transform
2810 
2811 
2819 subroutine vg6d_wind_unrot(this)
2820 type(volgrid6d) :: this
2821 
2822 integer :: component_flag
2823 
2824 call get_val(this%griddim,component_flag=component_flag)
2825 
2826 if (component_flag == 1) then
2827  call l4f_category_log(this%category,l4f_info, &
2828  "unrotating vector components")
2829  call vg6d_wind__un_rot(this,.false.)
2830  call set_val(this%griddim,component_flag=0)
2831 else
2832  call l4f_category_log(this%category,l4f_info, &
2833  "no need to unrotate vector components")
2834 end if
2835 
2836 end subroutine vg6d_wind_unrot
2837 
2838 
2844 subroutine vg6d_wind_rot(this)
2845 type(volgrid6d) :: this
2846 
2847 integer :: component_flag
2848 
2849 call get_val(this%griddim,component_flag=component_flag)
2850 
2851 if (component_flag == 0) then
2852  call l4f_category_log(this%category,l4f_info, &
2853  "rotating vector components")
2854  call vg6d_wind__un_rot(this,.true.)
2855  call set_val(this%griddim,component_flag=1)
2856 else
2857  call l4f_category_log(this%category,l4f_info, &
2858  "no need to rotate vector components")
2859 end if
2860 
2861 end subroutine vg6d_wind_rot
2862 
2863 
2864 ! Generic UnRotate the wind components.
2865 SUBROUTINE vg6d_wind__un_rot(this,rot)
2866 TYPE(volgrid6d) :: this ! object containing wind to be (un)rotated
2867 LOGICAL :: rot ! if .true. rotate else unrotate
2868 
2869 INTEGER :: i, j, k, l, a11, a12, a21, a22, stallo
2870 double precision,pointer :: rot_mat(:,:,:)
2871 real,allocatable :: tmp_arr(:,:)
2872 REAL,POINTER :: voldatiu(:,:), voldativ(:,:)
2873 INTEGER,POINTER :: iu(:), iv(:)
2874 
2875 IF (.NOT.ASSOCIATED(this%var)) THEN
2876  CALL l4f_category_log(this%category, l4f_error, &
2877  "trying to unrotate an incomplete volgrid6d object")
2878  CALL raise_fatal_error()
2879 ! RETURN
2880 ENDIF
2881 
2882 CALL volgrid6d_var_hor_comp_index(this%var, iu, iv)
2883 IF (.NOT.ASSOCIATED(iu)) THEN
2884  CALL l4f_category_log(this%category,l4f_error, &
2885  "unrotation impossible")
2886  CALL raise_fatal_error()
2887 ! RETURN
2888 ENDIF
2889 
2890 ! Temporary workspace
2891 ALLOCATE(tmp_arr(this%griddim%dim%nx, this%griddim%dim%ny),stat=stallo)
2892 IF (stallo /= 0) THEN
2893  CALL l4f_category_log(this%category, l4f_fatal, "allocating memory")
2894  CALL raise_fatal_error()
2895 ENDIF
2896 ! allocate once for speed
2897 IF (.NOT.ASSOCIATED(this%voldati)) THEN
2898  ALLOCATE(voldatiu(this%griddim%dim%nx, this%griddim%dim%ny), &
2899  voldativ(this%griddim%dim%nx, this%griddim%dim%ny))
2900 ENDIF
2901 
2902 CALL griddim_unproj(this%griddim)
2903 CALL wind_unrot(this%griddim, rot_mat)
2904 
2905 a11=1
2906 if (rot)then
2907  a12=2
2908  a21=3
2909 else
2910  a12=3
2911  a21=2
2912 end if
2913 a22=4
2914 
2915 DO l = 1, SIZE(iu)
2916  DO k = 1, SIZE(this%timerange)
2917  DO j = 1, SIZE(this%time)
2918  DO i = 1, SIZE(this%level)
2919 ! get data
2920  CALL volgrid_get_vol_2d(this, i, j, k, iu(l), voldatiu)
2921  CALL volgrid_get_vol_2d(this, i, j, k, iv(l), voldativ)
2922 ! convert units forward
2923 ! CALL compute(conv_fwd(iu(l)), voldatiu)
2924 ! CALL compute(conv_fwd(iv(l)), voldativ)
2925 
2926 ! multiply wind components by rotation matrix
2927  WHERE(voldatiu /= rmiss .AND. voldativ /= rmiss)
2928  tmp_arr(:,:) = real(voldatiu(:,:)*rot_mat(:,:,a11) + &
2929  voldativ(:,:)*rot_mat(:,:,a12))
2930  voldativ(:,:) = real(voldatiu(:,:)*rot_mat(:,:,a21) + &
2931  voldativ(:,:)*rot_mat(:,:,a22))
2932  voldatiu(:,:) = tmp_arr(:,:)
2933  END WHERE
2934 ! convert units backward
2935 ! CALL uncompute(conv_fwd(iu(l)), voldatiu)
2936 ! CALL uncompute(conv_fwd(iv(l)), voldativ)
2937 ! put data
2938  CALL volgrid_set_vol_2d(this, i, j, k, iu(l), voldatiu)
2939  CALL volgrid_set_vol_2d(this, i, j, k, iv(l), voldativ)
2940  ENDDO
2941  ENDDO
2942  ENDDO
2943 ENDDO
2944 
2945 IF (.NOT.ASSOCIATED(this%voldati)) THEN
2946  DEALLOCATE(voldatiu, voldativ)
2947 ENDIF
2948 DEALLOCATE(rot_mat, tmp_arr, iu, iv)
2949 
2950 END SUBROUTINE vg6d_wind__un_rot
2951 
2952 
2953 !!$ try to understand the problem:
2954 !!$
2955 !!$ case:
2956 !!$
2957 !!$ 1) we have only one volume: we have to provide the direction of shift
2958 !!$ compute H and traslate on it
2959 !!$ 2) we have two volumes:
2960 !!$ 1) volume U and volume V: compute H and traslate on it
2961 !!$ 2) volume U/V and volume H : translate U/V on H
2962 !!$ 3) we have tree volumes: translate U and V on H
2963 !!$
2964 !!$ strange cases:
2965 !!$ 1) do not have U in volume U
2966 !!$ 2) do not have V in volume V
2967 !!$ 3) we have others variables more than U and V in volumes U e V
2968 !!$
2969 !!$
2970 !!$ so the steps are:
2971 !!$ 1) find the volumes
2972 !!$ 2) define or compute H grid
2973 !!$ 3) trasform the volumes in H
2974 
2975 !!$ N.B.
2976 !!$ case 1) for only one vg6d (U or V) is not managed, but
2977 !!$ the not pubblic subroutines will work but you have to know what you want to do
2978 
2979 
2996 subroutine vg6d_c2a (this)
2997 
2998 TYPE(volgrid6d),INTENT(inout) :: this(:)
2999 
3000 integer :: ngrid,igrid,jgrid,ugrid,vgrid,tgrid
3001 doubleprecision :: xmin, xmax, ymin, ymax
3002 doubleprecision :: xmin_t, xmax_t, ymin_t, ymax_t
3003 doubleprecision :: step_lon_t,step_lat_t
3004 character(len=80) :: type_t,type
3005 TYPE(griddim_def):: griddim_t
3006 

Generated with Doxygen.