Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | n | |||
real(kind=rk), | intent(inout) | :: | x(*) | |||
real(kind=rk), | intent(inout) | :: | wsave(*) |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
real(kind=rk), | public | :: | c1 | ||||
integer, | public | :: | i | ||||
integer, | public | :: | k | ||||
integer, | public | :: | kc | ||||
integer, | public | :: | modn | ||||
integer, | public | :: | nm1 | ||||
integer, | public | :: | np1 | ||||
integer, | public | :: | ns2 | ||||
real(kind=rk), | public | :: | t1 | ||||
real(kind=rk), | public | :: | t2 | ||||
real(kind=rk), | public | :: | tx2 | ||||
real(kind=rk), | public | :: | x1h | ||||
real(kind=rk), | public | :: | x1p3 | ||||
real(kind=rk), | public | :: | xi | ||||
real(kind=rk), | public | :: | xim2 |
subroutine dcost(n, x, wsave)
use fftpack_kind, only: rk
implicit none
integer, intent(in) :: n
real(rk), intent(inout) :: wsave(*)
real(rk), intent(inout) :: x(*)
real(rk) :: c1, t1, t2, tx2, x1h, x1p3, &
xi, xim2
integer :: i, k, kc, modn, nm1, np1, ns2
nm1 = n - 1
np1 = n + 1
ns2 = n/2
if (n < 2) return
if (n == 2) then
x1h = x(1) + x(2)
x(2) = x(1) - x(2)
x(1) = x1h
return
elseif (n > 3) then
c1 = x(1) - x(n)
x(1) = x(1) + x(n)
do k = 2, ns2
kc = np1 - k
t1 = x(k) + x(kc)
t2 = x(k) - x(kc)
c1 = c1 + wsave(kc)*t2
t2 = wsave(k)*t2
x(k) = t1 - t2
x(kc) = t1 + t2
end do
modn = mod(n, 2)
if (modn /= 0) x(ns2 + 1) = x(ns2 + 1) + x(ns2 + 1)
call dfftf(nm1, x, wsave(n + 1))
xim2 = x(2)
x(2) = c1
do i = 4, n, 2
xi = x(i)
x(i) = x(i - 2) - x(i - 1)
x(i - 1) = xim2
xim2 = xi
end do
if (modn /= 0) x(n) = xim2
return
end if
x1p3 = x(1) + x(3)
tx2 = x(2) + x(2)
x(2) = x(1) - x(3)
x(1) = x1p3 + tx2
x(3) = x1p3 - tx2
end subroutine dcost