1 SUBROUTINE exchqz(NMAX, N, A, B, Z, L, LS1, LS2, EPS, FAIL)
2 INTEGER NMAX, N, L, LS1, LS2
3 DOUBLE PRECISION A(nmax,n), B(nmax,n), Z(nmax,n), EPS
31 INTEGER I, J, L1, L2, L3, LI, LJ, LL, IT1, IT2
32 DOUBLE PRECISION U(3,3), D, E, F, G, SA, SB, A11B11, A21B11,
34 * a22b22, ammbmm, anmbmm, amnbnn, bmnbnn, annbnn, tempr
45 IF (
abs(a(l1,l1)).GE.f) altb = .false.
48 f = sa*b(l,l) - sb*a(l,l)
50 g = sa*b(l,l1) - sb*a(l,l1)
51 CALL dlartg(f, g, d, e,tempr)
52 CALL drot(l1, a(1,l), 1, a(1,l1), 1, e, -d)
53 CALL drot(l1, b(1,l), 1, b(1,l1), 1, e, -d)
54 CALL drot(n, z(1,l), 1, z(1,l1), 1, e, -d)
56 IF (altb) CALL dlartg(b(l,l), b(l1,l), d, e,tempr)
57 IF (.NOT.altb) CALL dlartg(a(l,l), a(l1,l), d, e,tempr)
58 CALL drot(n-l+1, a(l,l), nmax, a(l1,l), nmax, d, e)
59 CALL drot(n-l+1, b(l,l), nmax, b(l1,l), nmax, d, e)
67 IF (ls1.EQ.2) go to 60
70 IF (
abs(a(l,l)).LT.g) go to 20
72 CALL dlartg(a(l1,l1), a(l2,l1), d, e,tempr)
73 CALL drot(n-l, a(l1,l1), nmax, a(l2,l1), nmax, d, e)
74 CALL drot(n-l, b(l1,l1), nmax, b(l2,l1), nmax, d, e)
83 u(i,j) = sa*b(li,lj) - sb*a(li,lj)
86 CALL dlartg(u(3,1), u(3,2), d, e,tempr)
87 CALL drot(3, u(1,1), 1, u(1,2), 1, e, -d)
89 CALL dlartg(u(1,1), u(2,1), d, e,tempr)
90 u(2,2) = -u(1,2)*e + u(2,2)*d
91 CALL drot(n-l+1, a(l,l), nmax, a(l1,l), nmax, d, e)
92 CALL drot(n-l+1, b(l,l), nmax, b(l1,l), nmax, d, e)
94 IF (altb) CALL dlartg(b(l1,l), b(l1,l1), d, e,tempr)
95 IF (.NOT.altb) CALL dlartg(a(l1,l), a(l1,l1), d, e,tempr)
96 CALL drot(l2, a(1,l), 1, a(1,l1), 1, e, -d)
97 CALL drot(l2, b(1,l), 1, b(1,l1), 1, e, -d)
98 CALL drot(n, z(1,l), 1, z(1,l1), 1, e, -d)
100 CALL dlartg(u(2,2), u(3,2), d, e,tempr)
101 CALL drot(n-l+1, a(l1,l), nmax, a(l2,l), nmax, d, e)
102 CALL drot(n-l+1, b(l1,l), nmax, b(l2,l), nmax, d, e)
104 IF (altb) CALL dlartg(b(l2,l1), b(l2,l2), d, e,tempr)
105 IF (.NOT.altb) CALL dlartg(a(l2,l1), a(l2,l2), d, e,tempr)
106 CALL drot(l2, a(1,l1), 1, a(1,l2), 1, e, -d)
107 CALL drot(l2, b(1,l1), 1, b(1,l2), 1, e, -d)
108 CALL drot(n, z(1,l1), 1, z(1,l2), 1, e, -d)
110 CALL dlartg(b(l,l), b(l1,l), d, e,tempr)
111 CALL drot(n-l+1, a(l,l), nmax, a(l1,l), nmax, d, e)
112 CALL drot(n-l+1, b(l,l), nmax, b(l1,l), nmax, d, e)
123 60
IF (ls2.EQ.2) go to 110
126 IF (
abs(a(l2,l2)).LT.g) go to 70
128 CALL dlartg(a(l,l), a(l1,l), d, e,tempr)
129 CALL drot(n-l+1, a(l,l), nmax, a(l1,l), nmax, d, e)
130 CALL drot(n-l+1, b(l,l), nmax, b(l1,l), nmax, d, e)
139 u(i,j) = sa*b(li,lj) - sb*a(li,lj)
142 CALL dlartg(u(1,1), u(2,1), d, e,tempr)
143 CALL drot(3, u(1,1), 3, u(2,1), 3, d, e)
145 CALL dlartg(u(2,2), u(2,3), d, e,tempr)
146 u(1,2) = u(1,2)*e - u(1,3)*d
147 CALL drot(l2, a(1,l1), 1, a(1,l2), 1, e, -d)
148 CALL drot(l2, b(1,l1), 1, b(1,l2), 1, e, -d)
149 CALL drot(n, z(1,l1), 1, z(1,l2), 1, e, -d)
151 IF (altb) CALL dlartg(b(l1,l1), b(l2,l1), d, e,tempr)
152 IF (.NOT.altb) CALL dlartg(a(l1,l1), a(l2,l1), d, e,tempr)
153 CALL drot(n-l+1, a(l1,l), nmax, a(l2,l), nmax, d, e)
154 CALL drot(n-l+1, b(l1,l), nmax, b(l2,l), nmax, d, e)
156 CALL dlartg(u(1,1), u(1,2), d, e,tempr)
157 CALL drot(l2, a(1,l), 1, a(1,l1), 1, e, -d)
158 CALL drot(l2, b(1,l), 1, b(1,l1), 1, e, -d)
159 CALL drot(n, z(1,l), 1, z(1,l1), 1, e, -d)
161 IF (altb) CALL dlartg(b(l,l), b(l1,l), d, e,tempr)
162 IF (.NOT.altb) CALL dlartg(a(l,l), a(l1,l), d, e,tempr)
163 CALL drot(n-l+1, a(l,l), nmax, a(l1,l), nmax, d, e)
164 CALL drot(n-l+1, b(l,l), nmax, b(l1,l), nmax, d, e)
166 CALL dlartg(b(l1,l1), b(l2,l1), d, e,tempr)
167 CALL drot(n-l, a(l1,l1), nmax, a(l2,l1), nmax, d, e)
168 CALL drot(n-l, b(l1,l1), nmax, b(l2,l1), nmax, d, e)
183 ammbmm = a(l,l)/b(l,l)
184 anmbmm = a(l1,l)/b(l,l)
185 amnbnn = a(l,l1)/b(l1,l1)
186 annbnn = a(l1,l1)/b(l1,l1)
187 bmnbnn = b(l,l1)/b(l1,l1)
194 CALL dlartg(u(2,1), u(3,1), d, e,tempr)
195 CALL drot(n-l+1, a(l1,l), nmax, a(l2,l), nmax, d, e)
196 CALL drot(n-l, b(l1,l1), nmax, b(l2,l1), nmax, d, e)
197 u(2,1) = d*u(2,1) + e*u(3,1)
198 CALL dlartg(u(1,1), u(2,1), d, e,tempr)
199 CALL drot(n-l+1, a(l,l), nmax, a(l1,l), nmax, d, e)
200 CALL drot(n-l+1, b(l,l), nmax, b(l1,l), nmax, d, e)
202 CALL dlartg(b(l2,l1), b(l2,l2), d, e,tempr)
203 CALL drot(l3, a(1,l1), 1, a(1,l2), 1, e, -d)
204 CALL drot(l2, b(1,l1), 1, b(1,l2), 1, e, -d)
205 CALL drot(n, z(1,l1), 1, z(1,l2), 1, e, -d)
206 CALL dlartg(b(l1,l), b(l1,l1), d, e,tempr)
207 CALL drot(l3, a(1,l), 1, a(1,l1), 1, e, -d)
208 CALL drot(l1, b(1,l), 1, b(1,l1), 1, e, -d)
209 CALL drot(n, z(1,l), 1, z(1,l1), 1, e, -d)
212 CALL dlartg(a(l2,l), a(l3,l), d, e,tempr)
213 CALL drot(n-l+1, a(l2,l), nmax, a(l3,l), nmax, d, e)
214 CALL drot(n-l1, b(l2,l2), nmax, b(l3,l2), nmax, d, e)
215 CALL dlartg(b(l3,l2), b(l3,l3), d, e,tempr)
216 CALL drot(l3, a(1,l2), 1, a(1,l3), 1, e, -d)
217 CALL drot(l3, b(1,l2), 1, b(1,l3), 1, e, -d)
218 CALL drot(n, z(1,l2), 1, z(1,l3), 1, e, -d)
219 CALL dlartg(a(l1,l), a(l2,l), d, e,tempr)
220 CALL drot(n-l+1, a(l1,l), nmax, a(l2,l), nmax, d, e)
221 CALL drot(n-l, b(l1,l1), nmax, b(l2,l1), nmax, d, e)
222 CALL dlartg(b(l2,l1), b(l2,l2), d, e,tempr)
223 CALL drot(l3, a(1,l1), 1, a(1,l2), 1, e, -d)
224 CALL drot(l2, b(1,l1), 1, b(1,l2), 1, e, -d)
225 CALL drot(n, z(1,l1), 1, z(1,l2), 1, e, -d)
226 CALL dlartg(a(l2,l1), a(l3,l1), d, e,tempr)
227 CALL drot(n-l, a(l2,l1), nmax, a(l3,l1), nmax, d, e)
228 CALL drot(n-l1, b(l2,l2), nmax, b(l3,l2), nmax, d, e)
229 CALL dlartg(b(l3,l2), b(l3,l3), d, e,tempr)
230 CALL drot(l3, a(1,l2), 1, a(1,l3), 1, e, -d)
231 CALL drot(l3, b(1,l2), 1, b(1,l3), 1, e, -d)
232 CALL drot(n, z(1,l2), 1, z(1,l3), 1, e, -d)
234 IF (
abs(a(l2,l1)).LE.eps) go to 140
236 a11b11 = a(l,l)/b(l,l)
237 a12b22 = a(l,l1)/b(l1,l1)
238 a21b11 = a(l1,l)/b(l,l)
239 a22b22 = a(l1,l1)/b(l1,l1)
240 b12b22 = b(l,l1)/b(l1,l1)
241 u(1,1) = ((ammbmm-a11b11)*(annbnn-a11b11)-amnbnn*
242 * anmbmm+anmbmm*bmnbnn*a11b11)/a21b11 + a12b22 - a11b11*b12b22
243 u(2,1) = (a22b22-a11b11) - a21b11*b12b22 - (ammbmm-a11b11) -
244 * (annbnn-a11b11) + anmbmm*bmnbnn
245 u(3,1) = a(l2,l1)/b(l1,l1)
subroutine exchqz(NMAX, N, A, B, Z, L, LS1, LS2, EPS, FAIL)
charNDArray max(char d, const charNDArray &m)