shifting Subroutine

private subroutine shifting(long, larg, shift, shift_tab)

Rotation matrix for frequencies -> results in surface shifting

Arguments

Type IntentOptional Attributes Name
integer(kind=I4), intent(in) :: long

2D array length
integer(kind=I4), intent(in) :: larg

2D array width
real(kind=R8), intent(in), optional, dimension(2) :: shift

surface shift fraction along x and y
complex(kind=R8), intent(out), dimension(1:long, 1:larg) :: shift_tab

2D array out

Called by

proc~~shifting~~CalledByGraph proc~shifting shifting proc~fft_filter fft_filter proc~fft_filter->proc~shifting proc~multiple_anisotropy multiple_anisotropy proc~multiple_anisotropy->proc~fft_filter proc~test_peaks_and_pits_curvatures test_peaks_and_pits_curvatures proc~test_peaks_and_pits_curvatures->proc~fft_filter program~test_smooth test_smooth program~test_smooth->proc~fft_filter program~test_anisotropy test_anisotropy program~test_anisotropy->proc~multiple_anisotropy program~test_grad_curv test_grad_curv program~test_grad_curv->proc~test_peaks_and_pits_curvatures

Source Code

   subroutine shifting(long, larg, shift, shift_tab)
   !================================================================================================
   !! Rotation matrix for frequencies -> results in surface shifting
   !------------------------------------------------------------------------------------------------
   implicit none
   integer(kind=I4), intent(in )                            :: long        !! *2D array length*
   integer(kind=I4), intent(in )                            :: larg        !! *2D array width*
   real   (kind=R8), intent(in ), dimension(2), optional    :: shift       !! *surface shift fraction along x and y*
   complex(kind=R8), intent(out), dimension(1:long, 1:larg) :: shift_tab   !! *2D array out*

      integer(kind=I4) :: i, j
      real   (kind=R8) :: x, y

      complex(kind=R8) :: eixi, tmp

      x = - shift(1) * ( 2 * pi_r8 / (long - 1) )
      y = - shift(2) * ( 2 * pi_r8 / (larg - 1) )

      do i = 1, long

         eixi = cmplx( cos((i - 1) * x), sin((i - 1) * x), kind=r8 )

         do j = 1, larg

            shift_tab(i, j) = eixi * cmplx( cos((j - 1) * y), sin((j - 1) * y), kind=r8 )

         enddo

      enddo

   return
   endsubroutine shifting