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
zpassf.f
Go to the documentation of this file.
1  subroutine zpassf (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