radf5 Subroutine

subroutine radf5(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3, Wa4)

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
real(kind=rk) :: Wa4

Contents

Source Code


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 :: ci5
real(kind=rk), public :: cr2
real(kind=rk), public :: cr3
real(kind=rk), public :: cr4
real(kind=rk), public :: cr5
real(kind=rk), public :: di2
real(kind=rk), public :: di3
real(kind=rk), public :: di4
real(kind=rk), public :: di5
real(kind=rk), public :: dr2
real(kind=rk), public :: dr3
real(kind=rk), public :: dr4
real(kind=rk), public :: dr5
integer, public :: i
integer, public :: ic
integer, public :: idp2
integer, public :: k
real(kind=rk), public, parameter :: pi = acos(-1.0_rk)
real(kind=rk), public, parameter :: ti11 = sin(2.0_rk*pi/5.0_rk)
real(kind=rk), public, parameter :: ti12 = sin(4.0_rk*pi/5.0_rk)
real(kind=rk), public :: ti2
real(kind=rk), public :: ti3
real(kind=rk), public :: ti4
real(kind=rk), public :: ti5
real(kind=rk), public, parameter :: tr11 = cos(2.0_rk*pi/5.0_rk)
real(kind=rk), public, parameter :: tr12 = cos(4.0_rk*pi/5.0_rk)
real(kind=rk), public :: tr2
real(kind=rk), public :: tr3
real(kind=rk), public :: tr4
real(kind=rk), public :: tr5

Source Code

      subroutine radf5(Ido,l1,Cc,Ch,Wa1,Wa2,Wa3,Wa4)
      use fftpack_kind
      implicit none
      real(rk) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , &
                  cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , &
                  dr4 , dr5
      real(rk) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3, &
                  tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4
      integer :: i , ic , Ido , idp2 , k , l1
      dimension Cc(Ido,l1,5) , Ch(Ido,5,l1) , Wa1(*) , Wa2(*) , Wa3(*), &
                Wa4(*)
      real(rk),parameter :: pi = acos(-1.0_rk)
      real(rk),parameter :: tr11 = cos(2.0_rk * pi / 5.0_rk)
      real(rk),parameter :: ti11 = sin(2.0_rk * pi / 5.0_rk)
      real(rk),parameter :: tr12 = cos(4.0_rk * pi / 5.0_rk)
      real(rk),parameter :: ti12 = sin(4.0_rk * pi / 5.0_rk)
      do k = 1 , l1
         cr2 = Cc(1,k,5) + Cc(1,k,2)
         ci5 = Cc(1,k,5) - Cc(1,k,2)
         cr3 = Cc(1,k,4) + Cc(1,k,3)
         ci4 = Cc(1,k,4) - Cc(1,k,3)
         Ch(1,1,k) = Cc(1,k,1) + cr2 + cr3
         Ch(Ido,2,k) = Cc(1,k,1) + tr11*cr2 + tr12*cr3
         Ch(1,3,k) = ti11*ci5 + ti12*ci4
         Ch(Ido,4,k) = Cc(1,k,1) + tr12*cr2 + tr11*cr3
         Ch(1,5,k) = ti12*ci5 - ti11*ci4
      enddo
      if ( Ido==1 ) return
      idp2 = Ido + 2
      do k = 1 , l1
         do i = 3 , Ido , 2
            ic = idp2 - i
            dr2 = Wa1(i-2)*Cc(i-1,k,2) + Wa1(i-1)*Cc(i,k,2)
            di2 = Wa1(i-2)*Cc(i,k,2) - Wa1(i-1)*Cc(i-1,k,2)
            dr3 = Wa2(i-2)*Cc(i-1,k,3) + Wa2(i-1)*Cc(i,k,3)
            di3 = Wa2(i-2)*Cc(i,k,3) - Wa2(i-1)*Cc(i-1,k,3)
            dr4 = Wa3(i-2)*Cc(i-1,k,4) + Wa3(i-1)*Cc(i,k,4)
            di4 = Wa3(i-2)*Cc(i,k,4) - Wa3(i-1)*Cc(i-1,k,4)
            dr5 = Wa4(i-2)*Cc(i-1,k,5) + Wa4(i-1)*Cc(i,k,5)
            di5 = Wa4(i-2)*Cc(i,k,5) - Wa4(i-1)*Cc(i-1,k,5)
            cr2 = dr2 + dr5
            ci5 = dr5 - dr2
            cr5 = di2 - di5
            ci2 = di2 + di5
            cr3 = dr3 + dr4
            ci4 = dr4 - dr3
            cr4 = di3 - di4
            ci3 = di3 + di4
            Ch(i-1,1,k) = Cc(i-1,k,1) + cr2 + cr3
            Ch(i,1,k) = Cc(i,k,1) + ci2 + ci3
            tr2 = Cc(i-1,k,1) + tr11*cr2 + tr12*cr3
            ti2 = Cc(i,k,1) + tr11*ci2 + tr12*ci3
            tr3 = Cc(i-1,k,1) + tr12*cr2 + tr11*cr3
            ti3 = Cc(i,k,1) + tr12*ci2 + tr11*ci3
            tr5 = ti11*cr5 + ti12*cr4
            ti5 = ti11*ci5 + ti12*ci4
            tr4 = ti12*cr5 - ti11*cr4
            ti4 = ti12*ci5 - ti11*ci4
            Ch(i-1,3,k) = tr2 + tr5
            Ch(ic-1,2,k) = tr2 - tr5
            Ch(i,3,k) = ti2 + ti5
            Ch(ic,2,k) = ti5 - ti2
            Ch(i-1,5,k) = tr3 + tr4
            Ch(ic-1,4,k) = tr3 - tr4
            Ch(i,5,k) = ti3 + ti4
            Ch(ic,4,k) = ti4 - ti3
         enddo
      enddo
      end subroutine radf5