GNU Octave  4.2.1 A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
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
double inc(void) const
Definition: Range.h:80
may be zero for pure relative error test tem the relative tolerance must be greater than or equal to