sint1 Subroutine

subroutine sint1(n, War, Was, Xh, x, Ifac)

Arguments

Type IntentOptional Attributes Name
integer :: n
real(kind=rk) :: War
real(kind=rk) :: Was
real(kind=rk) :: Xh
real(kind=rk) :: x
integer :: Ifac

Contents

Source Code


Variables

Type Visibility Attributes Name Initial
integer, public :: i
integer, public :: k
integer, public :: kc
integer, public :: modn
integer, public :: np1
integer, public :: ns2
real(kind=rk), public, parameter :: sqrt3 = sqrt(3.0_rk)
real(kind=rk), public :: t1
real(kind=rk), public :: t2
real(kind=rk), public :: xhold

Source Code

      subroutine sint1(n,War,Was,Xh,x,Ifac)
      use fftpack_kind
      implicit none
      integer :: i , Ifac , k , kc , modn , n , np1 , ns2
      real(rk) :: t1 , t2 , War , Was , x , Xh , xhold
      dimension War(*) , Was(*) , x(*) , Xh(*) , Ifac(*)
      real(rk),parameter :: sqrt3 = sqrt(3.0_rk)
      do i = 1 , n
         Xh(i) = War(i)
         War(i) = x(i)
      enddo
      if ( n<2 ) then
         Xh(1) = Xh(1) + Xh(1)
      elseif ( n==2 ) then
         xhold = sqrt3*(Xh(1)+Xh(2))
         Xh(2) = sqrt3*(Xh(1)-Xh(2))
         Xh(1) = xhold
      else
         np1 = n + 1
         ns2 = n/2
         x(1) = 0.0_rk
         do k = 1 , ns2
            kc = np1 - k
            t1 = Xh(k) - Xh(kc)
            t2 = Was(k)*(Xh(k)+Xh(kc))
            x(k+1) = t1 + t2
            x(kc+1) = t2 - t1
         enddo
         modn = mod(n,2)
         if ( modn/=0 ) x(ns2+2) = 4.0_rk*Xh(ns2+1)
         call rfftf1(np1,x,Xh,War,Ifac)
         Xh(1) = 0.5_rk*x(1)
         do i = 3 , n , 2
            Xh(i-1) = -x(i)
            Xh(i) = Xh(i-2) + x(i-1)
         enddo
         if ( modn==0 ) Xh(n) = -x(n+1)
      endif
      do i = 1 , n
         x(i) = War(i)
         War(i) = Xh(i)
      enddo
      end subroutine sint1