GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
passb.f
Go to the documentation of this file.
1  subroutine passb (nac,ido,ip,l1,idl1,cc,c1,c2,ch,ch2,wa)
2  dimension ch(ido,l1,ip) ,cc(ido,ip,l1) ,
3  1 c1(ido,l1,ip) ,wa(1) ,c2(idl1,ip),
4  2 ch2(idl1,ip)
5  idot = ido/2
6  nt = ip*idl1
7  ipp2 = ip+2
8  ipph = (ip+1)/2
9  idp = ip*ido
10 c
11  if (ido .lt. l1) go to 106
12  do 103 j=2,ipph
13  jc = ipp2-j
14  do 102 k=1,l1
15  do 101 i=1,ido
16  ch(i,k,j) = cc(i,j,k)+cc(i,jc,k)
17  ch(i,k,jc) = cc(i,j,k)-cc(i,jc,k)
18  101 continue
19  102 continue
20  103 continue
21  do 105 k=1,l1
22  do 104 i=1,ido
23  ch(i,k,1) = cc(i,1,k)
24  104 continue
25  105 continue
26  go to 112
27  106 do 109 j=2,ipph
28  jc = ipp2-j
29  do 108 i=1,ido
30  do 107 k=1,l1
31  ch(i,k,j) = cc(i,j,k)+cc(i,jc,k)
32  ch(i,k,jc) = cc(i,j,k)-cc(i,jc,k)
33  107 continue
34  108 continue
35  109 continue
36  do 111 i=1,ido
37  do 110 k=1,l1
38  ch(i,k,1) = cc(i,1,k)
39  110 continue
40  111 continue
41  112 idl = 2-ido
42  inc = 0
43  do 116 l=2,ipph
44  lc = ipp2-l
45  idl = idl+ido
46  do 113 ik=1,idl1
47  c2(ik,l) = ch2(ik,1)+wa(idl-1)*ch2(ik,2)
48  c2(ik,lc) = wa(idl)*ch2(ik,ip)
49  113 continue
50  idlj = idl
51  inc = inc+ido
52  do 115 j=3,ipph
53  jc = ipp2-j
54  idlj = idlj+inc
55  if (idlj .gt. idp) idlj = idlj-idp
56  war = wa(idlj-1)
57  wai = wa(idlj)
58  do 114 ik=1,idl1
59  c2(ik,l) = c2(ik,l)+war*ch2(ik,j)
60  c2(ik,lc) = c2(ik,lc)+wai*ch2(ik,jc)
61  114 continue
62  115 continue
63  116 continue
64  do 118 j=2,ipph
65  do 117 ik=1,idl1
66  ch2(ik,1) = ch2(ik,1)+ch2(ik,j)
67  117 continue
68  118 continue
69  do 120 j=2,ipph
70  jc = ipp2-j
71  do 119 ik=2,idl1,2
72  ch2(ik-1,j) = c2(ik-1,j)-c2(ik,jc)
73  ch2(ik-1,jc) = c2(ik-1,j)+c2(ik,jc)
74  ch2(ik,j) = c2(ik,j)+c2(ik-1,jc)
75  ch2(ik,jc) = c2(ik,j)-c2(ik-1,jc)
76  119 continue
77  120 continue
78  nac = 1
79  if (ido .eq. 2) return
80  nac = 0
81  do 121 ik=1,idl1
82  c2(ik,1) = ch2(ik,1)
83  121 continue
84  do 123 j=2,ip
85  do 122 k=1,l1
86  c1(1,k,j) = ch(1,k,j)
87  c1(2,k,j) = ch(2,k,j)
88  122 continue
89  123 continue
90  if (idot .gt. l1) go to 127
91  idij = 0
92  do 126 j=2,ip
93  idij = idij+2
94  do 125 i=4,ido,2
95  idij = idij+2
96  do 124 k=1,l1
97  c1(i-1,k,j) = wa(idij-1)*ch(i-1,k,j)-wa(idij)*ch(i,k,j)
98  c1(i,k,j) = wa(idij-1)*ch(i,k,j)+wa(idij)*ch(i-1,k,j)
99  124 continue
100  125 continue
101  126 continue
102  return
103  127 idj = 2-ido
104  do 130 j=2,ip
105  idj = idj+ido
106  do 129 k=1,l1
107  idij = idj
108  do 128 i=4,ido,2
109  idij = idij+2
110  c1(i-1,k,j) = wa(idij-1)*ch(i-1,k,j)-wa(idij)*ch(i,k,j)
111  c1(i,k,j) = wa(idij-1)*ch(i,k,j)+wa(idij)*ch(i-1,k,j)
112  128 continue
113  129 continue
114  130 continue
115  return
116  end