passb4 Subroutine

subroutine passb4(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3)

Uses

Arguments

Type IntentOptional Attributes Name
integer :: Ido
integer :: l1
real(kind=rk) :: Cc
real(kind=rk) :: Ch
real(kind=rk) :: Wa1
real(kind=rk) :: Wa2
real(kind=rk) :: Wa3

Contents

Variables

Source Code

passb4

Variables

Type Visibility Attributes Name Initial
real(kind=rk), public :: ci2
real(kind=rk), public :: ci3
real(kind=rk), public :: ci4
real(kind=rk), public :: cr2
real(kind=rk), public :: cr3
real(kind=rk), public :: cr4
integer, public :: i
integer, public :: k
real(kind=rk), public :: ti1
real(kind=rk), public :: ti2
real(kind=rk), public :: ti3
real(kind=rk), public :: ti4
real(kind=rk), public :: tr1
real(kind=rk), public :: tr2
real(kind=rk), public :: tr3
real(kind=rk), public :: tr4

Source Code

      subroutine passb4(Ido,l1,Cc,Ch,Wa1,Wa2,Wa3)
      use fftpack_kind
      implicit none
      real(rk) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , &
                     & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , tr4 , &
                     & Wa1 , Wa2 , Wa3
      integer :: i , Ido , k , l1
      dimension Cc(Ido,4,l1) , Ch(Ido,l1,4) , Wa1(*) , Wa2(*) , Wa3(*)
      if ( Ido/=2 ) then
         do k = 1 , l1
            do i = 2 , Ido , 2
               ti1 = Cc(i,1,k) - Cc(i,3,k)
               ti2 = Cc(i,1,k) + Cc(i,3,k)
               ti3 = Cc(i,2,k) + Cc(i,4,k)
               tr4 = Cc(i,4,k) - Cc(i,2,k)
               tr1 = Cc(i-1,1,k) - Cc(i-1,3,k)
               tr2 = Cc(i-1,1,k) + Cc(i-1,3,k)
               ti4 = Cc(i-1,2,k) - Cc(i-1,4,k)
               tr3 = Cc(i-1,2,k) + Cc(i-1,4,k)
               Ch(i-1,k,1) = tr2 + tr3
               cr3 = tr2 - tr3
               Ch(i,k,1) = ti2 + ti3
               ci3 = ti2 - ti3
               cr2 = tr1 + tr4
               cr4 = tr1 - tr4
               ci2 = ti1 + ti4
               ci4 = ti1 - ti4
               Ch(i-1,k,2) = Wa1(i-1)*cr2 - Wa1(i)*ci2
               Ch(i,k,2) = Wa1(i-1)*ci2 + Wa1(i)*cr2
               Ch(i-1,k,3) = Wa2(i-1)*cr3 - Wa2(i)*ci3
               Ch(i,k,3) = Wa2(i-1)*ci3 + Wa2(i)*cr3
               Ch(i-1,k,4) = Wa3(i-1)*cr4 - Wa3(i)*ci4
               Ch(i,k,4) = Wa3(i-1)*ci4 + Wa3(i)*cr4
            enddo
         enddo
      else
         do k = 1 , l1
            ti1 = Cc(2,1,k) - Cc(2,3,k)
            ti2 = Cc(2,1,k) + Cc(2,3,k)
            tr4 = Cc(2,4,k) - Cc(2,2,k)
            ti3 = Cc(2,2,k) + Cc(2,4,k)
            tr1 = Cc(1,1,k) - Cc(1,3,k)
            tr2 = Cc(1,1,k) + Cc(1,3,k)
            ti4 = Cc(1,2,k) - Cc(1,4,k)
            tr3 = Cc(1,2,k) + Cc(1,4,k)
            Ch(1,k,1) = tr2 + tr3
            Ch(1,k,3) = tr2 - tr3
            Ch(2,k,1) = ti2 + ti3
            Ch(2,k,3) = ti2 - ti3
            Ch(1,k,2) = tr1 + tr4
            Ch(1,k,4) = tr1 - tr4
            Ch(2,k,2) = ti1 + ti4
            Ch(2,k,4) = ti1 - ti4
         enddo
      end if 
      end subroutine passb4