Type | Intent | Optional | 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 |
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 |
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