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