|
2329
|
1 subroutine passf (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 |
