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