00001 subroutine zpassb (nac,ido,ip,l1,idl1,cc,c1,c2,ch,ch2,wa)
00002 implicit double precision (a-h,o-z)
00003 dimension ch(ido,l1,ip) ,cc(ido,ip,l1) ,
00004 1 c1(ido,l1,ip) ,wa(1) ,c2(idl1,ip),
00005 2 ch2(idl1,ip)
00006 idot = ido/2
00007 nt = ip*idl1
00008 ipp2 = ip+2
00009 ipph = (ip+1)/2
00010 idp = ip*ido
00011
00012 if (ido .lt. l1) go to 106
00013 do 103 j=2,ipph
00014 jc = ipp2-j
00015 do 102 k=1,l1
00016 do 101 i=1,ido
00017 ch(i,k,j) = cc(i,j,k)+cc(i,jc,k)
00018 ch(i,k,jc) = cc(i,j,k)-cc(i,jc,k)
00019 101 continue
00020 102 continue
00021 103 continue
00022 do 105 k=1,l1
00023 do 104 i=1,ido
00024 ch(i,k,1) = cc(i,1,k)
00025 104 continue
00026 105 continue
00027 go to 112
00028 106 do 109 j=2,ipph
00029 jc = ipp2-j
00030 do 108 i=1,ido
00031 do 107 k=1,l1
00032 ch(i,k,j) = cc(i,j,k)+cc(i,jc,k)
00033 ch(i,k,jc) = cc(i,j,k)-cc(i,jc,k)
00034 107 continue
00035 108 continue
00036 109 continue
00037 do 111 i=1,ido
00038 do 110 k=1,l1
00039 ch(i,k,1) = cc(i,1,k)
00040 110 continue
00041 111 continue
00042 112 idl = 2-ido
00043 inc = 0
00044 do 116 l=2,ipph
00045 lc = ipp2-l
00046 idl = idl+ido
00047 do 113 ik=1,idl1
00048 c2(ik,l) = ch2(ik,1)+wa(idl-1)*ch2(ik,2)
00049 c2(ik,lc) = wa(idl)*ch2(ik,ip)
00050 113 continue
00051 idlj = idl
00052 inc = inc+ido
00053 do 115 j=3,ipph
00054 jc = ipp2-j
00055 idlj = idlj+inc
00056 if (idlj .gt. idp) idlj = idlj-idp
00057 war = wa(idlj-1)
00058 wai = wa(idlj)
00059 do 114 ik=1,idl1
00060 c2(ik,l) = c2(ik,l)+war*ch2(ik,j)
00061 c2(ik,lc) = c2(ik,lc)+wai*ch2(ik,jc)
00062 114 continue
00063 115 continue
00064 116 continue
00065 do 118 j=2,ipph
00066 do 117 ik=1,idl1
00067 ch2(ik,1) = ch2(ik,1)+ch2(ik,j)
00068 117 continue
00069 118 continue
00070 do 120 j=2,ipph
00071 jc = ipp2-j
00072 do 119 ik=2,idl1,2
00073 ch2(ik-1,j) = c2(ik-1,j)-c2(ik,jc)
00074 ch2(ik-1,jc) = c2(ik-1,j)+c2(ik,jc)
00075 ch2(ik,j) = c2(ik,j)+c2(ik-1,jc)
00076 ch2(ik,jc) = c2(ik,j)-c2(ik-1,jc)
00077 119 continue
00078 120 continue
00079 nac = 1
00080 if (ido .eq. 2) return
00081 nac = 0
00082 do 121 ik=1,idl1
00083 c2(ik,1) = ch2(ik,1)
00084 121 continue
00085 do 123 j=2,ip
00086 do 122 k=1,l1
00087 c1(1,k,j) = ch(1,k,j)
00088 c1(2,k,j) = ch(2,k,j)
00089 122 continue
00090 123 continue
00091 if (idot .gt. l1) go to 127
00092 idij = 0
00093 do 126 j=2,ip
00094 idij = idij+2
00095 do 125 i=4,ido,2
00096 idij = idij+2
00097 do 124 k=1,l1
00098 c1(i-1,k,j) = wa(idij-1)*ch(i-1,k,j)-wa(idij)*ch(i,k,j)
00099 c1(i,k,j) = wa(idij-1)*ch(i,k,j)+wa(idij)*ch(i-1,k,j)
00100 124 continue
00101 125 continue
00102 126 continue
00103 return
00104 127 idj = 2-ido
00105 do 130 j=2,ip
00106 idj = idj+ido
00107 do 129 k=1,l1
00108 idij = idj
00109 do 128 i=4,ido,2
00110 idij = idij+2
00111 c1(i-1,k,j) = wa(idij-1)*ch(i-1,k,j)-wa(idij)*ch(i,k,j)
00112 c1(i,k,j) = wa(idij-1)*ch(i,k,j)+wa(idij)*ch(i-1,k,j)
00113 128 continue
00114 129 continue
00115 130 continue
00116 return
00117 end
1.7.1
