radf5 Subroutine

subroutine radf5(ido, l1, cc, ch, wa1, wa2, wa3, wa4)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: ido
integer, intent(in) :: l1
real(kind=dp), intent(in) :: cc(ido,l1,5)
real(kind=dp), intent(out) :: ch(ido,5,l1)
real(kind=dp), intent(in) :: wa1(*)
real(kind=dp), intent(in) :: wa2(*)
real(kind=dp), intent(in) :: wa3(*)
real(kind=dp), intent(in) :: wa4(*)

Contents

Source Code


Variables

Type Visibility Attributes Name Initial
real(kind=dp), public :: ci2
real(kind=dp), public :: ci3
real(kind=dp), public :: ci4
real(kind=dp), public :: ci5
real(kind=dp), public :: cr2
real(kind=dp), public :: cr3
real(kind=dp), public :: cr4
real(kind=dp), public :: cr5
real(kind=dp), public :: di2
real(kind=dp), public :: di3
real(kind=dp), public :: di4
real(kind=dp), public :: di5
real(kind=dp), public :: dr2
real(kind=dp), public :: dr3
real(kind=dp), public :: dr4
real(kind=dp), public :: dr5
integer, public :: i
integer, public :: ic
integer, public :: idp2
integer, public :: k
real(kind=dp), public, parameter :: pi = acos(-1.0_dp)
real(kind=dp), public, parameter :: ti11 = sin(2.0_dp*pi/5.0_dp)
real(kind=dp), public, parameter :: ti12 = sin(4.0_dp*pi/5.0_dp)
real(kind=dp), public :: ti2
real(kind=dp), public :: ti3
real(kind=dp), public :: ti4
real(kind=dp), public :: ti5
real(kind=dp), public, parameter :: tr11 = cos(2.0_dp*pi/5.0_dp)
real(kind=dp), public, parameter :: tr12 = cos(4.0_dp*pi/5.0_dp)
real(kind=dp), public :: tr2
real(kind=dp), public :: tr3
real(kind=dp), public :: tr4
real(kind=dp), public :: tr5

Source Code

      subroutine radf5(ido, l1, cc, ch, wa1, wa2, wa3, wa4)
         use fftpack_kind, only: dp => rk
         implicit none
         integer, intent(in) :: ido, l1
         real(dp), intent(in) :: cc(ido, l1, 5), wa1(*), wa2(*), wa3(*), wa4(*)
         real(dp), intent(out) :: ch(ido, 5, l1)
         real(dp) :: ci2, ci3, ci4, ci5, cr2, cr3, &
                     cr4, cr5, di2, di3, di4, di5, dr2, dr3, &
                     dr4, dr5
         real(dp) :: ti2, ti3, ti4, ti5, tr2, tr3, &
                     tr4, tr5
         integer :: i, ic, idp2, k
         real(dp), parameter :: pi = acos(-1.0_dp)
         real(dp), parameter :: tr11 = cos(2.0_dp*pi/5.0_dp)
         real(dp), parameter :: ti11 = sin(2.0_dp*pi/5.0_dp)
         real(dp), parameter :: tr12 = cos(4.0_dp*pi/5.0_dp)
         real(dp), parameter :: ti12 = sin(4.0_dp*pi/5.0_dp)
         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
         end do
         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
            end do
         end do
      end subroutine radf5