LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
alaerh.f
Go to the documentation of this file.
1 *> \brief \b ALAERH
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE ALAERH( PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU,
12 * N5, IMAT, NFAIL, NERRS, NOUT )
13 *
14 * .. Scalar Arguments ..
15 * CHARACTER*3 PATH
16 * CHARACTER*( * ) SUBNAM
17 * CHARACTER*( * ) OPTS
18 * INTEGER IMAT, INFO, INFOE, KL, KU, M, N, N5, NERRS,
19 * $ NFAIL, NOUT
20 * ..
21 *
22 *
23 *> \par Purpose:
24 * =============
25 *>
26 *> \verbatim
27 *>
28 *> ALAERH is an error handler for the LAPACK routines. It prints the
29 *> header if this is the first error message and prints the error code
30 *> and form of recovery, if any. The character evaluations in this
31 *> routine may make it slow, but it should not be called once the LAPACK
32 *> routines are fully debugged.
33 *> \endverbatim
34 *
35 * Arguments:
36 * ==========
37 *
38 *> \param[in] PATH
39 *> \verbatim
40 *> PATH is CHARACTER*3
41 *> The LAPACK path name of subroutine SUBNAM.
42 *> \endverbatim
43 *>
44 *> \param[in] SUBNAM
45 *> \verbatim
46 *> SUBNAM is CHARACTER*(*)
47 *> The name of the subroutine that returned an error code.
48 *> \endverbatim
49 *>
50 *> \param[in] INFO
51 *> \verbatim
52 *> INFO is INTEGER
53 *> The error code returned from routine SUBNAM.
54 *> \endverbatim
55 *>
56 *> \param[in] INFOE
57 *> \verbatim
58 *> INFOE is INTEGER
59 *> The expected error code from routine SUBNAM, if SUBNAM were
60 *> error-free. If INFOE = 0, an error message is printed, but
61 *> if INFOE.NE.0, we assume only the return code INFO is wrong.
62 *> \endverbatim
63 *>
64 *> \param[in] OPTS
65 *> \verbatim
66 *> OPTS is CHARACTER*(*)
67 *> The character options to the subroutine SUBNAM, concatenated
68 *> into a single character string. For example, UPLO = 'U',
69 *> TRANS = 'T', and DIAG = 'N' for a triangular routine would
70 *> be specified as OPTS = 'UTN'.
71 *> \endverbatim
72 *>
73 *> \param[in] M
74 *> \verbatim
75 *> M is INTEGER
76 *> The matrix row dimension.
77 *> \endverbatim
78 *>
79 *> \param[in] N
80 *> \verbatim
81 *> N is INTEGER
82 *> The matrix column dimension. Accessed only if PATH = xGE or
83 *> xGB.
84 *> \endverbatim
85 *>
86 *> \param[in] KL
87 *> \verbatim
88 *> KL is INTEGER
89 *> The number of sub-diagonals of the matrix. Accessed only if
90 *> PATH = xGB, xPB, or xTB. Also used for NRHS for PATH = xLS.
91 *> \endverbatim
92 *>
93 *> \param[in] KU
94 *> \verbatim
95 *> KU is INTEGER
96 *> The number of super-diagonals of the matrix. Accessed only
97 *> if PATH = xGB.
98 *> \endverbatim
99 *>
100 *> \param[in] N5
101 *> \verbatim
102 *> N5 is INTEGER
103 *> A fifth integer parameter, may be the blocksize NB or the
104 *> number of right hand sides NRHS.
105 *> \endverbatim
106 *>
107 *> \param[in] IMAT
108 *> \verbatim
109 *> IMAT is INTEGER
110 *> The matrix type.
111 *> \endverbatim
112 *>
113 *> \param[in] NFAIL
114 *> \verbatim
115 *> NFAIL is INTEGER
116 *> The number of prior tests that did not pass the threshold;
117 *> used to determine if the header should be printed.
118 *> \endverbatim
119 *>
120 *> \param[in,out] NERRS
121 *> \verbatim
122 *> NERRS is INTEGER
123 *> On entry, the number of errors already detected; used to
124 *> determine if the header should be printed.
125 *> On exit, NERRS is increased by 1.
126 *> \endverbatim
127 *>
128 *> \param[in] NOUT
129 *> \verbatim
130 *> NOUT is INTEGER
131 *> The unit number on which results are to be printed.
132 *> \endverbatim
133 *
134 * Authors:
135 * ========
136 *
137 *> \author Univ. of Tennessee
138 *> \author Univ. of California Berkeley
139 *> \author Univ. of Colorado Denver
140 *> \author NAG Ltd.
141 *
142 *> \date April 2012
143 *
144 *> \ingroup aux_lin
145 *
146 * =====================================================================
147  SUBROUTINE alaerh( PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU,
148  $ n5, imat, nfail, nerrs, nout )
149 *
150 * -- LAPACK test routine (version 3.4.1) --
151 * -- LAPACK is a software package provided by Univ. of Tennessee, --
152 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
153 * April 2012
154 *
155 * .. Scalar Arguments ..
156  CHARACTER*3 path
157  CHARACTER*( * ) subnam
158  CHARACTER*( * ) opts
159  INTEGER imat, info, infoe, kl, ku, m, n, n5, nerrs,
160  $ nfail, nout
161 * ..
162 *
163 * =====================================================================
164 *
165 * .. Local Scalars ..
166  CHARACTER uplo
167  CHARACTER*2 p2
168  CHARACTER*3 c3
169 * ..
170 * .. External Functions ..
171  LOGICAL lsame, lsamen
172  EXTERNAL lsame, lsamen
173 * ..
174 * .. Intrinsic Functions ..
175  INTRINSIC len_trim
176 * ..
177 * .. External Subroutines ..
178  EXTERNAL aladhd, alahd
179 * ..
180 * .. Executable Statements ..
181 *
182  IF( info.EQ.0 )
183  $ return
184  p2 = path( 2: 3 )
185  c3 = subnam( 4: 6 )
186 *
187 * Print the header if this is the first error message.
188 *
189  IF( nfail.EQ.0 .AND. nerrs.EQ.0 ) THEN
190  IF( lsamen( 3, c3, 'SV ' ) .OR. lsamen( 3, c3, 'SVX' ) ) THEN
191  CALL aladhd( nout, path )
192  ELSE
193  CALL alahd( nout, path )
194  END IF
195  END IF
196  nerrs = nerrs + 1
197 *
198 * Print the message detailing the error and form of recovery,
199 * if any.
200 *
201  IF( lsamen( 2, p2, 'GE' ) ) THEN
202 *
203 * xGE: General matrices
204 *
205  IF( lsamen( 3, c3, 'TRF' ) ) THEN
206  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
207  WRITE( nout, fmt = 9988 )
208  $ subnam(1:len_trim( subnam )), info, infoe, m, n, n5,
209  $ imat
210  ELSE
211  WRITE( nout, fmt = 9975 )
212  $ subnam(1:len_trim( subnam )), info, m, n, n5, imat
213  END IF
214  IF( info.NE.0 )
215  $ WRITE( nout, fmt = 9949 )
216 *
217  ELSE IF( lsamen( 3, c3, 'SV ' ) ) THEN
218 *
219  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
220  WRITE( nout, fmt = 9984 )
221  $ subnam(1:len_trim( subnam )), info, infoe, n, n5,
222  $ imat
223  ELSE
224  WRITE( nout, fmt = 9970 )
225  $ subnam(1:len_trim( subnam )), info, n, n5, imat
226  END IF
227 *
228  ELSE IF( lsamen( 3, c3, 'SVX' ) ) THEN
229 *
230  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
231  WRITE( nout, fmt = 9992 )
232  $ subnam(1:len_trim( subnam )), info, infoe,
233  $ opts( 1: 1 ), opts( 2: 2 ), n, n5, imat
234  ELSE
235  WRITE( nout, fmt = 9997 )
236  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
237  $ opts( 2: 2 ), n, n5, imat
238  END IF
239 *
240  ELSE IF( lsamen( 3, c3, 'TRI' ) ) THEN
241 *
242  WRITE( nout, fmt = 9971 )
243  $ subnam(1:len_trim( subnam )), info, n, n5, imat
244 *
245  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) ) THEN
246 *
247  WRITE( nout, fmt = 9978 )
248  $ subnam(1:len_trim( subnam )), info, m, n, imat
249 *
250  ELSE IF( lsamen( 3, c3, 'CON' ) ) THEN
251 *
252  WRITE( nout, fmt = 9969 )
253  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), m,
254  $ imat
255 *
256  ELSE IF( lsamen( 3, c3, 'LS ' ) ) THEN
257 *
258  WRITE( nout, fmt = 9965 )
259  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), m, n,
260  $ kl, n5, imat
261 *
262  ELSE IF( lsamen( 3, c3, 'LSX' ) .OR. lsamen( 3, c3, 'LSS' ) )
263  $ THEN
264 *
265  WRITE( nout, fmt = 9974 )
266  $ subnam(1:len_trim( subnam )), info, m, n, kl, n5, imat
267 *
268  ELSE
269 *
270  WRITE( nout, fmt = 9963 )
271  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), m, n5,
272  $ imat
273  END IF
274 *
275  ELSE IF( lsamen( 2, p2, 'GB' ) ) THEN
276 *
277 * xGB: General band matrices
278 *
279  IF( lsamen( 3, c3, 'TRF' ) ) THEN
280  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
281  WRITE( nout, fmt = 9989 )
282  $ subnam(1:len_trim( subnam )), info, infoe, m, n, kl,
283  $ ku, n5, imat
284  ELSE
285  WRITE( nout, fmt = 9976 )
286  $ subnam(1:len_trim( subnam )), info, m, n, kl, ku, n5,
287  $ imat
288  END IF
289  IF( info.NE.0 )
290  $ WRITE( nout, fmt = 9949 )
291 *
292  ELSE IF( lsamen( 3, c3, 'SV ' ) ) THEN
293 *
294  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
295  WRITE( nout, fmt = 9986 )
296  $ subnam(1:len_trim( subnam )), info, infoe, n, kl, ku,
297  $ n5, imat
298  ELSE
299  WRITE( nout, fmt = 9972 )
300  $ subnam(1:len_trim( subnam )), info, n, kl, ku, n5,
301  $ imat
302  END IF
303 *
304  ELSE IF( lsamen( 3, c3, 'SVX' ) ) THEN
305 *
306  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
307  WRITE( nout, fmt = 9993 )
308  $ subnam(1:len_trim( subnam )), info, infoe,
309  $ opts( 1: 1 ), opts( 2: 2 ), n, kl, ku, n5, imat
310  ELSE
311  WRITE( nout, fmt = 9998 )
312  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
313  $ opts( 2: 2 ), n, kl, ku, n5, imat
314  END IF
315 *
316  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) ) THEN
317 *
318  WRITE( nout, fmt = 9977 )
319  $ subnam(1:len_trim( subnam )), info, m, n, kl, ku, imat
320 *
321  ELSE IF( lsamen( 3, c3, 'CON' ) ) THEN
322 *
323  WRITE( nout, fmt = 9968 )
324  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), m, kl,
325  $ ku, imat
326 *
327  ELSE
328 *
329  WRITE( nout, fmt = 9964 )
330  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), m, kl,
331  $ ku, n5, imat
332  END IF
333 *
334  ELSE IF( lsamen( 2, p2, 'GT' ) ) THEN
335 *
336 * xGT: General tridiagonal matrices
337 *
338  IF( lsamen( 3, c3, 'TRF' ) ) THEN
339  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
340  WRITE( nout, fmt = 9987 )
341  $ subnam(1:len_trim( subnam )), info, infoe, n, imat
342  ELSE
343  WRITE( nout, fmt = 9973 )
344  $ subnam(1:len_trim( subnam )), info, n, imat
345  END IF
346  IF( info.NE.0 )
347  $ WRITE( nout, fmt = 9949 )
348 *
349  ELSE IF( lsamen( 3, c3, 'SV ' ) ) THEN
350 *
351  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
352  WRITE( nout, fmt = 9984 )
353  $ subnam(1:len_trim( subnam )), info, infoe, n, n5,
354  $ imat
355  ELSE
356  WRITE( nout, fmt = 9970 )
357  $ subnam(1:len_trim( subnam )), info, n, n5, imat
358  END IF
359 *
360  ELSE IF( lsamen( 3, c3, 'SVX' ) ) THEN
361 *
362  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
363  WRITE( nout, fmt = 9992 )
364  $ subnam(1:len_trim( subnam )), info, infoe,
365  $ opts( 1: 1 ), opts( 2: 2 ), n, n5, imat
366  ELSE
367  WRITE( nout, fmt = 9997 )
368  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
369  $ opts( 2: 2 ), n, n5, imat
370  END IF
371 *
372  ELSE IF( lsamen( 3, c3, 'CON' ) ) THEN
373 *
374  WRITE( nout, fmt = 9969 )
375  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), m,
376  $ imat
377 *
378  ELSE
379 *
380  WRITE( nout, fmt = 9963 )
381  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), m, n5,
382  $ imat
383  END IF
384 *
385  ELSE IF( lsamen( 2, p2, 'PO' ) ) THEN
386 *
387 * xPO: Symmetric or Hermitian positive definite matrices
388 *
389  uplo = opts( 1: 1 )
390  IF( lsamen( 3, c3, 'TRF' ) ) THEN
391  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
392  WRITE( nout, fmt = 9980 )
393  $ subnam(1:len_trim( subnam )), info, infoe, uplo, m,
394  $ n5, imat
395  ELSE
396  WRITE( nout, fmt = 9956 )
397  $ subnam(1:len_trim( subnam )), info, uplo, m, n5, imat
398  END IF
399  IF( info.NE.0 )
400  $ WRITE( nout, fmt = 9949 )
401 *
402  ELSE IF( lsamen( 3, c3, 'SV ' ) ) THEN
403 *
404  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
405  WRITE( nout, fmt = 9979 )
406  $ subnam(1:len_trim( subnam )), info, infoe, uplo, n,
407  $ n5, imat
408  ELSE
409  WRITE( nout, fmt = 9955 )
410  $ subnam(1:len_trim( subnam )), info, uplo, n, n5, imat
411  END IF
412 *
413  ELSE IF( lsamen( 3, c3, 'SVX' ) ) THEN
414 *
415  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
416  WRITE( nout, fmt = 9990 )
417  $ subnam(1:len_trim( subnam )), info, infoe,
418  $ opts( 1: 1 ), opts( 2: 2 ), n, n5, imat
419  ELSE
420  WRITE( nout, fmt = 9995 )
421  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
422  $ opts( 2: 2 ), n, n5, imat
423  END IF
424 *
425  ELSE IF( lsamen( 3, c3, 'TRI' ) ) THEN
426 *
427  WRITE( nout, fmt = 9956 )
428  $ subnam(1:len_trim( subnam )), info, uplo, m, n5, imat
429 *
430  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) .OR.
431  $ lsamen( 3, c3, 'CON' ) ) THEN
432 *
433  WRITE( nout, fmt = 9960 )
434  $ subnam(1:len_trim( subnam )), info, uplo, m, imat
435 *
436  ELSE
437 *
438  WRITE( nout, fmt = 9955 )
439  $ subnam(1:len_trim( subnam )), info, uplo, m, n5, imat
440  END IF
441 *
442  ELSE IF( lsamen( 2, p2, 'PS' ) ) THEN
443 *
444 * xPS: Symmetric or Hermitian positive semi-definite matrices
445 *
446  uplo = opts( 1: 1 )
447  IF( lsamen( 3, c3, 'TRF' ) ) THEN
448  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
449  WRITE( nout, fmt = 9980 )subnam, info, infoe, uplo, m,
450  $ n5, imat
451  ELSE
452  WRITE( nout, fmt = 9956 )subnam, info, uplo, m, n5, imat
453  END IF
454  IF( info.NE.0 )
455  $ WRITE( nout, fmt = 9949 )
456 *
457  ELSE IF( lsamen( 3, c3, 'SV ' ) ) THEN
458 *
459  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
460  WRITE( nout, fmt = 9979 )subnam, info, infoe, uplo, n,
461  $ n5, imat
462  ELSE
463  WRITE( nout, fmt = 9955 )subnam, info, uplo, n, n5, imat
464  END IF
465 *
466  ELSE IF( lsamen( 3, c3, 'SVX' ) ) THEN
467 *
468  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
469  WRITE( nout, fmt = 9990 )subnam, info, infoe,
470  $ opts( 1: 1 ), opts( 2: 2 ), n, n5, imat
471  ELSE
472  WRITE( nout, fmt = 9995 )subnam, info, opts( 1: 1 ),
473  $ opts( 2: 2 ), n, n5, imat
474  END IF
475 *
476  ELSE IF( lsamen( 3, c3, 'TRI' ) ) THEN
477 *
478  WRITE( nout, fmt = 9956 )subnam, info, uplo, m, n5, imat
479 *
480  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMT' ) .OR.
481  $ lsamen( 3, c3, 'CON' ) ) THEN
482 *
483  WRITE( nout, fmt = 9960 )subnam, info, uplo, m, imat
484 *
485  ELSE
486 *
487  WRITE( nout, fmt = 9955 )subnam, info, uplo, m, n5, imat
488  END IF
489 *
490  ELSE IF( lsamen( 2, p2, 'SY' ) .OR. lsamen( 2, p2, 'HE' ) ) THEN
491 *
492 * xHE, or xSY: Symmetric or Hermitian indefinite matrices
493 *
494  uplo = opts( 1: 1 )
495  IF( lsamen( 3, c3, 'TRF' ) ) THEN
496  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
497  WRITE( nout, fmt = 9980 )
498  $ subnam(1:len_trim( subnam )), info, infoe, uplo, m,
499  $ n5, imat
500  ELSE
501  WRITE( nout, fmt = 9956 )
502  $ subnam(1:len_trim( subnam )), info, uplo, m, n5, imat
503  END IF
504  IF( info.NE.0 )
505  $ WRITE( nout, fmt = 9949 )
506 *
507  ELSE IF( lsamen( 2, c3, 'SV' ) ) THEN
508 *
509  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
510  WRITE( nout, fmt = 9979 )
511  $ subnam(1:len_trim( subnam )), info, infoe, uplo, n,
512  $ n5, imat
513  ELSE
514  WRITE( nout, fmt = 9955 )
515  $ subnam(1:len_trim( subnam )), info, uplo, n, n5, imat
516  END IF
517 *
518  ELSE IF( lsamen( 3, c3, 'SVX' ) ) THEN
519 *
520  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
521  WRITE( nout, fmt = 9990 )
522  $ subnam(1:len_trim( subnam )), info, infoe,
523  $ opts( 1: 1 ), opts( 2: 2 ), n, n5, imat
524  ELSE
525  WRITE( nout, fmt = 9995 )
526  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
527  $ opts( 2: 2 ), n, n5, imat
528  END IF
529 *
530  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) .OR.
531  $ lsamen( 3, c3, 'TRI' ) .OR. lsamen( 3, c3, 'CON' ) )
532  $ THEN
533 *
534  WRITE( nout, fmt = 9960 )
535  $ subnam(1:len_trim( subnam )), info, uplo, m, imat
536 *
537  ELSE
538 *
539  WRITE( nout, fmt = 9955 )
540  $ subnam(1:len_trim( subnam )), info, uplo, m, n5, imat
541  END IF
542 *
543  ELSE IF( lsamen( 2, p2, 'PP' ) .OR. lsamen( 2, p2, 'SP' ) .OR.
544  $ lsamen( 2, p2, 'HP' ) ) THEN
545 *
546 * xPP, xHP, or xSP: Symmetric or Hermitian packed matrices
547 *
548  uplo = opts( 1: 1 )
549  IF( lsamen( 3, c3, 'TRF' ) ) THEN
550  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
551  WRITE( nout, fmt = 9983 )
552  $ subnam(1:len_trim( subnam )), info, infoe, uplo, m,
553  $ imat
554  ELSE
555  WRITE( nout, fmt = 9960 )
556  $ subnam(1:len_trim( subnam )), info, uplo, m, imat
557  END IF
558  IF( info.NE.0 )
559  $ WRITE( nout, fmt = 9949 )
560 *
561  ELSE IF( lsamen( 3, c3, 'SV ' ) ) THEN
562 *
563  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
564  WRITE( nout, fmt = 9979 )
565  $ subnam(1:len_trim( subnam )), info, infoe, uplo, n,
566  $ n5, imat
567  ELSE
568  WRITE( nout, fmt = 9955 )
569  $ subnam(1:len_trim( subnam )), info, uplo, n, n5, imat
570  END IF
571 *
572  ELSE IF( lsamen( 3, c3, 'SVX' ) ) THEN
573 *
574  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
575  WRITE( nout, fmt = 9990 )
576  $ subnam(1:len_trim( subnam )), info, infoe,
577  $ opts( 1: 1 ), opts( 2: 2 ), n, n5, imat
578  ELSE
579  WRITE( nout, fmt = 9995 )
580  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
581  $ opts( 2: 2 ), n, n5, imat
582  END IF
583 *
584  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) .OR.
585  $ lsamen( 3, c3, 'TRI' ) .OR. lsamen( 3, c3, 'CON' ) )
586  $ THEN
587 *
588  WRITE( nout, fmt = 9960 )
589  $ subnam(1:len_trim( subnam )), info, uplo, m, imat
590 *
591  ELSE
592 *
593  WRITE( nout, fmt = 9955 )
594  $ subnam(1:len_trim( subnam )), info, uplo, m, n5, imat
595  END IF
596 *
597  ELSE IF( lsamen( 2, p2, 'PB' ) ) THEN
598 *
599 * xPB: Symmetric (Hermitian) positive definite band matrix
600 *
601  uplo = opts( 1: 1 )
602  IF( lsamen( 3, c3, 'TRF' ) ) THEN
603  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
604  WRITE( nout, fmt = 9982 )
605  $ subnam(1:len_trim( subnam )), info, infoe, uplo, m,
606  $ kl, n5, imat
607  ELSE
608  WRITE( nout, fmt = 9958 )
609  $ subnam(1:len_trim( subnam )), info, uplo, m, kl, n5,
610  $ imat
611  END IF
612  IF( info.NE.0 )
613  $ WRITE( nout, fmt = 9949 )
614 *
615  ELSE IF( lsamen( 3, c3, 'SV ' ) ) THEN
616 *
617  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
618  WRITE( nout, fmt = 9981 )
619  $ subnam(1:len_trim( subnam )), info, infoe, uplo, n,
620  $ kl, n5, imat
621  ELSE
622  WRITE( nout, fmt = 9957 )
623  $ subnam(1:len_trim( subnam )), info, uplo, n, kl, n5,
624  $ imat
625  END IF
626 *
627  ELSE IF( lsamen( 3, c3, 'SVX' ) ) THEN
628 *
629  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
630  WRITE( nout, fmt = 9991 )
631  $ subnam(1:len_trim( subnam )), info, infoe,
632  $ opts( 1: 1 ), opts( 2: 2 ), n, kl, n5, imat
633  ELSE
634  WRITE( nout, fmt = 9996 )
635  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
636  $ opts( 2: 2 ), n, kl, n5, imat
637  END IF
638 *
639  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) .OR.
640  $ lsamen( 3, c3, 'CON' ) ) THEN
641 *
642  WRITE( nout, fmt = 9959 )
643  $ subnam(1:len_trim( subnam )), info, uplo, m, kl, imat
644 *
645  ELSE
646 *
647  WRITE( nout, fmt = 9957 )
648  $ subnam(1:len_trim( subnam )), info, uplo, m, kl, n5,
649  $ imat
650  END IF
651 *
652  ELSE IF( lsamen( 2, p2, 'PT' ) ) THEN
653 *
654 * xPT: Positive definite tridiagonal matrices
655 *
656  IF( lsamen( 3, c3, 'TRF' ) ) THEN
657  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
658  WRITE( nout, fmt = 9987 )
659  $ subnam(1:len_trim( subnam )), info, infoe, n, imat
660  ELSE
661  WRITE( nout, fmt = 9973 )
662  $ subnam(1:len_trim( subnam )), info, n, imat
663  END IF
664  IF( info.NE.0 )
665  $ WRITE( nout, fmt = 9949 )
666 *
667  ELSE IF( lsamen( 3, c3, 'SV ' ) ) THEN
668 *
669  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
670  WRITE( nout, fmt = 9984 )
671  $ subnam(1:len_trim( subnam )), info, infoe, n, n5,
672  $ imat
673  ELSE
674  WRITE( nout, fmt = 9970 )
675  $ subnam(1:len_trim( subnam )), info, n, n5, imat
676  END IF
677 *
678  ELSE IF( lsamen( 3, c3, 'SVX' ) ) THEN
679 *
680  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
681  WRITE( nout, fmt = 9994 )
682  $ subnam(1:len_trim( subnam )), info, infoe,
683  $ opts( 1: 1 ), n, n5, imat
684  ELSE
685  WRITE( nout, fmt = 9999 )
686  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), n,
687  $ n5, imat
688  END IF
689 *
690  ELSE IF( lsamen( 3, c3, 'CON' ) ) THEN
691 *
692  IF( lsame( subnam( 1: 1 ), 'S' ) .OR.
693  $ lsame( subnam( 1: 1 ), 'D' ) ) THEN
694  WRITE( nout, fmt = 9973 )
695  $ subnam(1:len_trim( subnam )), info, m, imat
696  ELSE
697  WRITE( nout, fmt = 9969 )
698  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), m,
699  $ imat
700  END IF
701 *
702  ELSE
703 *
704  WRITE( nout, fmt = 9963 )
705  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ), m, n5,
706  $ imat
707  END IF
708 *
709  ELSE IF( lsamen( 2, p2, 'TR' ) ) THEN
710 *
711 * xTR: Triangular matrix
712 *
713  IF( lsamen( 3, c3, 'TRI' ) ) THEN
714  WRITE( nout, fmt = 9961 )
715  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
716  $ opts( 2: 2 ), m, n5, imat
717  ELSE IF( lsamen( 3, c3, 'CON' ) ) THEN
718  WRITE( nout, fmt = 9967 )
719  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
720  $ opts( 2: 2 ), opts( 3: 3 ), m, imat
721  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATRS' ) ) THEN
722  WRITE( nout, fmt = 9952 )
723  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
724  $ opts( 2: 2 ), opts( 3: 3 ), opts( 4: 4 ), m, imat
725  ELSE
726  WRITE( nout, fmt = 9953 )
727  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
728  $ opts( 2: 2 ), opts( 3: 3 ), m, n5, imat
729  END IF
730 *
731  ELSE IF( lsamen( 2, p2, 'TP' ) ) THEN
732 *
733 * xTP: Triangular packed matrix
734 *
735  IF( lsamen( 3, c3, 'TRI' ) ) THEN
736  WRITE( nout, fmt = 9962 )
737  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
738  $ opts( 2: 2 ), m, imat
739  ELSE IF( lsamen( 3, c3, 'CON' ) ) THEN
740  WRITE( nout, fmt = 9967 )
741  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
742  $ opts( 2: 2 ), opts( 3: 3 ), m, imat
743  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATPS' ) ) THEN
744  WRITE( nout, fmt = 9952 )
745  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
746  $ opts( 2: 2 ), opts( 3: 3 ), opts( 4: 4 ), m, imat
747  ELSE
748  WRITE( nout, fmt = 9953 )
749  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
750  $ opts( 2: 2 ), opts( 3: 3 ), m, n5, imat
751  END IF
752 *
753  ELSE IF( lsamen( 2, p2, 'TB' ) ) THEN
754 *
755 * xTB: Triangular band matrix
756 *
757  IF( lsamen( 3, c3, 'CON' ) ) THEN
758  WRITE( nout, fmt = 9966 )
759  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
760  $ opts( 2: 2 ), opts( 3: 3 ), m, kl, imat
761  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATBS' ) ) THEN
762  WRITE( nout, fmt = 9951 )
763  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
764  $ opts( 2: 2 ), opts( 3: 3 ), opts( 4: 4 ), m, kl, imat
765  ELSE
766  WRITE( nout, fmt = 9954 )
767  $ subnam(1:len_trim( subnam )), info, opts( 1: 1 ),
768  $ opts( 2: 2 ), opts( 3: 3 ), m, kl, n5, imat
769  END IF
770 *
771  ELSE IF( lsamen( 2, p2, 'QR' ) ) THEN
772 *
773 * xQR: QR factorization
774 *
775  IF( lsamen( 3, c3, 'QRS' ) ) THEN
776  WRITE( nout, fmt = 9974 )
777  $ subnam(1:len_trim( subnam )), info, m, n, kl, n5, imat
778  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) ) THEN
779  WRITE( nout, fmt = 9978 )
780  $ subnam(1:len_trim( subnam )), info, m, n, imat
781  END IF
782 *
783  ELSE IF( lsamen( 2, p2, 'LQ' ) ) THEN
784 *
785 * xLQ: LQ factorization
786 *
787  IF( lsamen( 3, c3, 'LQS' ) ) THEN
788  WRITE( nout, fmt = 9974 )
789  $ subnam(1:len_trim( subnam )), info, m, n, kl, n5, imat
790  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) ) THEN
791  WRITE( nout, fmt = 9978 )
792  $ subnam(1:len_trim( subnam )), info, m, n, imat
793  END IF
794 *
795  ELSE IF( lsamen( 2, p2, 'QL' ) ) THEN
796 *
797 * xQL: QL factorization
798 *
799  IF( lsamen( 3, c3, 'QLS' ) ) THEN
800  WRITE( nout, fmt = 9974 )
801  $ subnam(1:len_trim( subnam )), info, m, n, kl, n5, imat
802  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) ) THEN
803  WRITE( nout, fmt = 9978 )
804  $ subnam(1:len_trim( subnam )), info, m, n, imat
805  END IF
806 *
807  ELSE IF( lsamen( 2, p2, 'RQ' ) ) THEN
808 *
809 * xRQ: RQ factorization
810 *
811  IF( lsamen( 3, c3, 'RQS' ) ) THEN
812  WRITE( nout, fmt = 9974 )
813  $ subnam(1:len_trim( subnam )), info, m, n, kl, n5, imat
814  ELSE IF( lsamen( 5, subnam( 2: 6 ), 'LATMS' ) ) THEN
815  WRITE( nout, fmt = 9978 )
816  $ subnam(1:len_trim( subnam )), info, m, n, imat
817  END IF
818 *
819  ELSE IF( lsamen( 2, p2, 'LU' ) ) THEN
820 *
821  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
822  WRITE( nout, fmt = 9988 )
823  $ subnam(1:len_trim( subnam )), info, infoe, m, n, n5,
824  $ imat
825  ELSE
826  WRITE( nout, fmt = 9975 )
827  $ subnam(1:len_trim( subnam )), info, m, n, n5, imat
828  END IF
829 *
830  ELSE IF( lsamen( 2, p2, 'CH' ) ) THEN
831 *
832  IF( info.NE.infoe .AND. infoe.NE.0 ) THEN
833  WRITE( nout, fmt = 9985 )
834  $ subnam(1:len_trim( subnam )), info, infoe, m, n5, imat
835  ELSE
836  WRITE( nout, fmt = 9971 )
837  $ subnam(1:len_trim( subnam )), info, m, n5, imat
838  END IF
839 *
840  ELSE
841 *
842 * Print a generic message if the path is unknown.
843 *
844  WRITE( nout, fmt = 9950 )
845  $ subnam(1:len_trim( subnam )), info
846  END IF
847 *
848 * Description of error message (alphabetical, left to right)
849 *
850 * SUBNAM, INFO, FACT, N, NRHS, IMAT
851 *
852  9999 format( ' *** Error code from ', a, '=', i5, ', FACT=''', a1,
853  $ ''', N=', i5, ', NRHS=', i4, ', type ', i2 )
854 *
855 * SUBNAM, INFO, FACT, TRANS, N, KL, KU, NRHS, IMAT
856 *
857  9998 format( ' *** Error code from ', a, ' =', i5, / ' ==> FACT=''',
858  $ a1, ''', TRANS=''', a1, ''', N=', i5, ', KL=', i5, ', KU=',
859  $ i5, ', NRHS=', i4, ', type ', i1 )
860 *
861 * SUBNAM, INFO, FACT, TRANS, N, NRHS, IMAT
862 *
863  9997 format( ' *** Error code from ', a, ' =', i5, / ' ==> FACT=''',
864  $ a1, ''', TRANS=''', a1, ''', N =', i5, ', NRHS =', i4,
865  $ ', type ', i2 )
866 *
867 * SUBNAM, INFO, FACT, UPLO, N, KD, NRHS, IMAT
868 *
869  9996 format( ' *** Error code from ', a, ' =', i5, / ' ==> FACT=''',
870  $ a1, ''', UPLO=''', a1, ''', N=', i5, ', KD=', i5, ', NRHS=',
871  $ i4, ', type ', i2 )
872 *
873 * SUBNAM, INFO, FACT, UPLO, N, NRHS, IMAT
874 *
875  9995 format( ' *** Error code from ', a, ' =', i5, / ' ==> FACT=''',
876  $ a1, ''', UPLO=''', a1, ''', N =', i5, ', NRHS =', i4,
877  $ ', type ', i2 )
878 *
879 * SUBNAM, INFO, INFOE, FACT, N, NRHS, IMAT
880 *
881  9994 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
882  $ i2, / ' ==> FACT=''', a1, ''', N =', i5, ', NRHS =', i4,
883  $ ', type ', i2 )
884 *
885 * SUBNAM, INFO, INFOE, FACT, TRANS, N, KL, KU, NRHS, IMAT
886 *
887  9993 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
888  $ i2, / ' ==> FACT=''', a1, ''', TRANS=''', a1, ''', N=', i5,
889  $ ', KL=', i5, ', KU=', i5, ', NRHS=', i4, ', type ', i1 )
890 *
891 * SUBNAM, INFO, INFOE, FACT, TRANS, N, NRHS, IMAT
892 *
893  9992 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
894  $ i2, / ' ==> FACT=''', a1, ''', TRANS=''', a1, ''', N =', i5,
895  $ ', NRHS =', i4, ', type ', i2 )
896 *
897 * SUBNAM, INFO, INFOE, FACT, UPLO, N, KD, NRHS, IMAT
898 *
899  9991 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
900  $ i2, / ' ==> FACT=''', a1, ''', UPLO=''', a1, ''', N=', i5,
901  $ ', KD=', i5, ', NRHS=', i4, ', type ', i2 )
902 *
903 * SUBNAM, INFO, INFOE, FACT, UPLO, N, NRHS, IMAT
904 *
905  9990 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
906  $ i2, / ' ==> FACT=''', a1, ''', UPLO=''', a1, ''', N =', i5,
907  $ ', NRHS =', i4, ', type ', i2 )
908 *
909 * SUBNAM, INFO, INFOE, M, N, KL, KU, NB, IMAT
910 *
911  9989 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
912  $ i2, / ' ==> M = ', i5, ', N =', i5, ', KL =', i5, ', KU =',
913  $ i5, ', NB =', i4, ', type ', i2 )
914 *
915 * SUBNAM, INFO, INFOE, M, N, NB, IMAT
916 *
917  9988 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
918  $ i2, / ' ==> M =', i5, ', N =', i5, ', NB =', i4, ', type ',
919  $ i2 )
920 *
921 * SUBNAM, INFO, INFOE, N, IMAT
922 *
923  9987 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
924  $ i2, ' for N=', i5, ', type ', i2 )
925 *
926 * SUBNAM, INFO, INFOE, N, KL, KU, NRHS, IMAT
927 *
928  9986 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
929  $ i2, / ' ==> N =', i5, ', KL =', i5, ', KU =', i5,
930  $ ', NRHS =', i4, ', type ', i2 )
931 *
932 * SUBNAM, INFO, INFOE, N, NB, IMAT
933 *
934  9985 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
935  $ i2, / ' ==> N =', i5, ', NB =', i4, ', type ', i2 )
936 *
937 * SUBNAM, INFO, INFOE, N, NRHS, IMAT
938 *
939  9984 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
940  $ i2, / ' ==> N =', i5, ', NRHS =', i4, ', type ', i2 )
941 *
942 * SUBNAM, INFO, INFOE, UPLO, N, IMAT
943 *
944  9983 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
945  $ i2, / ' ==> UPLO = ''', a1, ''', N =', i5, ', type ', i2 )
946 *
947 * SUBNAM, INFO, INFOE, UPLO, N, KD, NB, IMAT
948 *
949  9982 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
950  $ i2, / ' ==> UPLO = ''', a1, ''', N =', i5, ', KD =', i5,
951  $ ', NB =', i4, ', type ', i2 )
952 *
953 * SUBNAM, INFO, INFOE, UPLO, N, KD, NRHS, IMAT
954 *
955  9981 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
956  $ i2, / ' ==> UPLO=''', a1, ''', N =', i5, ', KD =', i5,
957  $ ', NRHS =', i4, ', type ', i2 )
958 *
959 * SUBNAM, INFO, INFOE, UPLO, N, NB, IMAT
960 *
961  9980 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
962  $ i2, / ' ==> UPLO = ''', a1, ''', N =', i5, ', NB =', i4,
963  $ ', type ', i2 )
964 *
965 * SUBNAM, INFO, INFOE, UPLO, N, NRHS, IMAT
966 *
967  9979 format( ' *** ', a, ' returned with INFO =', i5, ' instead of ',
968  $ i2, / ' ==> UPLO = ''', a1, ''', N =', i5, ', NRHS =', i4,
969  $ ', type ', i2 )
970 *
971 * SUBNAM, INFO, M, N, IMAT
972 *
973  9978 format( ' *** Error code from ', a, ' =', i5, ' for M =', i5,
974  $ ', N =', i5, ', type ', i2 )
975 *
976 * SUBNAM, INFO, M, N, KL, KU, IMAT
977 *
978  9977 format( ' *** Error code from ', a, ' =', i5, / ' ==> M = ', i5,
979  $ ', N =', i5, ', KL =', i5, ', KU =', i5, ', type ', i2 )
980 *
981 * SUBNAM, INFO, M, N, KL, KU, NB, IMAT
982 *
983  9976 format( ' *** Error code from ', a, ' =', i5, / ' ==> M = ', i5,
984  $ ', N =', i5, ', KL =', i5, ', KU =', i5, ', NB =', i4,
985  $ ', type ', i2 )
986 *
987 * SUBNAM, INFO, M, N, NB, IMAT
988 *
989  9975 format( ' *** Error code from ', a, '=', i5, ' for M=', i5,
990  $ ', N=', i5, ', NB=', i4, ', type ', i2 )
991 *
992 * SUBNAM, INFO, M, N, NRHS, NB, IMAT
993 *
994  9974 format( ' *** Error code from ', a, '=', i5, / ' ==> M =', i5,
995  $ ', N =', i5, ', NRHS =', i4, ', NB =', i4, ', type ', i2 )
996 *
997 * SUBNAM, INFO, N, IMAT
998 *
999  9973 format( ' *** Error code from ', a, ' =', i5, ' for N =', i5,
1000  $ ', type ', i2 )
1001 *
1002 * SUBNAM, INFO, N, KL, KU, NRHS, IMAT
1003 *
1004  9972 format( ' *** Error code from ', a, ' =', i5, / ' ==> N =', i5,
1005  $ ', KL =', i5, ', KU =', i5, ', NRHS =', i4, ', type ', i2 )
1006 *
1007 * SUBNAM, INFO, N, NB, IMAT
1008 *
1009  9971 format( ' *** Error code from ', a, '=', i5, ' for N=', i5,
1010  $ ', NB=', i4, ', type ', i2 )
1011 *
1012 * SUBNAM, INFO, N, NRHS, IMAT
1013 *
1014  9970 format( ' *** Error code from ', a, ' =', i5, ' for N =', i5,
1015  $ ', NRHS =', i4, ', type ', i2 )
1016 *
1017 * SUBNAM, INFO, NORM, N, IMAT
1018 *
1019  9969 format( ' *** Error code from ', a, ' =', i5, ' for NORM = ''',
1020  $ a1, ''', N =', i5, ', type ', i2 )
1021 *
1022 * SUBNAM, INFO, NORM, N, KL, KU, IMAT
1023 *
1024  9968 format( ' *** Error code from ', a, ' =', i5, / ' ==> NORM =''',
1025  $ a1, ''', N =', i5, ', KL =', i5, ', KU =', i5, ', type ',
1026  $ i2 )
1027 *
1028 * SUBNAM, INFO, NORM, UPLO, DIAG, N, IMAT
1029 *
1030  9967 format( ' *** Error code from ', a, ' =', i5, / ' ==> NORM=''',
1031  $ a1, ''', UPLO =''', a1, ''', DIAG=''', a1, ''', N =', i5,
1032  $ ', type ', i2 )
1033 *
1034 * SUBNAM, INFO, NORM, UPLO, DIAG, N, KD, IMAT
1035 *
1036  9966 format( ' *** Error code from ', a, ' =', i5, / ' ==> NORM=''',
1037  $ a1, ''', UPLO =''', a1, ''', DIAG=''', a1, ''', N=', i5,
1038  $ ', KD=', i5, ', type ', i2 )
1039 *
1040 * SUBNAM, INFO, TRANS, M, N, NRHS, NB, IMAT
1041 *
1042  9965 format( ' *** Error code from ', a, ' =', i5,
1043  $ / ' ==> TRANS = ''', a1, ''', M =', i5, ', N =', i5,
1044  $ ', NRHS =', i4, ', NB =', i4, ', type ', i2 )
1045 *
1046 * SUBNAM, INFO, TRANS, N, KL, KU, NRHS, IMAT
1047 *
1048  9964 format( ' *** Error code from ', a, '=', i5, / ' ==> TRANS=''',
1049  $ a1, ''', N =', i5, ', KL =', i5, ', KU =', i5, ', NRHS =',
1050  $ i4, ', type ', i2 )
1051 *
1052 * SUBNAM, INFO, TRANS, N, NRHS, IMAT
1053 *
1054  9963 format( ' *** Error code from ', a, ' =', i5,
1055  $ / ' ==> TRANS = ''', a1, ''', N =', i5, ', NRHS =', i4,
1056  $ ', type ', i2 )
1057 *
1058 * SUBNAM, INFO, UPLO, DIAG, N, IMAT
1059 *
1060  9962 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO=''',
1061  $ a1, ''', DIAG =''', a1, ''', N =', i5, ', type ', i2 )
1062 *
1063 * SUBNAM, INFO, UPLO, DIAG, N, NB, IMAT
1064 *
1065  9961 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO=''',
1066  $ a1, ''', DIAG =''', a1, ''', N =', i5, ', NB =', i4,
1067  $ ', type ', i2 )
1068 *
1069 * SUBNAM, INFO, UPLO, N, IMAT
1070 *
1071  9960 format( ' *** Error code from ', a, ' =', i5, ' for UPLO = ''',
1072  $ a1, ''', N =', i5, ', type ', i2 )
1073 *
1074 * SUBNAM, INFO, UPLO, N, KD, IMAT
1075 *
1076  9959 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO = ''',
1077  $ a1, ''', N =', i5, ', KD =', i5, ', type ', i2 )
1078 *
1079 * SUBNAM, INFO, UPLO, N, KD, NB, IMAT
1080 *
1081  9958 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO = ''',
1082  $ a1, ''', N =', i5, ', KD =', i5, ', NB =', i4, ', type ',
1083  $ i2 )
1084 *
1085 * SUBNAM, INFO, UPLO, N, KD, NRHS, IMAT
1086 *
1087  9957 format( ' *** Error code from ', a, '=', i5, / ' ==> UPLO = ''',
1088  $ a1, ''', N =', i5, ', KD =', i5, ', NRHS =', i4, ', type ',
1089  $ i2 )
1090 *
1091 * SUBNAM, INFO, UPLO, N, NB, IMAT
1092 *
1093  9956 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO = ''',
1094  $ a1, ''', N =', i5, ', NB =', i4, ', type ', i2 )
1095 *
1096 * SUBNAM, INFO, UPLO, N, NRHS, IMAT
1097 *
1098  9955 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO = ''',
1099  $ a1, ''', N =', i5, ', NRHS =', i4, ', type ', i2 )
1100 *
1101 * SUBNAM, INFO, UPLO, TRANS, DIAG, N, KD, NRHS, IMAT
1102 *
1103  9954 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO=''',
1104  $ a1, ''', TRANS=''', a1, ''', DIAG=''', a1, ''', N=', i5,
1105  $ ', KD=', i5, ', NRHS=', i4, ', type ', i2 )
1106 *
1107 * SUBNAM, INFO, UPLO, TRANS, DIAG, N, NRHS, IMAT
1108 *
1109  9953 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO=''',
1110  $ a1, ''', TRANS=''', a1, ''', DIAG=''', a1, ''', N =', i5,
1111  $ ', NRHS =', i4, ', type ', i2 )
1112 *
1113 * SUBNAM, INFO, UPLO, TRANS, DIAG, NORMIN, N, IMAT
1114 *
1115  9952 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO=''',
1116  $ a1, ''', TRANS=''', a1, ''', DIAG=''', a1, ''', NORMIN=''',
1117  $ a1, ''', N =', i5, ', type ', i2 )
1118 *
1119 * SUBNAM, INFO, UPLO, TRANS, DIAG, NORMIN, N, KD, IMAT
1120 *
1121  9951 format( ' *** Error code from ', a, ' =', i5, / ' ==> UPLO=''',
1122  $ a1, ''', TRANS=''', a1, ''', DIAG=''', a1, ''', NORMIN=''',
1123  $ a1, ''', N=', i5, ', KD=', i5, ', type ', i2 )
1124 *
1125 * Unknown type
1126 *
1127  9950 format( ' *** Error code from ', a, ' =', i5 )
1128 *
1129 * What we do next
1130 *
1131  9949 format( ' ==> Doing only the condition estimate for this case' )
1132 *
1133  return
1134 *
1135 * End of ALAERH
1136 *
1137  END