subroutine dradbg (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), ai1, ai2, ar1, ar1h, ar2, 2 ar2h, arg, dc2, dcp, ds2, dsp, tpi data tpi / 6.2831853071 7958647692 5286766559 00577d0/ c arg = tpi/dfloat(ip) dcp = dcos(arg) dsp = dsin(arg) idp2 = ido+2 nbd = (ido-1)/2 ipp2 = ip+2 ipph = (ip+1)/2 if (ido .lt. l1) go to 103 do 102 k=1,l1 do 101 i=1,ido ch(i,k,1) = cc(i,1,k) 101 continue 102 continue go to 106 c 103 do 105 i=1,ido do 104 k=1,l1 ch(i,k,1) = cc(i,1,k) 104 continue 105 continue c 106 do 108 j=2,ipph jc = ipp2-j j2 = j+j do 107 k=1,l1 ch(1,k,j) = cc(ido,j2-2,k)+cc(ido,j2-2,k) ch(1,k,jc) = cc(1,j2-1,k)+cc(1,j2-1,k) 107 continue 108 continue c if (ido .eq. 1) go to 116 if (nbd .lt. l1) go to 112 do 111 j=2,ipph jc = ipp2-j do 110 k=1,l1 do 109 i=3,ido,2 ic = idp2-i ch(i-1,k,j) = cc(i-1,2*j-1,k)+cc(ic-1,2*j-2,k) ch(i-1,k,jc) = cc(i-1,2*j-1,k)-cc(ic-1,2*j-2,k) ch(i,k,j) = cc(i,2*j-1,k)-cc(ic,2*j-2,k) ch(i,k,jc) = cc(i,2*j-1,k)+cc(ic,2*j-2,k) 109 continue 110 continue 111 continue go to 116 c 112 do 115 j=2,ipph jc = ipp2-j do 114 i=3,ido,2 ic = idp2-i do 113 k=1,l1 ch(i-1,k,j) = cc(i-1,2*j-1,k)+cc(ic-1,2*j-2,k) ch(i-1,k,jc) = cc(i-1,2*j-1,k)-cc(ic-1,2*j-2,k) ch(i,k,j) = cc(i,2*j-1,k)-cc(ic,2*j-2,k) ch(i,k,jc) = cc(i,2*j-1,k)+cc(ic,2*j-2,k) 113 continue 114 continue 115 continue c 116 ar1 = 1. ai1 = 0. do 120 l=2,ipph lc = ipp2-l ar1h = dcp*ar1-dsp*ai1 ai1 = dcp*ai1+dsp*ar1 ar1 = ar1h do 117 ik=1,idl1 c2(ik,l) = ch2(ik,1)+ar1*ch2(ik,2) c2(ik,lc) = ai1*ch2(ik,ip) 117 continue dc2 = ar1 ds2 = ai1 ar2 = ar1 ai2 = ai1 do 119 j=3,ipph jc = ipp2-j ar2h = dc2*ar2-ds2*ai2 ai2 = dc2*ai2+ds2*ar2 ar2 = ar2h do 118 ik=1,idl1 c2(ik,l) = c2(ik,l)+ar2*ch2(ik,j) c2(ik,lc) = c2(ik,lc)+ai2*ch2(ik,jc) 118 continue 119 continue 120 continue c do 122 j=2,ipph do 121 ik=1,idl1 ch2(ik,1) = ch2(ik,1)+ch2(ik,j) 121 continue 122 continue c do 124 j=2,ipph jc = ipp2-j do 123 k=1,l1 ch(1,k,j) = c1(1,k,j)-c1(1,k,jc) ch(1,k,jc) = c1(1,k,j)+c1(1,k,jc) 123 continue 124 continue c if (ido .eq. 1) go to 132 if (nbd .lt. l1) go to 128 do 127 j=2,ipph jc = ipp2-j do 126 k=1,l1 do 125 i=3,ido,2 ch(i-1,k,j) = c1(i-1,k,j)-c1(i,k,jc) ch(i-1,k,jc) = c1(i-1,k,j)+c1(i,k,jc) ch(i,k,j) = c1(i,k,j)+c1(i-1,k,jc) ch(i,k,jc) = c1(i,k,j)-c1(i-1,k,jc) 125 continue 126 continue 127 continue go to 132 c 128 do 131 j=2,ipph jc = ipp2-j do 130 i=3,ido,2 do 129 k=1,l1 ch(i-1,k,j) = c1(i-1,k,j)-c1(i,k,jc) ch(i-1,k,jc) = c1(i-1,k,j)+c1(i,k,jc) ch(i,k,j) = c1(i,k,j)+c1(i-1,k,jc) ch(i,k,jc) = c1(i,k,j)-c1(i-1,k,jc) 129 continue 130 continue 131 continue 132 continue c if (ido .eq. 1) return do 133 ik=1,idl1 c2(ik,1) = ch2(ik,1) 133 continue c do 135 j=2,ip do 134 k=1,l1 c1(1,k,j) = ch(1,k,j) 134 continue 135 continue c if (nbd .gt. l1) go to 139 is = -ido do 138 j=2,ip is = is+ido idij = is do 137 i=3,ido,2 idij = idij+2 do 136 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) 136 continue 137 continue 138 continue go to 143 c 139 is = -ido do 142 j=2,ip is = is+ido do 141 k=1,l1 idij = is do 140 i=3,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) 140 continue 141 continue 142 continue c 143 return end