subroutine dpssb (nac,ido,ip,l1,idl1,cc,c1,c2,ch,ch2,wa) double precision cc(ido,ip,l1), c1(ido,l1,ip), c2(idl1,ip), 1 ch(ido,l1,ip), ch2(idl1,ip), wa(1), wai, war c idot = ido/2 nt = ip*idl1 ipp2 = ip+2 ipph = (ip+1)/2 idp = ip*ido c if (ido .lt. l1) go to 106 do 103 j=2,ipph jc = ipp2-j do 102 k=1,l1 do 101 i=1,ido ch(i,k,j) = cc(i,j,k)+cc(i,jc,k) ch(i,k,jc) = cc(i,j,k)-cc(i,jc,k) 101 continue 102 continue 103 continue c do 105 k=1,l1 do 104 i=1,ido ch(i,k,1) = cc(i,1,k) 104 continue 105 continue go to 112 c 106 do 109 j=2,ipph jc = ipp2-j do 108 i=1,ido do 107 k=1,l1 ch(i,k,j) = cc(i,j,k)+cc(i,jc,k) ch(i,k,jc) = cc(i,j,k)-cc(i,jc,k) 107 continue 108 continue 109 continue c do 111 i=1,ido do 110 k=1,l1 ch(i,k,1) = cc(i,1,k) 110 continue 111 continue c 112 idl = 2-ido inc = 0 do 116 l=2,ipph lc = ipp2-l idl = idl+ido do 113 ik=1,idl1 c2(ik,l) = ch2(ik,1)+wa(idl-1)*ch2(ik,2) c2(ik,lc) = wa(idl)*ch2(ik,ip) 113 continue idlj = idl inc = inc+ido do 115 j=3,ipph jc = ipp2-j idlj = idlj+inc if (idlj .gt. idp) idlj = idlj-idp war = wa(idlj-1) wai = wa(idlj) do 114 ik=1,idl1 c2(ik,l) = c2(ik,l)+war*ch2(ik,j) c2(ik,lc) = c2(ik,lc)+wai*ch2(ik,jc) 114 continue 115 continue 116 continue c do 118 j=2,ipph do 117 ik=1,idl1 ch2(ik,1) = ch2(ik,1)+ch2(ik,j) 117 continue 118 continue c do 120 j=2,ipph jc = ipp2-j do 119 ik=2,idl1,2 ch2(ik-1,j) = c2(ik-1,j)-c2(ik,jc) ch2(ik-1,jc) = c2(ik-1,j)+c2(ik,jc) ch2(ik,j) = c2(ik,j)+c2(ik-1,jc) ch2(ik,jc) = c2(ik,j)-c2(ik-1,jc) 119 continue 120 continue c nac = 1 if (ido .eq. 2) return nac = 0 c do 121 ik=1,idl1 c2(ik,1) = ch2(ik,1) 121 continue c do 123 j=2,ip do 122 k=1,l1 c1(1,k,j) = ch(1,k,j) c1(2,k,j) = ch(2,k,j) 122 continue 123 continue c if (idot .gt. l1) go to 127 idij = 0 do 126 j=2,ip idij = idij+2 do 125 i=4,ido,2 idij = idij+2 do 124 k=1,l1 c1(i-1,k,j) = wa(idij-1)*ch(i-1,k,j)-wa(idij)*ch(i,k,j) c1(i,k,j) = wa(idij-1)*ch(i,k,j)+wa(idij)*ch(i-1,k,j) 124 continue 125 continue 126 continue return c 127 idj = 2-ido do 130 j=2,ip idj = idj+ido do 129 k=1,l1 idij = idj do 128 i=4,ido,2 idij = idij+2 c1(i-1,k,j) = wa(idij-1)*ch(i-1,k,j)-wa(idij)*ch(i,k,j) c1(i,k,j) = wa(idij-1)*ch(i,k,j)+wa(idij)*ch(i-1,k,j) 128 continue 129 continue 130 continue c return end