libsim  Versione8.0.0

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

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

Generated with Doxygen.