passb.f

Go to the documentation of this file.
00001       subroutine passb (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 c
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
 All Classes Files Functions Variables Typedefs Enumerations Enumerator Friends Defines