home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / fftpack / passb.f < prev    next >
Text File  |  1996-09-28  |  3KB  |  118 lines
  1.       subroutine passb (nac,ido,ip,l1,idl1,cc,c1,c2,ch,ch2,wa)
  2.       implicit double precision (a-h,o-z)
  3.       dimension       ch(ido,l1,ip)          ,cc(ido,ip,l1)          ,
  4.      1                c1(ido,l1,ip)          ,wa(1)      ,c2(idl1,ip),
  5.      2                ch2(idl1,ip)
  6.       idot = ido/2
  7.       nt = ip*idl1
  8.       ipp2 = ip+2
  9.       ipph = (ip+1)/2
  10.       idp = ip*ido
  11. c
  12.       if (ido .lt. l1) go to 106
  13.       do 103 j=2,ipph
  14.          jc = ipp2-j
  15.          do 102 k=1,l1
  16.             do 101 i=1,ido
  17.                ch(i,k,j) = cc(i,j,k)+cc(i,jc,k)
  18.                ch(i,k,jc) = cc(i,j,k)-cc(i,jc,k)
  19.   101       continue
  20.   102    continue
  21.   103 continue
  22.       do 105 k=1,l1
  23.          do 104 i=1,ido
  24.             ch(i,k,1) = cc(i,1,k)
  25.   104    continue
  26.   105 continue
  27.       go to 112
  28.   106 do 109 j=2,ipph
  29.          jc = ipp2-j
  30.          do 108 i=1,ido
  31.             do 107 k=1,l1
  32.                ch(i,k,j) = cc(i,j,k)+cc(i,jc,k)
  33.                ch(i,k,jc) = cc(i,j,k)-cc(i,jc,k)
  34.   107       continue
  35.   108    continue
  36.   109 continue
  37.       do 111 i=1,ido
  38.          do 110 k=1,l1
  39.             ch(i,k,1) = cc(i,1,k)
  40.   110    continue
  41.   111 continue
  42.   112 idl = 2-ido
  43.       inc = 0
  44.       do 116 l=2,ipph
  45.          lc = ipp2-l
  46.          idl = idl+ido
  47.          do 113 ik=1,idl1
  48.             c2(ik,l) = ch2(ik,1)+wa(idl-1)*ch2(ik,2)
  49.             c2(ik,lc) = wa(idl)*ch2(ik,ip)
  50.   113    continue
  51.          idlj = idl
  52.          inc = inc+ido
  53.          do 115 j=3,ipph
  54.             jc = ipp2-j
  55.             idlj = idlj+inc
  56.             if (idlj .gt. idp) idlj = idlj-idp
  57.             war = wa(idlj-1)
  58.             wai = wa(idlj)
  59.             do 114 ik=1,idl1
  60.                c2(ik,l) = c2(ik,l)+war*ch2(ik,j)
  61.                c2(ik,lc) = c2(ik,lc)+wai*ch2(ik,jc)
  62.   114       continue
  63.   115    continue
  64.   116 continue
  65.       do 118 j=2,ipph
  66.          do 117 ik=1,idl1
  67.             ch2(ik,1) = ch2(ik,1)+ch2(ik,j)
  68.   117    continue
  69.   118 continue
  70.       do 120 j=2,ipph
  71.          jc = ipp2-j
  72.          do 119 ik=2,idl1,2
  73.             ch2(ik-1,j) = c2(ik-1,j)-c2(ik,jc)
  74.             ch2(ik-1,jc) = c2(ik-1,j)+c2(ik,jc)
  75.             ch2(ik,j) = c2(ik,j)+c2(ik-1,jc)
  76.             ch2(ik,jc) = c2(ik,j)-c2(ik-1,jc)
  77.   119    continue
  78.   120 continue
  79.       nac = 1
  80.       if (ido .eq. 2) return
  81.       nac = 0
  82.       do 121 ik=1,idl1
  83.          c2(ik,1) = ch2(ik,1)
  84.   121 continue
  85.       do 123 j=2,ip
  86.          do 122 k=1,l1
  87.             c1(1,k,j) = ch(1,k,j)
  88.             c1(2,k,j) = ch(2,k,j)
  89.   122    continue
  90.   123 continue
  91.       if (idot .gt. l1) go to 127
  92.       idij = 0
  93.       do 126 j=2,ip
  94.          idij = idij+2
  95.          do 125 i=4,ido,2
  96.             idij = idij+2
  97.             do 124 k=1,l1
  98.                c1(i-1,k,j) = wa(idij-1)*ch(i-1,k,j)-wa(idij)*ch(i,k,j)
  99.                c1(i,k,j) = wa(idij-1)*ch(i,k,j)+wa(idij)*ch(i-1,k,j)
  100.   124       continue
  101.   125    continue
  102.   126 continue
  103.       return
  104.   127 idj = 2-ido
  105.       do 130 j=2,ip
  106.          idj = idj+ido
  107.          do 129 k=1,l1
  108.             idij = idj
  109.             do 128 i=4,ido,2
  110.                idij = idij+2
  111.                c1(i-1,k,j) = wa(idij-1)*ch(i-1,k,j)-wa(idij)*ch(i,k,j)
  112.                c1(i,k,j) = wa(idij-1)*ch(i,k,j)+wa(idij)*ch(i-1,k,j)
  113.   128       continue
  114.   129    continue
  115.   130 continue
  116.       return
  117.       end
  118.