1 /* ../netlib/shseqr.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib;
2 on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */
3 #include "FLA_f2c.h" /* Table of constant values */
4 static real c_b11 = 0.f;
5 static real c_b12 = 1.f;
6 static integer c__12 = 12;
7 static integer c__49 = 49;
8 /* > \brief \b SHSEQR */
9 /* =========== DOCUMENTATION =========== */
10 /* Online html documentation available at */
11 /* http://www.netlib.org/lapack/explore-html/ */
12 /* > \htmlonly */
13 /* > Download SHSEQR + dependencies */
14 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/shseqr. f"> */
15 /* > [TGZ]</a> */
16 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/shseqr. f"> */
17 /* > [ZIP]</a> */
18 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/shseqr. f"> */
19 /* > [TXT]</a> */
20 /* > \endhtmlonly */
21 /* Definition: */
22 /* =========== */
23 /* SUBROUTINE SHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, */
24 /* LDZ, WORK, LWORK, INFO ) */
25 /* .. Scalar Arguments .. */
26 /* INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N */
27 /* CHARACTER COMPZ, JOB */
28 /* .. */
29 /* .. Array Arguments .. */
30 /* REAL H( LDH, * ), WI( * ), WORK( * ), WR( * ), */
31 /* $ Z( LDZ, * ) */
32 /* .. */
33 /* > \par Purpose: */
34 /* ============= */
35 /* > */
36 /* > \verbatim */
37 /* > */
38 /* > SHSEQR computes the eigenvalues of a Hessenberg matrix H */
39 /* > and, optionally, the matrices T and Z from the Schur decomposition */
40 /* > H = Z T Z**T, where T is an upper quasi-triangular matrix (the */
41 /* > Schur form), and Z is the orthogonal matrix of Schur vectors. */
42 /* > */
43 /* > Optionally Z may be postmultiplied into an input orthogonal */
44 /* > matrix Q so that this routine can give the Schur factorization */
45 /* > of a matrix A which has been reduced to the Hessenberg form H */
46 /* > by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. */
47 /* > \endverbatim */
48 /* Arguments: */
49 /* ========== */
50 /* > \param[in] JOB */
51 /* > \verbatim */
52 /* > JOB is CHARACTER*1 */
53 /* > = 'E': compute eigenvalues only;
54 */
55 /* > = 'S': compute eigenvalues and the Schur form T. */
56 /* > \endverbatim */
57 /* > */
58 /* > \param[in] COMPZ */
59 /* > \verbatim */
60 /* > COMPZ is CHARACTER*1 */
61 /* > = 'N': no Schur vectors are computed;
62 */
63 /* > = 'I': Z is initialized to the unit matrix and the matrix Z */
64 /* > of Schur vectors of H is returned;
65 */
66 /* > = 'V': Z must contain an orthogonal matrix Q on entry, and */
67 /* > the product Q*Z is returned. */
68 /* > \endverbatim */
69 /* > */
70 /* > \param[in] N */
71 /* > \verbatim */
72 /* > N is INTEGER */
73 /* > The order of the matrix H. N .GE. 0. */
74 /* > \endverbatim */
75 /* > */
76 /* > \param[in] ILO */
77 /* > \verbatim */
78 /* > ILO is INTEGER */
79 /* > \endverbatim */
80 /* > */
81 /* > \param[in] IHI */
82 /* > \verbatim */
83 /* > IHI is INTEGER */
84 /* > */
85 /* > It is assumed that H is already upper triangular in rows */
86 /* > and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally */
87 /* > set by a previous call to SGEBAL, and then passed to ZGEHRD */
88 /* > when the matrix output by SGEBAL is reduced to Hessenberg */
89 /* > form. Otherwise ILO and IHI should be set to 1 and N */
90 /* > respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. */
91 /* > If N = 0, then ILO = 1 and IHI = 0. */
92 /* > \endverbatim */
93 /* > */
94 /* > \param[in,out] H */
95 /* > \verbatim */
96 /* > H is REAL array, dimension (LDH,N) */
97 /* > On entry, the upper Hessenberg matrix H. */
98 /* > On exit, if INFO = 0 and JOB = 'S', then H contains the */
99 /* > upper quasi-triangular matrix T from the Schur decomposition */
100 /* > (the Schur form);
101 2-by-2 diagonal blocks (corresponding to */
102 /* > complex conjugate pairs of eigenvalues) are returned in */
103 /* > standard form, with H(i,i) = H(i+1,i+1) and */
104 /* > H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the */
105 /* > contents of H are unspecified on exit. (The output value of */
106 /* > H when INFO.GT.0 is given under the description of INFO */
107 /* > below.) */
108 /* > */
109 /* > Unlike earlier versions of SHSEQR, this subroutine may */
110 /* > explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1 */
111 /* > or j = IHI+1, IHI+2, ... N. */
112 /* > \endverbatim */
113 /* > */
114 /* > \param[in] LDH */
115 /* > \verbatim */
116 /* > LDH is INTEGER */
117 /* > The leading dimension of the array H. LDH .GE. max(1,N). */
118 /* > \endverbatim */
119 /* > */
120 /* > \param[out] WR */
121 /* > \verbatim */
122 /* > WR is REAL array, dimension (N) */
123 /* > \endverbatim */
124 /* > */
125 /* > \param[out] WI */
126 /* > \verbatim */
127 /* > WI is REAL array, dimension (N) */
128 /* > */
129 /* > The real and imaginary parts, respectively, of the computed */
130 /* > eigenvalues. If two eigenvalues are computed as a complex */
131 /* > conjugate pair, they are stored in consecutive elements of */
132 /* > WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and */
133 /* > WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in */
134 /* > the same order as on the diagonal of the Schur form returned */
135 /* > in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 */
136 /* > diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and */
137 /* > WI(i+1) = -WI(i). */
138 /* > \endverbatim */
139 /* > */
140 /* > \param[in,out] Z */
141 /* > \verbatim */
142 /* > Z is REAL array, dimension (LDZ,N) */
143 /* > If COMPZ = 'N', Z is not referenced. */
144 /* > If COMPZ = 'I', on entry Z need not be set and on exit, */
145 /* > if INFO = 0, Z contains the orthogonal matrix Z of the Schur */
146 /* > vectors of H. If COMPZ = 'V', on entry Z must contain an */
147 /* > N-by-N matrix Q, which is assumed to be equal to the unit */
148 /* > matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit, */
149 /* > if INFO = 0, Z contains Q*Z. */
150 /* > Normally Q is the orthogonal matrix generated by SORGHR */
151 /* > after the call to SGEHRD which formed the Hessenberg matrix */
152 /* > H. (The output value of Z when INFO.GT.0 is given under */
153 /* > the description of INFO below.) */
154 /* > \endverbatim */
155 /* > */
156 /* > \param[in] LDZ */
157 /* > \verbatim */
158 /* > LDZ is INTEGER */
159 /* > The leading dimension of the array Z. if COMPZ = 'I' or */
160 /* > COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1. */
161 /* > \endverbatim */
162 /* > */
163 /* > \param[out] WORK */
164 /* > \verbatim */
165 /* > WORK is REAL array, dimension (LWORK) */
166 /* > On exit, if INFO = 0, WORK(1) returns an estimate of */
167 /* > the optimal value for LWORK. */
168 /* > \endverbatim */
169 /* > */
170 /* > \param[in] LWORK */
171 /* > \verbatim */
172 /* > LWORK is INTEGER */
173 /* > The dimension of the array WORK. LWORK .GE. max(1,N) */
174 /* > is sufficient and delivers very good and sometimes */
175 /* > optimal performance. However, LWORK as large as 11*N */
176 /* > may be required for optimal performance. A workspace */
177 /* > query is recommended to determine the optimal workspace */
178 /* > size. */
179 /* > */
180 /* > If LWORK = -1, then SHSEQR does a workspace query. */
181 /* > In this case, SHSEQR checks the input parameters and */
182 /* > estimates the optimal workspace size for the given */
183 /* > values of N, ILO and IHI. The estimate is returned */
184 /* > in WORK(1). No error message related to LWORK is */
185 /* > issued by XERBLA. Neither H nor Z are accessed. */
186 /* > \endverbatim */
187 /* > */
188 /* > \param[out] INFO */
189 /* > \verbatim */
190 /* > INFO is INTEGER */
191 /* > = 0: successful exit */
192 /* > .LT. 0: if INFO = -i, the i-th argument had an illegal */
193 /* > value */
194 /* > .GT. 0: if INFO = i, SHSEQR failed to compute all of */
195 /* > the eigenvalues. Elements 1:ilo-1 and i+1:n of WR */
196 /* > and WI contain those eigenvalues which have been */
197 /* > successfully computed. (Failures are rare.) */
198 /* > */
199 /* > If INFO .GT. 0 and JOB = 'E', then on exit, the */
200 /* > remaining unconverged eigenvalues are the eigen- */
201 /* > values of the upper Hessenberg matrix rows and */
202 /* > columns ILO through INFO of the final, output */
203 /* > value of H. */
204 /* > */
205 /* > If INFO .GT. 0 and JOB = 'S', then on exit */
206 /* > */
207 /* > (*) (initial value of H)*U = U*(final value of H) */
208 /* > */
209 /* > where U is an orthogonal matrix. The final */
210 /* > value of H is upper Hessenberg and quasi-triangular */
211 /* > in rows and columns INFO+1 through IHI. */
212 /* > */
213 /* > If INFO .GT. 0 and COMPZ = 'V', then on exit */
214 /* > */
215 /* > (final value of Z) = (initial value of Z)*U */
216 /* > */
217 /* > where U is the orthogonal matrix in (*) (regard- */
218 /* > less of the value of JOB.) */
219 /* > */
220 /* > If INFO .GT. 0 and COMPZ = 'I', then on exit */
221 /* > (final value of Z) = U */
222 /* > where U is the orthogonal matrix in (*) (regard- */
223 /* > less of the value of JOB.) */
224 /* > */
225 /* > If INFO .GT. 0 and COMPZ = 'N', then Z is not */
226 /* > accessed. */
227 /* > \endverbatim */
228 /* Authors: */
229 /* ======== */
230 /* > \author Univ. of Tennessee */
231 /* > \author Univ. of California Berkeley */
232 /* > \author Univ. of Colorado Denver */
233 /* > \author NAG Ltd. */
234 /* > \date November 2011 */
235 /* > \ingroup realOTHERcomputational */
236 /* > \par Contributors: */
237 /* ================== */
238 /* > */
239 /* > Karen Braman and Ralph Byers, Department of Mathematics, */
240 /* > University of Kansas, USA */
241 /* > \par Further Details: */
242 /* ===================== */
243 /* > */
244 /* > \verbatim */
245 /* > */
246 /* > Default values supplied by */
247 /* > ILAENV(ISPEC,'SHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK). */
248 /* > It is suggested that these defaults be adjusted in order */
249 /* > to attain best performance in each particular */
250 /* > computational environment. */
251 /* > */
252 /* > ISPEC=12: The SLAHQR vs SLAQR0 crossover point. */
253 /* > Default: 75. (Must be at least 11.) */
254 /* > */
255 /* > ISPEC=13: Recommended deflation window size. */
256 /* > This depends on ILO, IHI and NS. NS is the */
257 /* > number of simultaneous shifts returned */
258 /* > by ILAENV(ISPEC=15). (See ISPEC=15 below.) */
259 /* > The default for (IHI-ILO+1).LE.500 is NS. */
260 /* > The default for (IHI-ILO+1).GT.500 is 3*NS/2. */
261 /* > */
262 /* > ISPEC=14: Nibble crossover point. (See IPARMQ for */
263 /* > details.) Default: 14% of deflation window */
264 /* > size. */
265 /* > */
266 /* > ISPEC=15: Number of simultaneous shifts in a multishift */
267 /* > QR iteration. */
268 /* > */
269 /* > If IHI-ILO+1 is ... */
270 /* > */
271 /* > greater than ...but less ... the */
272 /* > or equal to ... than default is */
273 /* > */
274 /* > 1 30 NS = 2(+) */
275 /* > 30 60 NS = 4(+) */
276 /* > 60 150 NS = 10(+) */
277 /* > 150 590 NS = ** */
278 /* > 590 3000 NS = 64 */
279 /* > 3000 6000 NS = 128 */
280 /* > 6000 infinity NS = 256 */
281 /* > */
282 /* > (+) By default some or all matrices of this order */
283 /* > are passed to the implicit double shift routine */
284 /* > SLAHQR and this parameter is ignored. See */
285 /* > ISPEC=12 above and comments in IPARMQ for */
286 /* > details. */
287 /* > */
288 /* > (**) The asterisks (**) indicate an ad-hoc */
289 /* > function of N increasing from 10 to 64. */
290 /* > */
291 /* > ISPEC=16: Select structured matrix multiply. */
292 /* > If the number of simultaneous shifts (specified */
293 /* > by ISPEC=15) is less than 14, then the default */
294 /* > for ISPEC=16 is 0. Otherwise the default for */
295 /* > ISPEC=16 is 2. */
296 /* > \endverbatim */
297 /* > \par References: */
298 /* ================ */
299 /* > */
300 /* > K. Braman, R. Byers and R. Mathias, The Multi-Shift QR */
301 /* > Algorithm Part I: Maintaining Well Focused Shifts, and Level 3 */
302 /* > Performance, SIAM Journal of Matrix Analysis, volume 23, pages */
303 /* > 929--947, 2002. */
304 /* > \n */
305 /* > K. Braman, R. Byers and R. Mathias, The Multi-Shift QR */
306 /* > Algorithm Part II: Aggressive Early Deflation, SIAM Journal */
307 /* > of Matrix Analysis, volume 23, pages 948--973, 2002. */
308 /* ===================================================================== */
309 /* Subroutine */
shseqr_(char * job,char * compz,integer * n,integer * ilo,integer * ihi,real * h__,integer * ldh,real * wr,real * wi,real * z__,integer * ldz,real * work,integer * lwork,integer * info)310 int shseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, real *h__, integer *ldh, real *wr, real *wi, real *z__, integer *ldz, real *work, integer *lwork, integer *info)
311 {
312 /* System generated locals */
313 integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__3;
314 real r__1;
315 char ch__1[2];
316 /* Builtin functions */
317 /* Subroutine */
318
319 /* Local variables */
320 integer i__;
321 real hl[2401] /* was [49][49] */
322 ;
323 integer kbot, nmin;
324 extern logical lsame_(char *, char *);
325 logical initz;
326 real workl[49];
327 logical wantt, wantz;
328 extern /* Subroutine */
329 int slaqr0_(logical *, logical *, integer *, integer *, integer *, real *, integer *, real *, real *, integer * , integer *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *);
330 extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *);
331 extern /* Subroutine */
332 int slahqr_(logical *, logical *, integer *, integer *, integer *, real *, integer *, real *, real *, integer * , integer *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *);
333 logical lquery;
334 /* -- LAPACK computational routine (version 3.4.0) -- */
335 /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
336 /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
337 /* November 2011 */
338 /* .. Scalar Arguments .. */
339 /* .. */
340 /* .. Array Arguments .. */
341 /* .. */
342 /* ===================================================================== */
343 /* .. Parameters .. */
344 /* ==== Matrices of order NTINY or smaller must be processed by */
345 /* . SLAHQR because of insufficient subdiagonal scratch space. */
346 /* . (This is a hard limit.) ==== */
347 /* ==== NL allocates some local workspace to help small matrices */
348 /* . through a rare SLAHQR failure. NL .GT. NTINY = 11 is */
349 /* . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom- */
350 /* . mended. (The default value of NMIN is 75.) Using NL = 49 */
351 /* . allows up to six simultaneous shifts and a 16-by-16 */
352 /* . deflation window. ==== */
353 /* .. */
354 /* .. Local Arrays .. */
355 /* .. */
356 /* .. Local Scalars .. */
357 /* .. */
358 /* .. External Functions .. */
359 /* .. */
360 /* .. External Subroutines .. */
361 /* .. */
362 /* .. Intrinsic Functions .. */
363 /* .. */
364 /* .. Executable Statements .. */
365 /* ==== Decode and check the input parameters. ==== */
366 /* Parameter adjustments */
367 h_dim1 = *ldh;
368 h_offset = 1 + h_dim1;
369 h__ -= h_offset;
370 --wr;
371 --wi;
372 z_dim1 = *ldz;
373 z_offset = 1 + z_dim1;
374 z__ -= z_offset;
375 --work;
376 /* Function Body */
377 wantt = lsame_(job, "S");
378 initz = lsame_(compz, "I");
379 wantz = initz || lsame_(compz, "V");
380 work[1] = (real) max(1,*n);
381 lquery = *lwork == -1;
382 *info = 0;
383 if (! lsame_(job, "E") && ! wantt)
384 {
385 *info = -1;
386 }
387 else if (! lsame_(compz, "N") && ! wantz)
388 {
389 *info = -2;
390 }
391 else if (*n < 0)
392 {
393 *info = -3;
394 }
395 else if (*ilo < 1 || *ilo > max(1,*n))
396 {
397 *info = -4;
398 }
399 else if (*ihi < min(*ilo,*n) || *ihi > *n)
400 {
401 *info = -5;
402 }
403 else if (*ldh < max(1,*n))
404 {
405 *info = -7;
406 }
407 else if (*ldz < 1 || wantz && *ldz < max(1,*n))
408 {
409 *info = -11;
410 }
411 else if (*lwork < max(1,*n) && ! lquery)
412 {
413 *info = -13;
414 }
415 if (*info != 0)
416 {
417 /* ==== Quick return in case of invalid argument. ==== */
418 i__1 = -(*info);
419 xerbla_("SHSEQR", &i__1);
420 return 0;
421 }
422 else if (*n == 0)
423 {
424 /* ==== Quick return in case N = 0;
425 nothing to do. ==== */
426 return 0;
427 }
428 else if (lquery)
429 {
430 /* ==== Quick return in case of a workspace query ==== */
431 slaqr0_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[ 1], ilo, ihi, &z__[z_offset], ldz, &work[1], lwork, info);
432 /* ==== Ensure reported workspace size is backward-compatible with */
433 /* . previous LAPACK versions. ==== */
434 /* Computing MAX */
435 r__1 = (real) max(1,*n);
436 work[1] = max(r__1,work[1]);
437 return 0;
438 }
439 else
440 {
441 /* ==== copy eigenvalues isolated by SGEBAL ==== */
442 i__1 = *ilo - 1;
443 for (i__ = 1;
444 i__ <= i__1;
445 ++i__)
446 {
447 wr[i__] = h__[i__ + i__ * h_dim1];
448 wi[i__] = 0.f;
449 /* L10: */
450 }
451 i__1 = *n;
452 for (i__ = *ihi + 1;
453 i__ <= i__1;
454 ++i__)
455 {
456 wr[i__] = h__[i__ + i__ * h_dim1];
457 wi[i__] = 0.f;
458 /* L20: */
459 }
460 /* ==== Initialize Z, if requested ==== */
461 if (initz)
462 {
463 slaset_("A", n, n, &c_b11, &c_b12, &z__[z_offset], ldz) ;
464 }
465 /* ==== Quick return if possible ==== */
466 if (*ilo == *ihi)
467 {
468 wr[*ilo] = h__[*ilo + *ilo * h_dim1];
469 wi[*ilo] = 0.f;
470 return 0;
471 }
472 /* ==== SLAHQR/SLAQR0 crossover point ==== */
473 nmin = ilaenv_(&c__12, "SHSEQR", ch__1, n, ilo, ihi, lwork);
474 nmin = max(11,nmin);
475 /* ==== SLAQR0 for big matrices;
476 SLAHQR for small ones ==== */
477 if (*n > nmin)
478 {
479 slaqr0_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi, &z__[z_offset], ldz, &work[1], lwork, info);
480 }
481 else
482 {
483 /* ==== Small matrix ==== */
484 slahqr_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi, &z__[z_offset], ldz, info);
485 if (*info > 0)
486 {
487 /* ==== A rare SLAHQR failure! SLAQR0 sometimes succeeds */
488 /* . when SLAHQR fails. ==== */
489 kbot = *info;
490 if (*n >= 49)
491 {
492 /* ==== Larger matrices have enough subdiagonal scratch */
493 /* . space to call SLAQR0 directly. ==== */
494 slaqr0_(&wantt, &wantz, n, ilo, &kbot, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi, &z__[z_offset], ldz, &work[1], lwork, info);
495 }
496 else
497 {
498 /* ==== Tiny matrices don't have enough subdiagonal */
499 /* . scratch space to benefit from SLAQR0. Hence, */
500 /* . tiny matrices must be copied into a larger */
501 /* . array before calling SLAQR0. ==== */
502 slacpy_("A", n, n, &h__[h_offset], ldh, hl, &c__49);
503 hl[*n + 1 + *n * 49 - 50] = 0.f;
504 i__1 = 49 - *n;
505 slaset_("A", &c__49, &i__1, &c_b11, &c_b11, &hl[(*n + 1) * 49 - 49], &c__49);
506 slaqr0_(&wantt, &wantz, &c__49, ilo, &kbot, hl, &c__49, & wr[1], &wi[1], ilo, ihi, &z__[z_offset], ldz, workl, &c__49, info);
507 if (wantt || *info != 0)
508 {
509 slacpy_("A", n, n, hl, &c__49, &h__[h_offset], ldh);
510 }
511 }
512 }
513 }
514 /* ==== Clear out the trash, if necessary. ==== */
515 if ((wantt || *info != 0) && *n > 2)
516 {
517 i__1 = *n - 2;
518 i__3 = *n - 2;
519 slaset_("L", &i__1, &i__3, &c_b11, &c_b11, &h__[h_dim1 + 3], ldh);
520 }
521 /* ==== Ensure reported workspace size is backward-compatible with */
522 /* . previous LAPACK versions. ==== */
523 /* Computing MAX */
524 r__1 = (real) max(1,*n);
525 work[1] = max(r__1,work[1]);
526 }
527 /* ==== End of SHSEQR ==== */
528 return 0;
529 }
530 /* shseqr_ */
531