subroutine passf4(ido, l1, cc, ch, wa1, wa2, wa3)
use fftpack_kind, only: dp => rk
implicit none
integer, intent(in) :: ido, l1
real(dp), intent(in) :: cc(ido, 4, l1), wa1(*), wa2(*), wa3(*)
real(dp), intent(out) :: ch(ido, l1, 4)
real(dp) :: ci2, ci3, ci4, cr2, cr3, cr4, &
& ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4
integer :: i, k
if (ido /= 2) then
do concurrent(k=1:l1, i=2:ido:2)
ti1 = cc(i, 1, k) - cc(i, 3, k)
ti2 = cc(i, 1, k) + cc(i, 3, k)
ti3 = cc(i, 2, k) + cc(i, 4, k)
tr4 = cc(i, 2, k) - cc(i, 4, k)
tr1 = cc(i - 1, 1, k) - cc(i - 1, 3, k)
tr2 = cc(i - 1, 1, k) + cc(i - 1, 3, k)
ti4 = cc(i - 1, 4, k) - cc(i - 1, 2, k)
tr3 = cc(i - 1, 2, k) + cc(i - 1, 4, k)
ch(i - 1, k, 1) = tr2 + tr3
cr3 = tr2 - tr3
ch(i, k, 1) = ti2 + ti3
ci3 = ti2 - ti3
cr2 = tr1 + tr4
cr4 = tr1 - tr4
ci2 = ti1 + ti4
ci4 = ti1 - ti4
ch(i - 1, k, 2) = wa1(i - 1)*cr2 + wa1(i)*ci2
ch(i, k, 2) = wa1(i - 1)*ci2 - wa1(i)*cr2
ch(i - 1, k, 3) = wa2(i - 1)*cr3 + wa2(i)*ci3
ch(i, k, 3) = wa2(i - 1)*ci3 - wa2(i)*cr3
ch(i - 1, k, 4) = wa3(i - 1)*cr4 + wa3(i)*ci4
ch(i, k, 4) = wa3(i - 1)*ci4 - wa3(i)*cr4
end do
else
do concurrent(k=1:l1)
ti1 = cc(2, 1, k) - cc(2, 3, k)
ti2 = cc(2, 1, k) + cc(2, 3, k)
tr4 = cc(2, 2, k) - cc(2, 4, k)
ti3 = cc(2, 2, k) + cc(2, 4, k)
tr1 = cc(1, 1, k) - cc(1, 3, k)
tr2 = cc(1, 1, k) + cc(1, 3, k)
ti4 = cc(1, 4, k) - cc(1, 2, k)
tr3 = cc(1, 2, k) + cc(1, 4, k)
ch(1, k, 1) = tr2 + tr3
ch(1, k, 3) = tr2 - tr3
ch(2, k, 1) = ti2 + ti3
ch(2, k, 3) = ti2 - ti3
ch(1, k, 2) = tr1 + tr4
ch(1, k, 4) = tr1 - tr4
ch(2, k, 2) = ti1 + ti4
ch(2, k, 4) = ti1 - ti4
end do
end if
end subroutine passf4
