subroutine passf5(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, 5, l1), wa1(*), wa2(*), wa3(*), wa4(*) real(dp), intent(out) :: ch(ido, l1, 5) 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, 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) if (ido /= 2) then do k = 1, l1 do i = 2, ido, 2 ti5 = cc(i, 2, k) - cc(i, 5, k) ti2 = cc(i, 2, k) + cc(i, 5, k) ti4 = cc(i, 3, k) - cc(i, 4, k) ti3 = cc(i, 3, k) + cc(i, 4, k) tr5 = cc(i - 1, 2, k) - cc(i - 1, 5, k) tr2 = cc(i - 1, 2, k) + cc(i - 1, 5, k) tr4 = cc(i - 1, 3, k) - cc(i - 1, 4, k) tr3 = cc(i - 1, 3, k) + cc(i - 1, 4, k) ch(i - 1, k, 1) = cc(i - 1, 1, k) + tr2 + tr3 ch(i, k, 1) = cc(i, 1, k) + ti2 + ti3 cr2 = cc(i - 1, 1, k) + tr11*tr2 + tr12*tr3 ci2 = cc(i, 1, k) + tr11*ti2 + tr12*ti3 cr3 = cc(i - 1, 1, k) + tr12*tr2 + tr11*tr3 ci3 = cc(i, 1, k) + tr12*ti2 + tr11*ti3 cr5 = ti11*tr5 + ti12*tr4 ci5 = ti11*ti5 + ti12*ti4 cr4 = ti12*tr5 - ti11*tr4 ci4 = ti12*ti5 - ti11*ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 ch(i - 1, k, 2) = wa1(i - 1)*dr2 + wa1(i)*di2 ch(i, k, 2) = wa1(i - 1)*di2 - wa1(i)*dr2 ch(i - 1, k, 3) = wa2(i - 1)*dr3 + wa2(i)*di3 ch(i, k, 3) = wa2(i - 1)*di3 - wa2(i)*dr3 ch(i - 1, k, 4) = wa3(i - 1)*dr4 + wa3(i)*di4 ch(i, k, 4) = wa3(i - 1)*di4 - wa3(i)*dr4 ch(i - 1, k, 5) = wa4(i - 1)*dr5 + wa4(i)*di5 ch(i, k, 5) = wa4(i - 1)*di5 - wa4(i)*dr5 end do end do else do k = 1, l1 ti5 = cc(2, 2, k) - cc(2, 5, k) ti2 = cc(2, 2, k) + cc(2, 5, k) ti4 = cc(2, 3, k) - cc(2, 4, k) ti3 = cc(2, 3, k) + cc(2, 4, k) tr5 = cc(1, 2, k) - cc(1, 5, k) tr2 = cc(1, 2, k) + cc(1, 5, k) tr4 = cc(1, 3, k) - cc(1, 4, k) tr3 = cc(1, 3, k) + cc(1, 4, k) ch(1, k, 1) = cc(1, 1, k) + tr2 + tr3 ch(2, k, 1) = cc(2, 1, k) + ti2 + ti3 cr2 = cc(1, 1, k) + tr11*tr2 + tr12*tr3 ci2 = cc(2, 1, k) + tr11*ti2 + tr12*ti3 cr3 = cc(1, 1, k) + tr12*tr2 + tr11*tr3 ci3 = cc(2, 1, k) + tr12*ti2 + tr11*ti3 cr5 = ti11*tr5 + ti12*tr4 ci5 = ti11*ti5 + ti12*ti4 cr4 = ti12*tr5 - ti11*tr4 ci4 = ti12*ti5 - ti11*ti4 ch(1, k, 2) = cr2 - ci5 ch(1, k, 5) = cr2 + ci5 ch(2, k, 2) = ci2 + cr5 ch(2, k, 3) = ci3 + cr4 ch(1, k, 3) = cr3 - ci4 ch(1, k, 4) = cr3 + ci4 ch(2, k, 4) = ci3 - cr4 ch(2, k, 5) = ci2 - cr5 end do end if end subroutine passf5