OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
aux
LAPACK Testing » Linear Solve

Functions

subroutine aladhd (iounit, path)
 ALADHD
subroutine alaerh (path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
 ALAERH
subroutine alaesm (path, ok, nout)
 ALAESM
subroutine alahd (iounit, path)
 ALAHD
subroutine alareq (path, nmats, dotype, ntypes, nin, nout)
 ALAREQ
subroutine alasum (type, nout, nfail, nrun, nerrs)
 ALASUM
subroutine alasvm (type, nout, nfail, nrun, nerrs)
 ALASVM
subroutine icopy (n, sx, incx, sy, incy)
 ICOPY
integer function ilaenv (ispec, name, opts, n1, n2, n3, n4)
 ILAENV
subroutine xlaenv (ispec, nvalue)
 XLAENV

Detailed Description

This is the group of auxiliary LAPACK TESTING LIN routines.

Function Documentation

◆ aladhd()

subroutine aladhd ( integer iounit,
character*3 path )

ALADHD

Purpose:
!>
!> ALADHD prints header information for the driver routines test paths.
!>
Parameters
[in]IOUNIT
!>          IOUNIT is INTEGER
!>          The unit number to which the header information should be
!>          printed.
!>
[in]PATH
!>          PATH is CHARACTER*3
!>          The name of the path for which the header information is to
!>          be printed.  Current paths are
!>             _GE:  General matrices
!>             _GB:  General band
!>             _GT:  General Tridiagonal
!>             _PO:  Symmetric or Hermitian positive definite
!>             _PS:  Symmetric or Hermitian positive semi-definite
!>             _PP:  Symmetric or Hermitian positive definite packed
!>             _PB:  Symmetric or Hermitian positive definite band
!>             _PT:  Symmetric or Hermitian positive definite tridiagonal
!>             _SY:  Symmetric indefinite,
!>                     with partial (Bunch-Kaufman) pivoting
!>             _SR:  Symmetric indefinite,
!>                     with rook (bounded Bunch-Kaufman) pivoting
!>             _SK:  Symmetric indefinite,
!>                     with rook (bounded Bunch-Kaufman) pivoting
!>                     ( new storage format for factors:
!>                       L and diagonal of D is stored in A,
!>                       subdiagonal of D is stored in E )
!>             _SP:  Symmetric indefinite packed,
!>                     with partial (Bunch-Kaufman) pivoting
!>             _HA:  (complex) Hermitian ,
!>                     Assen Algorithm
!>             _HE:  (complex) Hermitian indefinite,
!>                     with partial (Bunch-Kaufman) pivoting
!>             _HR:  (complex) Hermitian indefinite,
!>                     with rook (bounded Bunch-Kaufman) pivoting
!>             _HK:  (complex) Hermitian indefinite,
!>                     with rook (bounded Bunch-Kaufman) pivoting
!>                     ( new storage format for factors:
!>                       L and diagonal of D is stored in A,
!>                       subdiagonal of D is stored in E )
!>             _HP:  (complex) Hermitian indefinite packed,
!>                     with partial (Bunch-Kaufman) pivoting
!>          The first character must be one of S, D, C, or Z (C or Z only
!>          if complex).
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 89 of file aladhd.f.

90*
91* -- LAPACK test routine --
92* -- LAPACK is a software package provided by Univ. of Tennessee, --
93* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
94*
95* .. Scalar Arguments ..
96 CHARACTER*3 PATH
97 INTEGER IOUNIT
98* ..
99*
100* =====================================================================
101*
102* .. Local Scalars ..
103 LOGICAL CORZ, SORD
104 CHARACTER C1, C3
105 CHARACTER*2 P2
106 CHARACTER*9 SYM
107* ..
108* .. External Functions ..
109 LOGICAL LSAME, LSAMEN
110 EXTERNAL lsame, lsamen
111* ..
112* .. Executable Statements ..
113*
114 IF( iounit.LE.0 )
115 $ RETURN
116 c1 = path( 1: 1 )
117 c3 = path( 3: 3 )
118 p2 = path( 2: 3 )
119 sord = lsame( c1, 'S' ) .OR. lsame( c1, 'D' )
120 corz = lsame( c1, 'C' ) .OR. lsame( c1, 'Z' )
121 IF( .NOT.( sord .OR. corz ) )
122 $ RETURN
123*
124 IF( lsamen( 2, p2, 'GE' ) ) THEN
125*
126* GE: General dense
127*
128 WRITE( iounit, fmt = 9999 )path
129 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
130 WRITE( iounit, fmt = 9989 )
131 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
132 WRITE( iounit, fmt = 9981 )1
133 WRITE( iounit, fmt = 9980 )2
134 WRITE( iounit, fmt = 9979 )3
135 WRITE( iounit, fmt = 9978 )4
136 WRITE( iounit, fmt = 9977 )5
137 WRITE( iounit, fmt = 9976 )6
138 WRITE( iounit, fmt = 9972 )7
139 WRITE( iounit, fmt = '( '' Messages:'' )' )
140*
141 ELSE IF( lsamen( 2, p2, 'GB' ) ) THEN
142*
143* GB: General band
144*
145 WRITE( iounit, fmt = 9998 )path
146 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
147 WRITE( iounit, fmt = 9988 )
148 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
149 WRITE( iounit, fmt = 9981 )1
150 WRITE( iounit, fmt = 9980 )2
151 WRITE( iounit, fmt = 9979 )3
152 WRITE( iounit, fmt = 9978 )4
153 WRITE( iounit, fmt = 9977 )5
154 WRITE( iounit, fmt = 9976 )6
155 WRITE( iounit, fmt = 9972 )7
156 WRITE( iounit, fmt = '( '' Messages:'' )' )
157*
158 ELSE IF( lsamen( 2, p2, 'GT' ) ) THEN
159*
160* GT: General tridiagonal
161*
162 WRITE( iounit, fmt = 9997 )path
163 WRITE( iounit, fmt = 9987 )
164 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
165 WRITE( iounit, fmt = 9981 )1
166 WRITE( iounit, fmt = 9980 )2
167 WRITE( iounit, fmt = 9979 )3
168 WRITE( iounit, fmt = 9978 )4
169 WRITE( iounit, fmt = 9977 )5
170 WRITE( iounit, fmt = 9976 )6
171 WRITE( iounit, fmt = '( '' Messages:'' )' )
172*
173 ELSE IF( lsamen( 2, p2, 'PO' ) .OR. lsamen( 2, p2, 'PP' )
174 $ .OR. lsamen( 2, p2, 'PS' ) ) THEN
175*
176* PO: Positive definite full
177* PS: Positive definite full
178* PP: Positive definite packed
179*
180 IF( sord ) THEN
181 sym = 'Symmetric'
182 ELSE
183 sym = 'Hermitian'
184 END IF
185 IF( lsame( c3, 'O' ) ) THEN
186 WRITE( iounit, fmt = 9996 )path, sym
187 ELSE
188 WRITE( iounit, fmt = 9995 )path, sym
189 END IF
190 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
191 WRITE( iounit, fmt = 9985 )path
192 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
193 WRITE( iounit, fmt = 9975 )1
194 WRITE( iounit, fmt = 9980 )2
195 WRITE( iounit, fmt = 9979 )3
196 WRITE( iounit, fmt = 9978 )4
197 WRITE( iounit, fmt = 9977 )5
198 WRITE( iounit, fmt = 9976 )6
199 WRITE( iounit, fmt = '( '' Messages:'' )' )
200*
201 ELSE IF( lsamen( 2, p2, 'PB' ) ) THEN
202*
203* PB: Positive definite band
204*
205 IF( sord ) THEN
206 WRITE( iounit, fmt = 9994 )path, 'Symmetric'
207 ELSE
208 WRITE( iounit, fmt = 9994 )path, 'Hermitian'
209 END IF
210 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
211 WRITE( iounit, fmt = 9984 )path
212 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
213 WRITE( iounit, fmt = 9975 )1
214 WRITE( iounit, fmt = 9980 )2
215 WRITE( iounit, fmt = 9979 )3
216 WRITE( iounit, fmt = 9978 )4
217 WRITE( iounit, fmt = 9977 )5
218 WRITE( iounit, fmt = 9976 )6
219 WRITE( iounit, fmt = '( '' Messages:'' )' )
220*
221 ELSE IF( lsamen( 2, p2, 'PT' ) ) THEN
222*
223* PT: Positive definite tridiagonal
224*
225 IF( sord ) THEN
226 WRITE( iounit, fmt = 9993 )path, 'Symmetric'
227 ELSE
228 WRITE( iounit, fmt = 9993 )path, 'Hermitian'
229 END IF
230 WRITE( iounit, fmt = 9986 )
231 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
232 WRITE( iounit, fmt = 9973 )1
233 WRITE( iounit, fmt = 9980 )2
234 WRITE( iounit, fmt = 9979 )3
235 WRITE( iounit, fmt = 9978 )4
236 WRITE( iounit, fmt = 9977 )5
237 WRITE( iounit, fmt = 9976 )6
238 WRITE( iounit, fmt = '( '' Messages:'' )' )
239*
240 ELSE IF( lsamen( 2, p2, 'SY' ) .OR. lsamen( 2, p2, 'SP' ) ) THEN
241*
242* SY: Symmetric indefinite full
243* with partial (Bunch-Kaufman) pivoting algorithm
244* SP: Symmetric indefinite packed
245* with partial (Bunch-Kaufman) pivoting algorithm
246*
247 IF( lsame( c3, 'Y' ) ) THEN
248 WRITE( iounit, fmt = 9992 )path, 'Symmetric'
249 ELSE
250 WRITE( iounit, fmt = 9991 )path, 'Symmetric'
251 END IF
252 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
253 IF( sord ) THEN
254 WRITE( iounit, fmt = 9983 )
255 ELSE
256 WRITE( iounit, fmt = 9982 )
257 END IF
258 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
259 WRITE( iounit, fmt = 9974 )1
260 WRITE( iounit, fmt = 9980 )2
261 WRITE( iounit, fmt = 9979 )3
262 WRITE( iounit, fmt = 9977 )4
263 WRITE( iounit, fmt = 9978 )5
264 WRITE( iounit, fmt = 9976 )6
265 WRITE( iounit, fmt = '( '' Messages:'' )' )
266*
267 ELSE IF( lsamen( 2, p2, 'SR' ) .OR. lsamen( 2, p2, 'SK') ) THEN
268*
269* SR: Symmetric indefinite full,
270* with rook (bounded Bunch-Kaufman) pivoting algorithm
271*
272* SK: Symmetric indefinite full,
273* with rook (bounded Bunch-Kaufman) pivoting algorithm,
274* ( new storage format for factors:
275* L and diagonal of D is stored in A,
276* subdiagonal of D is stored in E )
277*
278 WRITE( iounit, fmt = 9992 )path, 'Symmetric'
279*
280 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
281 IF( sord ) THEN
282 WRITE( iounit, fmt = 9983 )
283 ELSE
284 WRITE( iounit, fmt = 9982 )
285 END IF
286*
287 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
288 WRITE( iounit, fmt = 9974 )1
289 WRITE( iounit, fmt = 9980 )2
290 WRITE( iounit, fmt = 9979 )3
291 WRITE( iounit, fmt = '( '' Messages:'' )' )
292*
293 ELSE IF( lsamen( 2, p2, 'HA' ) ) THEN
294*
295* HA: Hermitian
296* Aasen algorithm
297 WRITE( iounit, fmt = 9971 )path, 'Hermitian'
298*
299 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
300 WRITE( iounit, fmt = 9983 )
301*
302 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
303 WRITE( iounit, fmt = 9974 )1
304 WRITE( iounit, fmt = 9980 )2
305 WRITE( iounit, fmt = 9979 )3
306 WRITE( iounit, fmt = 9977 )4
307 WRITE( iounit, fmt = 9978 )5
308 WRITE( iounit, fmt = 9976 )6
309 WRITE( iounit, fmt = '( '' Messages:'' )' )
310
311
312 ELSE IF( lsamen( 2, p2, 'HE' ) .OR.
313 $ lsamen( 2, p2, 'HP' ) ) THEN
314*
315* HE: Hermitian indefinite full
316* with partial (Bunch-Kaufman) pivoting algorithm
317* HP: Hermitian indefinite packed
318* with partial (Bunch-Kaufman) pivoting algorithm
319*
320 IF( lsame( c3, 'E' ) ) THEN
321 WRITE( iounit, fmt = 9992 )path, 'Hermitian'
322 ELSE
323 WRITE( iounit, fmt = 9991 )path, 'Hermitian'
324 END IF
325*
326 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
327 WRITE( iounit, fmt = 9983 )
328*
329 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
330 WRITE( iounit, fmt = 9974 )1
331 WRITE( iounit, fmt = 9980 )2
332 WRITE( iounit, fmt = 9979 )3
333 WRITE( iounit, fmt = 9977 )4
334 WRITE( iounit, fmt = 9978 )5
335 WRITE( iounit, fmt = 9976 )6
336 WRITE( iounit, fmt = '( '' Messages:'' )' )
337*
338 ELSE IF( lsamen( 2, p2, 'HR' ) .OR. lsamen( 2, p2, 'HK' ) ) THEN
339*
340* HR: Hermitian indefinite full,
341* with rook (bounded Bunch-Kaufman) pivoting algorithm
342*
343* HK: Hermitian indefinite full,
344* with rook (bounded Bunch-Kaufman) pivoting algorithm,
345* ( new storage format for factors:
346* L and diagonal of D is stored in A,
347* subdiagonal of D is stored in E )
348*
349 WRITE( iounit, fmt = 9992 )path, 'Hermitian'
350*
351 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
352 WRITE( iounit, fmt = 9983 )
353*
354 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
355 WRITE( iounit, fmt = 9974 )1
356 WRITE( iounit, fmt = 9980 )2
357 WRITE( iounit, fmt = 9979 )3
358 WRITE( iounit, fmt = '( '' Messages:'' )' )
359*
360 ELSE
361*
362* Print error message if no header is available.
363*
364 WRITE( iounit, fmt = 9990 )path
365 END IF
366*
367* First line of header
368*
369 9999 FORMAT( / 1x, a3, ' drivers: General dense matrices' )
370 9998 FORMAT( / 1x, a3, ' drivers: General band matrices' )
371 9997 FORMAT( / 1x, a3, ' drivers: General tridiagonal' )
372 9996 FORMAT( / 1x, a3, ' drivers: ', a9,
373 $ ' positive definite matrices' )
374 9995 FORMAT( / 1x, a3, ' drivers: ', a9,
375 $ ' positive definite packed matrices' )
376 9994 FORMAT( / 1x, a3, ' drivers: ', a9,
377 $ ' positive definite band matrices' )
378 9993 FORMAT( / 1x, a3, ' drivers: ', a9,
379 $ ' positive definite tridiagonal' )
380 9971 FORMAT( / 1x, a3, ' drivers: ', a9, ' indefinite matrices',
381 $ ', "Aasen" Algorithm' )
382 9992 FORMAT( / 1x, a3, ' drivers: ', a9, ' indefinite matrices',
383 $ ', "rook" (bounded Bunch-Kaufman) pivoting' )
384 9991 FORMAT( / 1x, a3, ' drivers: ', a9,
385 $ ' indefinite packed matrices',
386 $ ', partial (Bunch-Kaufman) pivoting' )
387 9891 FORMAT( / 1x, a3, ' drivers: ', a9,
388 $ ' indefinite packed matrices',
389 $ ', "rook" (bounded Bunch-Kaufman) pivoting' )
390 9990 FORMAT( / 1x, a3, ': No header available' )
391*
392* GE matrix types
393*
394 9989 FORMAT( 4x, '1. Diagonal', 24x, '7. Last n/2 columns zero', / 4x,
395 $ '2. Upper triangular', 16x,
396 $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
397 $ '3. Lower triangular', 16x, '9. Random, CNDNUM = 0.1/EPS',
398 $ / 4x, '4. Random, CNDNUM = 2', 13x,
399 $ '10. Scaled near underflow', / 4x, '5. First column zero',
400 $ 14x, '11. Scaled near overflow', / 4x,
401 $ '6. Last column zero' )
402*
403* GB matrix types
404*
405 9988 FORMAT( 4x, '1. Random, CNDNUM = 2', 14x,
406 $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
407 $ '2. First column zero', 15x, '6. Random, CNDNUM = 0.1/EPS',
408 $ / 4x, '3. Last column zero', 16x,
409 $ '7. Scaled near underflow', / 4x,
410 $ '4. Last n/2 columns zero', 11x, '8. Scaled near overflow' )
411*
412* GT matrix types
413*
414 9987 FORMAT( ' Matrix types (1-6 have specified condition numbers):',
415 $ / 4x, '1. Diagonal', 24x, '7. Random, unspecified CNDNUM',
416 $ / 4x, '2. Random, CNDNUM = 2', 14x, '8. First column zero',
417 $ / 4x, '3. Random, CNDNUM = sqrt(0.1/EPS)', 2x,
418 $ '9. Last column zero', / 4x, '4. Random, CNDNUM = 0.1/EPS',
419 $ 7x, '10. Last n/2 columns zero', / 4x,
420 $ '5. Scaled near underflow', 10x,
421 $ '11. Scaled near underflow', / 4x,
422 $ '6. Scaled near overflow', 11x, '12. Scaled near overflow' )
423*
424* PT matrix types
425*
426 9986 FORMAT( ' Matrix types (1-6 have specified condition numbers):',
427 $ / 4x, '1. Diagonal', 24x, '7. Random, unspecified CNDNUM',
428 $ / 4x, '2. Random, CNDNUM = 2', 14x,
429 $ '8. First row and column zero', / 4x,
430 $ '3. Random, CNDNUM = sqrt(0.1/EPS)', 2x,
431 $ '9. Last row and column zero', / 4x,
432 $ '4. Random, CNDNUM = 0.1/EPS', 7x,
433 $ '10. Middle row and column zero', / 4x,
434 $ '5. Scaled near underflow', 10x,
435 $ '11. Scaled near underflow', / 4x,
436 $ '6. Scaled near overflow', 11x, '12. Scaled near overflow' )
437*
438* PO, PP matrix types
439*
440 9985 FORMAT( 4x, '1. Diagonal', 24x,
441 $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
442 $ '2. Random, CNDNUM = 2', 14x, '7. Random, CNDNUM = 0.1/EPS',
443 $ / 3x, '*3. First row and column zero', 7x,
444 $ '8. Scaled near underflow', / 3x,
445 $ '*4. Last row and column zero', 8x,
446 $ '9. Scaled near overflow', / 3x,
447 $ '*5. Middle row and column zero', / 3x,
448 $ '(* - tests error exits from ', a3,
449 $ 'TRF, no test ratios are computed)' )
450*
451* PB matrix types
452*
453 9984 FORMAT( 4x, '1. Random, CNDNUM = 2', 14x,
454 $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 3x,
455 $ '*2. First row and column zero', 7x,
456 $ '6. Random, CNDNUM = 0.1/EPS', / 3x,
457 $ '*3. Last row and column zero', 8x,
458 $ '7. Scaled near underflow', / 3x,
459 $ '*4. Middle row and column zero', 6x,
460 $ '8. Scaled near overflow', / 3x,
461 $ '(* - tests error exits from ', a3,
462 $ 'TRF, no test ratios are computed)' )
463*
464* SSY, SSP, CHE, CHP matrix types
465*
466 9983 FORMAT( 4x, '1. Diagonal', 24x,
467 $ '6. Last n/2 rows and columns zero', / 4x,
468 $ '2. Random, CNDNUM = 2', 14x,
469 $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
470 $ '3. First row and column zero', 7x,
471 $ '8. Random, CNDNUM = 0.1/EPS', / 4x,
472 $ '4. Last row and column zero', 8x,
473 $ '9. Scaled near underflow', / 4x,
474 $ '5. Middle row and column zero', 5x,
475 $ '10. Scaled near overflow' )
476*
477* CSY, CSP matrix types
478*
479 9982 FORMAT( 4x, '1. Diagonal', 24x,
480 $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
481 $ '2. Random, CNDNUM = 2', 14x, '8. Random, CNDNUM = 0.1/EPS',
482 $ / 4x, '3. First row and column zero', 7x,
483 $ '9. Scaled near underflow', / 4x,
484 $ '4. Last row and column zero', 7x,
485 $ '10. Scaled near overflow', / 4x,
486 $ '5. Middle row and column zero', 5x,
487 $ '11. Block diagonal matrix', / 4x,
488 $ '6. Last n/2 rows and columns zero' )
489*
490* Test ratios
491*
492 9981 FORMAT( 3x, i2, ': norm( L * U - A ) / ( N * norm(A) * EPS )' )
493 9980 FORMAT( 3x, i2, ': norm( B - A * X ) / ',
494 $ '( norm(A) * norm(X) * EPS )' )
495 9979 FORMAT( 3x, i2, ': norm( X - XACT ) / ',
496 $ '( norm(XACT) * CNDNUM * EPS )' )
497 9978 FORMAT( 3x, i2, ': norm( X - XACT ) / ',
498 $ '( norm(XACT) * (error bound) )' )
499 9977 FORMAT( 3x, i2, ': (backward error) / EPS' )
500 9976 FORMAT( 3x, i2, ': RCOND * CNDNUM - 1.0' )
501 9975 FORMAT( 3x, i2, ': norm( U'' * U - A ) / ( N * norm(A) * EPS )',
502 $ ', or', / 7x, 'norm( L * L'' - A ) / ( N * norm(A) * EPS )'
503 $ )
504 9974 FORMAT( 3x, i2, ': norm( U*D*U'' - A ) / ( N * norm(A) * EPS )',
505 $ ', or', / 7x, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
506 $ )
507 9973 FORMAT( 3x, i2, ': norm( U''*D*U - A ) / ( N * norm(A) * EPS )',
508 $ ', or', / 7x, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
509 $ )
510 9972 FORMAT( 3x, i2, ': abs( WORK(1) - RPVGRW ) /',
511 $ ' ( max( WORK(1), RPVGRW ) * EPS )' )
512*
513 RETURN
514*
515* End of ALADHD
516*
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53

◆ alaerh()

subroutine alaerh ( character*3 path,
character*( * ) subnam,
integer info,
integer infoe,
character*( * ) opts,
integer m,
integer n,
integer kl,
integer ku,
integer n5,
integer imat,
integer nfail,
integer nerrs,
integer nout )

ALAERH

Purpose:
!>
!> ALAERH is an error handler for the LAPACK routines.  It prints the
!> header if this is the first error message and prints the error code
!> and form of recovery, if any.  The character evaluations in this
!> routine may make it slow, but it should not be called once the LAPACK
!> routines are fully debugged.
!>
Parameters
[in]PATH
!>          PATH is CHARACTER*3
!>          The LAPACK path name of subroutine SUBNAM.
!>
[in]SUBNAM
!>          SUBNAM is CHARACTER*(*)
!>          The name of the subroutine that returned an error code.
!>
[in]INFO
!>          INFO is INTEGER
!>          The error code returned from routine SUBNAM.
!>
[in]INFOE
!>          INFOE is INTEGER
!>          The expected error code from routine SUBNAM, if SUBNAM were
!>          error-free.  If INFOE = 0, an error message is printed, but
!>          if INFOE.NE.0, we assume only the return code INFO is wrong.
!>
[in]OPTS
!>          OPTS is CHARACTER*(*)
!>          The character options to the subroutine SUBNAM, concatenated
!>          into a single character string.  For example, UPLO = 'U',
!>          TRANS = 'T', and DIAG = 'N' for a triangular routine would
!>          be specified as OPTS = 'UTN'.
!>
[in]M
!>          M is INTEGER
!>          The matrix row dimension.
!>
[in]N
!>          N is INTEGER
!>          The matrix column dimension.  Accessed only if PATH = xGE or
!>          xGB.
!>
[in]KL
!>          KL is INTEGER
!>          The number of sub-diagonals of the matrix.  Accessed only if
!>          PATH = xGB, xPB, or xTB.  Also used for NRHS for PATH = xLS.
!>
[in]KU
!>          KU is INTEGER
!>          The number of super-diagonals of the matrix.  Accessed only
!>          if PATH = xGB.
!>
[in]N5
!>          N5 is INTEGER
!>          A fifth integer parameter, may be the blocksize NB or the
!>          number of right hand sides NRHS.
!>
[in]IMAT
!>          IMAT is INTEGER
!>          The matrix type.
!>
[in]NFAIL
!>          NFAIL is INTEGER
!>          The number of prior tests that did not pass the threshold;
!>          used to determine if the header should be printed.
!>
[in,out]NERRS
!>          NERRS is INTEGER
!>          On entry, the number of errors already detected; used to
!>          determine if the header should be printed.
!>          On exit, NERRS is increased by 1.
!>
[in]NOUT
!>          NOUT is INTEGER
!>          The unit number on which results are to be printed.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 145 of file alaerh.f.

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

◆ alaesm()

subroutine alaesm ( character*3 path,
logical ok,
integer nout )

ALAESM

Purpose:
!>
!> ALAESM prints a summary of results from one of the -ERR- routines.
!>
Parameters
[in]PATH
!>          PATH is CHARACTER*3
!>          The LAPACK path name.
!>
[in]OK
!>          OK is LOGICAL
!>          The flag from CHKXER that indicates whether or not the tests
!>          of error exits passed.
!>
[in]NOUT
!>          NOUT is INTEGER
!>          The unit number on which results are to be printed.
!>          NOUT >= 0.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 62 of file alaesm.f.

63*
64* -- LAPACK test routine --
65* -- LAPACK is a software package provided by Univ. of Tennessee, --
66* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
67*
68* .. Scalar Arguments ..
69 LOGICAL OK
70 CHARACTER*3 PATH
71 INTEGER NOUT
72* ..
73*
74* =====================================================================
75*
76* .. Executable Statements ..
77*
78 IF( ok ) THEN
79 WRITE( nout, fmt = 9999 )path
80 ELSE
81 WRITE( nout, fmt = 9998 )path
82 END IF
83*
84 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits'
85 $ )
86 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
87 $ 'exits ***' )
88 RETURN
89*
90* End of ALAESM
91*

◆ alahd()

subroutine alahd ( integer iounit,
character*3 path )

ALAHD

Purpose:
!>
!> ALAHD prints header information for the different test paths.
!>
Parameters
[in]IOUNIT
!>          IOUNIT is INTEGER
!>          The unit number to which the header information should be
!>          printed.
!>
[in]PATH
!>          PATH is CHARACTER*3
!>          The name of the path for which the header information is to
!>          be printed.  Current paths are
!>             _GE:  General matrices
!>             _GB:  General band
!>             _GT:  General Tridiagonal
!>             _PO:  Symmetric or Hermitian positive definite
!>             _PS:  Symmetric or Hermitian positive semi-definite
!>             _PP:  Symmetric or Hermitian positive definite packed
!>             _PB:  Symmetric or Hermitian positive definite band
!>             _PT:  Symmetric or Hermitian positive definite tridiagonal
!>             _SY:  Symmetric indefinite,
!>                     with partial (Bunch-Kaufman) pivoting
!>             _SR:  Symmetric indefinite,
!>                     with rook (bounded Bunch-Kaufman) pivoting
!>             _SK:  Symmetric indefinite,
!>                     with rook (bounded Bunch-Kaufman) pivoting
!>                     ( new storage format for factors:
!>                       L and diagonal of D is stored in A,
!>                       subdiagonal of D is stored in E )
!>             _SP:  Symmetric indefinite packed,
!>                     with partial (Bunch-Kaufman) pivoting
!>             _HA:  (complex) Hermitian ,
!>                     with Aasen Algorithm
!>             _HE:  (complex) Hermitian indefinite,
!>                     with partial (Bunch-Kaufman) pivoting
!>             _HR:  (complex) Hermitian indefinite,
!>                     with rook (bounded Bunch-Kaufman) pivoting
!>             _HK:  (complex) Hermitian indefinite,
!>                     with rook (bounded Bunch-Kaufman) pivoting
!>                     ( new storage format for factors:
!>                       L and diagonal of D is stored in A,
!>                       subdiagonal of D is stored in E )
!>             _HP:  (complex) Hermitian indefinite packed,
!>                     with partial (Bunch-Kaufman) pivoting
!>             _TR:  Triangular
!>             _TP:  Triangular packed
!>             _TB:  Triangular band
!>             _QR:  QR (general matrices)
!>             _LQ:  LQ (general matrices)
!>             _QL:  QL (general matrices)
!>             _RQ:  RQ (general matrices)
!>             _QP:  QR with column pivoting
!>             _TZ:  Trapezoidal
!>             _LS:  Least Squares driver routines
!>             _LU:  LU variants
!>             _CH:  Cholesky variants
!>             _QS:  QR variants
!>             _QT:  QRT (general matrices)
!>             _QX:  QRT (triangular-pentagonal matrices)
!>             _TS:  QR routines for tall-skinny and short-wide matrices
!>             _HH:  Householder reconstruction for tall-skinny matrices
!>          The first character must be one of S, D, C, or Z (C or Z only
!>          if complex).
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 106 of file alahd.f.

107*
108* -- LAPACK test routine --
109* -- LAPACK is a software package provided by Univ. of Tennessee, --
110* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
111*
112* .. Scalar Arguments ..
113 CHARACTER*3 PATH
114 INTEGER IOUNIT
115* ..
116*
117* =====================================================================
118*
119* .. Local Scalars ..
120 LOGICAL CORZ, SORD
121 CHARACTER C1, C3
122 CHARACTER*2 P2
123 CHARACTER*4 EIGCNM
124 CHARACTER*32 SUBNAM
125 CHARACTER*9 SYM
126* ..
127* .. External Functions ..
128 LOGICAL LSAME, LSAMEN
129 EXTERNAL lsame, lsamen
130* ..
131* .. Intrinsic Functions ..
132 INTRINSIC len_trim
133* ..
134* .. Executable Statements ..
135*
136 IF( iounit.LE.0 )
137 $ RETURN
138 c1 = path( 1: 1 )
139 c3 = path( 3: 3 )
140 p2 = path( 2: 3 )
141 sord = lsame( c1, 'S' ) .OR. lsame( c1, 'D' )
142 corz = lsame( c1, 'C' ) .OR. lsame( c1, 'Z' )
143 IF( .NOT.( sord .OR. corz ) )
144 $ RETURN
145*
146 IF( lsamen( 2, p2, 'GE' ) ) THEN
147*
148* GE: General dense
149*
150 WRITE( iounit, fmt = 9999 )path
151 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
152 WRITE( iounit, fmt = 9979 )
153 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
154 WRITE( iounit, fmt = 9962 )1
155 WRITE( iounit, fmt = 9961 )2
156 WRITE( iounit, fmt = 9960 )3
157 WRITE( iounit, fmt = 9959 )4
158 WRITE( iounit, fmt = 9958 )5
159 WRITE( iounit, fmt = 9957 )6
160 WRITE( iounit, fmt = 9956 )7
161 WRITE( iounit, fmt = 9955 )8
162 WRITE( iounit, fmt = '( '' Messages:'' )' )
163*
164 ELSE IF( lsamen( 2, p2, 'GB' ) ) THEN
165*
166* GB: General band
167*
168 WRITE( iounit, fmt = 9998 )path
169 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
170 WRITE( iounit, fmt = 9978 )
171 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
172 WRITE( iounit, fmt = 9962 )1
173 WRITE( iounit, fmt = 9960 )2
174 WRITE( iounit, fmt = 9959 )3
175 WRITE( iounit, fmt = 9958 )4
176 WRITE( iounit, fmt = 9957 )5
177 WRITE( iounit, fmt = 9956 )6
178 WRITE( iounit, fmt = 9955 )7
179 WRITE( iounit, fmt = '( '' Messages:'' )' )
180*
181 ELSE IF( lsamen( 2, p2, 'GT' ) ) THEN
182*
183* GT: General tridiagonal
184*
185 WRITE( iounit, fmt = 9997 )path
186 WRITE( iounit, fmt = 9977 )
187 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
188 WRITE( iounit, fmt = 9962 )1
189 WRITE( iounit, fmt = 9960 )2
190 WRITE( iounit, fmt = 9959 )3
191 WRITE( iounit, fmt = 9958 )4
192 WRITE( iounit, fmt = 9957 )5
193 WRITE( iounit, fmt = 9956 )6
194 WRITE( iounit, fmt = 9955 )7
195 WRITE( iounit, fmt = '( '' Messages:'' )' )
196*
197 ELSE IF( lsamen( 2, p2, 'PO' ) .OR. lsamen( 2, p2, 'PP' ) ) THEN
198*
199* PO: Positive definite full
200* PP: Positive definite packed
201*
202 IF( sord ) THEN
203 sym = 'Symmetric'
204 ELSE
205 sym = 'Hermitian'
206 END IF
207 IF( lsame( c3, 'O' ) ) THEN
208 WRITE( iounit, fmt = 9996 )path, sym
209 ELSE
210 WRITE( iounit, fmt = 9995 )path, sym
211 END IF
212 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
213 WRITE( iounit, fmt = 9975 )path
214 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
215 WRITE( iounit, fmt = 9954 )1
216 WRITE( iounit, fmt = 9961 )2
217 WRITE( iounit, fmt = 9960 )3
218 WRITE( iounit, fmt = 9959 )4
219 WRITE( iounit, fmt = 9958 )5
220 WRITE( iounit, fmt = 9957 )6
221 WRITE( iounit, fmt = 9956 )7
222 WRITE( iounit, fmt = 9955 )8
223 WRITE( iounit, fmt = '( '' Messages:'' )' )
224*
225 ELSE IF( lsamen( 2, p2, 'PS' ) ) THEN
226*
227* PS: Positive semi-definite full
228*
229 IF( sord ) THEN
230 sym = 'Symmetric'
231 ELSE
232 sym = 'Hermitian'
233 END IF
234 IF( lsame( c1, 'S' ) .OR. lsame( c1, 'C' ) ) THEN
235 eigcnm = '1E04'
236 ELSE
237 eigcnm = '1D12'
238 END IF
239 WRITE( iounit, fmt = 9995 )path, sym
240 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
241 WRITE( iounit, fmt = 8973 )eigcnm, eigcnm, eigcnm
242 WRITE( iounit, fmt = '( '' Difference:'' )' )
243 WRITE( iounit, fmt = 8972 )c1
244 WRITE( iounit, fmt = '( '' Test ratio:'' )' )
245 WRITE( iounit, fmt = 8950 )
246 WRITE( iounit, fmt = '( '' Messages:'' )' )
247 ELSE IF( lsamen( 2, p2, 'PB' ) ) THEN
248*
249* PB: Positive definite band
250*
251 IF( sord ) THEN
252 WRITE( iounit, fmt = 9994 )path, 'Symmetric'
253 ELSE
254 WRITE( iounit, fmt = 9994 )path, 'Hermitian'
255 END IF
256 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
257 WRITE( iounit, fmt = 9973 )path
258 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
259 WRITE( iounit, fmt = 9954 )1
260 WRITE( iounit, fmt = 9960 )2
261 WRITE( iounit, fmt = 9959 )3
262 WRITE( iounit, fmt = 9958 )4
263 WRITE( iounit, fmt = 9957 )5
264 WRITE( iounit, fmt = 9956 )6
265 WRITE( iounit, fmt = 9955 )7
266 WRITE( iounit, fmt = '( '' Messages:'' )' )
267*
268 ELSE IF( lsamen( 2, p2, 'PT' ) ) THEN
269*
270* PT: Positive definite tridiagonal
271*
272 IF( sord ) THEN
273 WRITE( iounit, fmt = 9993 )path, 'Symmetric'
274 ELSE
275 WRITE( iounit, fmt = 9993 )path, 'Hermitian'
276 END IF
277 WRITE( iounit, fmt = 9976 )
278 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
279 WRITE( iounit, fmt = 9952 )1
280 WRITE( iounit, fmt = 9960 )2
281 WRITE( iounit, fmt = 9959 )3
282 WRITE( iounit, fmt = 9958 )4
283 WRITE( iounit, fmt = 9957 )5
284 WRITE( iounit, fmt = 9956 )6
285 WRITE( iounit, fmt = 9955 )7
286 WRITE( iounit, fmt = '( '' Messages:'' )' )
287*
288 ELSE IF( lsamen( 2, p2, 'SY' ) ) THEN
289*
290* SY: Symmetric indefinite full,
291* with partial (Bunch-Kaufman) pivoting algorithm
292*
293 IF( lsame( c3, 'Y' ) ) THEN
294 WRITE( iounit, fmt = 9992 )path, 'Symmetric'
295 ELSE
296 WRITE( iounit, fmt = 9991 )path, 'Symmetric'
297 END IF
298 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
299 IF( sord ) THEN
300 WRITE( iounit, fmt = 9972 )
301 ELSE
302 WRITE( iounit, fmt = 9971 )
303 END IF
304 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
305 WRITE( iounit, fmt = 9953 )1
306 WRITE( iounit, fmt = 9961 )2
307 WRITE( iounit, fmt = 9960 )3
308 WRITE( iounit, fmt = 9960 )4
309 WRITE( iounit, fmt = 9959 )5
310 WRITE( iounit, fmt = 9958 )6
311 WRITE( iounit, fmt = 9956 )7
312 WRITE( iounit, fmt = 9957 )8
313 WRITE( iounit, fmt = 9955 )9
314 WRITE( iounit, fmt = '( '' Messages:'' )' )
315*
316 ELSE IF( lsamen( 2, p2, 'SR' ) .OR. lsamen( 2, p2, 'SK') ) THEN
317*
318* SR: Symmetric indefinite full,
319* with rook (bounded Bunch-Kaufman) pivoting algorithm
320*
321* SK: Symmetric indefinite full,
322* with rook (bounded Bunch-Kaufman) pivoting algorithm,
323* ( new storage format for factors:
324* L and diagonal of D is stored in A,
325* subdiagonal of D is stored in E )
326*
327 WRITE( iounit, fmt = 9892 )path, 'Symmetric'
328*
329 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
330 IF( sord ) THEN
331 WRITE( iounit, fmt = 9972 )
332 ELSE
333 WRITE( iounit, fmt = 9971 )
334 END IF
335*
336 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
337 WRITE( iounit, fmt = 9953 )1
338 WRITE( iounit, fmt = 9961 )2
339 WRITE( iounit, fmt = 9927 )3
340 WRITE( iounit, fmt = 9928 )
341 WRITE( iounit, fmt = 9926 )4
342 WRITE( iounit, fmt = 9928 )
343 WRITE( iounit, fmt = 9960 )5
344 WRITE( iounit, fmt = 9959 )6
345 WRITE( iounit, fmt = 9955 )7
346 WRITE( iounit, fmt = '( '' Messages:'' )' )
347*
348 ELSE IF( lsamen( 2, p2, 'SP' ) ) THEN
349*
350* SP: Symmetric indefinite packed,
351* with partial (Bunch-Kaufman) pivoting algorithm
352*
353 IF( lsame( c3, 'Y' ) ) THEN
354 WRITE( iounit, fmt = 9992 )path, 'Symmetric'
355 ELSE
356 WRITE( iounit, fmt = 9991 )path, 'Symmetric'
357 END IF
358 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
359 IF( sord ) THEN
360 WRITE( iounit, fmt = 9972 )
361 ELSE
362 WRITE( iounit, fmt = 9971 )
363 END IF
364 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
365 WRITE( iounit, fmt = 9953 )1
366 WRITE( iounit, fmt = 9961 )2
367 WRITE( iounit, fmt = 9960 )3
368 WRITE( iounit, fmt = 9959 )4
369 WRITE( iounit, fmt = 9958 )5
370 WRITE( iounit, fmt = 9956 )6
371 WRITE( iounit, fmt = 9957 )7
372 WRITE( iounit, fmt = 9955 )8
373 WRITE( iounit, fmt = '( '' Messages:'' )' )
374*
375 ELSE IF( lsamen( 2, p2, 'HA' ) ) THEN
376*
377* HA: Hermitian,
378* with Assen Algorithm
379*
380 WRITE( iounit, fmt = 9992 )path, 'Hermitian'
381*
382 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
383 WRITE( iounit, fmt = 9972 )
384*
385 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
386 WRITE( iounit, fmt = 9953 )1
387 WRITE( iounit, fmt = 9961 )2
388 WRITE( iounit, fmt = 9960 )3
389 WRITE( iounit, fmt = 9960 )4
390 WRITE( iounit, fmt = 9959 )5
391 WRITE( iounit, fmt = 9958 )6
392 WRITE( iounit, fmt = 9956 )7
393 WRITE( iounit, fmt = 9957 )8
394 WRITE( iounit, fmt = 9955 )9
395 WRITE( iounit, fmt = '( '' Messages:'' )' )
396*
397 ELSE IF( lsamen( 2, p2, 'HE' ) ) THEN
398*
399* HE: Hermitian indefinite full,
400* with partial (Bunch-Kaufman) pivoting algorithm
401*
402 WRITE( iounit, fmt = 9992 )path, 'Hermitian'
403*
404 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
405 WRITE( iounit, fmt = 9972 )
406*
407 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
408 WRITE( iounit, fmt = 9953 )1
409 WRITE( iounit, fmt = 9961 )2
410 WRITE( iounit, fmt = 9960 )3
411 WRITE( iounit, fmt = 9960 )4
412 WRITE( iounit, fmt = 9959 )5
413 WRITE( iounit, fmt = 9958 )6
414 WRITE( iounit, fmt = 9956 )7
415 WRITE( iounit, fmt = 9957 )8
416 WRITE( iounit, fmt = 9955 )9
417 WRITE( iounit, fmt = '( '' Messages:'' )' )
418*
419 ELSE IF( lsamen( 2, p2, 'HR' ) .OR. lsamen( 2, p2, 'HR' ) ) THEN
420*
421* HR: Hermitian indefinite full,
422* with rook (bounded Bunch-Kaufman) pivoting algorithm
423*
424* HK: Hermitian indefinite full,
425* with rook (bounded Bunch-Kaufman) pivoting algorithm,
426* ( new storage format for factors:
427* L and diagonal of D is stored in A,
428* subdiagonal of D is stored in E )
429*
430 WRITE( iounit, fmt = 9892 )path, 'Hermitian'
431*
432 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
433 WRITE( iounit, fmt = 9972 )
434*
435 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
436 WRITE( iounit, fmt = 9953 )1
437 WRITE( iounit, fmt = 9961 )2
438 WRITE( iounit, fmt = 9927 )3
439 WRITE( iounit, fmt = 9928 )
440 WRITE( iounit, fmt = 9926 )4
441 WRITE( iounit, fmt = 9928 )
442 WRITE( iounit, fmt = 9960 )5
443 WRITE( iounit, fmt = 9959 )6
444 WRITE( iounit, fmt = 9955 )7
445 WRITE( iounit, fmt = '( '' Messages:'' )' )
446*
447 ELSE IF( lsamen( 2, p2, 'HP' ) ) THEN
448*
449* HP: Hermitian indefinite packed,
450* with partial (Bunch-Kaufman) pivoting algorithm
451*
452 IF( lsame( c3, 'E' ) ) THEN
453 WRITE( iounit, fmt = 9992 )path, 'Hermitian'
454 ELSE
455 WRITE( iounit, fmt = 9991 )path, 'Hermitian'
456 END IF
457 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
458 WRITE( iounit, fmt = 9972 )
459 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
460 WRITE( iounit, fmt = 9953 )1
461 WRITE( iounit, fmt = 9961 )2
462 WRITE( iounit, fmt = 9960 )3
463 WRITE( iounit, fmt = 9959 )4
464 WRITE( iounit, fmt = 9958 )5
465 WRITE( iounit, fmt = 9956 )6
466 WRITE( iounit, fmt = 9957 )7
467 WRITE( iounit, fmt = 9955 )8
468 WRITE( iounit, fmt = '( '' Messages:'' )' )
469*
470 ELSE IF( lsamen( 2, p2, 'TR' ) .OR. lsamen( 2, p2, 'TP' ) ) THEN
471*
472* TR: Triangular full
473* TP: Triangular packed
474*
475 IF( lsame( c3, 'R' ) ) THEN
476 WRITE( iounit, fmt = 9990 )path
477 subnam = path( 1: 1 ) // 'LATRS'
478 ELSE
479 WRITE( iounit, fmt = 9989 )path
480 subnam = path( 1: 1 ) // 'LATPS'
481 END IF
482 WRITE( iounit, fmt = 9966 )path
483 WRITE( iounit, fmt = 9965 )subnam(1:len_trim( subnam ))
484 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
485 WRITE( iounit, fmt = 9961 )1
486 WRITE( iounit, fmt = 9960 )2
487 WRITE( iounit, fmt = 9959 )3
488 WRITE( iounit, fmt = 9958 )4
489 WRITE( iounit, fmt = 9957 )5
490 WRITE( iounit, fmt = 9956 )6
491 WRITE( iounit, fmt = 9955 )7
492 WRITE( iounit, fmt = 9951 )subnam(1:len_trim( subnam )), 8
493 WRITE( iounit, fmt = '( '' Messages:'' )' )
494*
495 ELSE IF( lsamen( 2, p2, 'TB' ) ) THEN
496*
497* TB: Triangular band
498*
499 WRITE( iounit, fmt = 9988 )path
500 subnam = path( 1: 1 ) // 'LATBS'
501 WRITE( iounit, fmt = 9964 )path
502 WRITE( iounit, fmt = 9963 )subnam(1:len_trim( subnam ))
503 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
504 WRITE( iounit, fmt = 9960 )1
505 WRITE( iounit, fmt = 9959 )2
506 WRITE( iounit, fmt = 9958 )3
507 WRITE( iounit, fmt = 9957 )4
508 WRITE( iounit, fmt = 9956 )5
509 WRITE( iounit, fmt = 9955 )6
510 WRITE( iounit, fmt = 9951 )subnam(1:len_trim( subnam )), 7
511 WRITE( iounit, fmt = '( '' Messages:'' )' )
512*
513 ELSE IF( lsamen( 2, p2, 'QR' ) ) THEN
514*
515* QR decomposition of rectangular matrices
516*
517 WRITE( iounit, fmt = 9987 )path, 'QR'
518 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
519 WRITE( iounit, fmt = 9970 )
520 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
521 WRITE( iounit, fmt = 9950 )1
522 WRITE( iounit, fmt = 6950 )8
523 WRITE( iounit, fmt = 9946 )2
524 WRITE( iounit, fmt = 9944 )3, 'M'
525 WRITE( iounit, fmt = 9943 )4, 'M'
526 WRITE( iounit, fmt = 9942 )5, 'M'
527 WRITE( iounit, fmt = 9941 )6, 'M'
528 WRITE( iounit, fmt = 9960 )7
529 WRITE( iounit, fmt = 6660 )9
530 WRITE( iounit, fmt = '( '' Messages:'' )' )
531*
532 ELSE IF( lsamen( 2, p2, 'LQ' ) ) THEN
533*
534* LQ decomposition of rectangular matrices
535*
536 WRITE( iounit, fmt = 9987 )path, 'LQ'
537 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
538 WRITE( iounit, fmt = 9970 )
539 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
540 WRITE( iounit, fmt = 9949 )1
541 WRITE( iounit, fmt = 9945 )2
542 WRITE( iounit, fmt = 9944 )3, 'N'
543 WRITE( iounit, fmt = 9943 )4, 'N'
544 WRITE( iounit, fmt = 9942 )5, 'N'
545 WRITE( iounit, fmt = 9941 )6, 'N'
546 WRITE( iounit, fmt = 9960 )7
547 WRITE( iounit, fmt = '( '' Messages:'' )' )
548*
549 ELSE IF( lsamen( 2, p2, 'QL' ) ) THEN
550*
551* QL decomposition of rectangular matrices
552*
553 WRITE( iounit, fmt = 9987 )path, 'QL'
554 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
555 WRITE( iounit, fmt = 9970 )
556 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
557 WRITE( iounit, fmt = 9948 )1
558 WRITE( iounit, fmt = 9946 )2
559 WRITE( iounit, fmt = 9944 )3, 'M'
560 WRITE( iounit, fmt = 9943 )4, 'M'
561 WRITE( iounit, fmt = 9942 )5, 'M'
562 WRITE( iounit, fmt = 9941 )6, 'M'
563 WRITE( iounit, fmt = 9960 )7
564 WRITE( iounit, fmt = '( '' Messages:'' )' )
565*
566 ELSE IF( lsamen( 2, p2, 'RQ' ) ) THEN
567*
568* RQ decomposition of rectangular matrices
569*
570 WRITE( iounit, fmt = 9987 )path, 'RQ'
571 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
572 WRITE( iounit, fmt = 9970 )
573 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
574 WRITE( iounit, fmt = 9947 )1
575 WRITE( iounit, fmt = 9945 )2
576 WRITE( iounit, fmt = 9944 )3, 'N'
577 WRITE( iounit, fmt = 9943 )4, 'N'
578 WRITE( iounit, fmt = 9942 )5, 'N'
579 WRITE( iounit, fmt = 9941 )6, 'N'
580 WRITE( iounit, fmt = 9960 )7
581 WRITE( iounit, fmt = '( '' Messages:'' )' )
582*
583 ELSE IF( lsamen( 2, p2, 'QP' ) ) THEN
584*
585* QR decomposition with column pivoting
586*
587 WRITE( iounit, fmt = 9986 )path
588 WRITE( iounit, fmt = 9969 )
589 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
590 WRITE( iounit, fmt = 9940 )1
591 WRITE( iounit, fmt = 9939 )2
592 WRITE( iounit, fmt = 9938 )3
593 WRITE( iounit, fmt = '( '' Messages:'' )' )
594*
595 ELSE IF( lsamen( 2, p2, 'TZ' ) ) THEN
596*
597* TZ: Trapezoidal
598*
599 WRITE( iounit, fmt = 9985 )path
600 WRITE( iounit, fmt = 9968 )
601 WRITE( iounit, fmt = 9929 )c1
602 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
603 WRITE( iounit, fmt = 9940 )1
604 WRITE( iounit, fmt = 9937 )2
605 WRITE( iounit, fmt = 9938 )3
606 WRITE( iounit, fmt = '( '' Messages:'' )' )
607*
608 ELSE IF( lsamen( 2, p2, 'LS' ) ) THEN
609*
610* LS: Least Squares driver routines for
611* LS, LSD, LSS, LSX and LSY.
612*
613 WRITE( iounit, fmt = 9984 )path
614 WRITE( iounit, fmt = 9967 )
615 WRITE( iounit, fmt = 9921 )c1, c1, c1, c1
616 WRITE( iounit, fmt = 9935 )1
617 WRITE( iounit, fmt = 9931 )2
618 WRITE( iounit, fmt = 9933 )3
619 WRITE( iounit, fmt = 9935 )4
620 WRITE( iounit, fmt = 9934 )5
621 WRITE( iounit, fmt = 9932 )6
622 WRITE( iounit, fmt = 9920 )
623 WRITE( iounit, fmt = '( '' Messages:'' )' )
624*
625 ELSE IF( lsamen( 2, p2, 'LU' ) ) THEN
626*
627* LU factorization variants
628*
629 WRITE( iounit, fmt = 9983 )path
630 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
631 WRITE( iounit, fmt = 9979 )
632 WRITE( iounit, fmt = '( '' Test ratio:'' )' )
633 WRITE( iounit, fmt = 9962 )1
634 WRITE( iounit, fmt = '( '' Messages:'' )' )
635*
636 ELSE IF( lsamen( 2, p2, 'CH' ) ) THEN
637*
638* Cholesky factorization variants
639*
640 WRITE( iounit, fmt = 9982 )path
641 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
642 WRITE( iounit, fmt = 9974 )
643 WRITE( iounit, fmt = '( '' Test ratio:'' )' )
644 WRITE( iounit, fmt = 9954 )1
645 WRITE( iounit, fmt = '( '' Messages:'' )' )
646*
647 ELSE IF( lsamen( 2, p2, 'QS' ) ) THEN
648*
649* QR factorization variants
650*
651 WRITE( iounit, fmt = 9981 )path
652 WRITE( iounit, fmt = '( '' Matrix types:'' )' )
653 WRITE( iounit, fmt = 9970 )
654 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
655*
656 ELSE IF( lsamen( 2, p2, 'QT' ) ) THEN
657*
658* QRT (general matrices)
659*
660 WRITE( iounit, fmt = 8000 ) path
661 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
662 WRITE( iounit, fmt = 8011 ) 1
663 WRITE( iounit, fmt = 8012 ) 2
664 WRITE( iounit, fmt = 8013 ) 3
665 WRITE( iounit, fmt = 8014 ) 4
666 WRITE( iounit, fmt = 8015 ) 5
667 WRITE( iounit, fmt = 8016 ) 6
668*
669 ELSE IF( lsamen( 2, p2, 'QX' ) ) THEN
670*
671* QRT (triangular-pentagonal)
672*
673 WRITE( iounit, fmt = 8001 ) path
674 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
675 WRITE( iounit, fmt = 8017 ) 1
676 WRITE( iounit, fmt = 8018 ) 2
677 WRITE( iounit, fmt = 8019 ) 3
678 WRITE( iounit, fmt = 8020 ) 4
679 WRITE( iounit, fmt = 8021 ) 5
680 WRITE( iounit, fmt = 8022 ) 6
681*
682 ELSE IF( lsamen( 2, p2, 'TQ' ) ) THEN
683*
684* QRT (triangular-pentagonal)
685*
686 WRITE( iounit, fmt = 8002 ) path
687 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
688 WRITE( iounit, fmt = 8023 ) 1
689 WRITE( iounit, fmt = 8024 ) 2
690 WRITE( iounit, fmt = 8025 ) 3
691 WRITE( iounit, fmt = 8026 ) 4
692 WRITE( iounit, fmt = 8027 ) 5
693 WRITE( iounit, fmt = 8028 ) 6
694*
695 ELSE IF( lsamen( 2, p2, 'XQ' ) ) THEN
696*
697* QRT (triangular-pentagonal)
698*
699 WRITE( iounit, fmt = 8003 ) path
700 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
701 WRITE( iounit, fmt = 8029 ) 1
702 WRITE( iounit, fmt = 8030 ) 2
703 WRITE( iounit, fmt = 8031 ) 3
704 WRITE( iounit, fmt = 8032 ) 4
705 WRITE( iounit, fmt = 8033 ) 5
706 WRITE( iounit, fmt = 8034 ) 6
707*
708 ELSE IF( lsamen( 2, p2, 'TS' ) ) THEN
709*
710* TS: QR routines for tall-skinny and short-wide matrices
711*
712 WRITE( iounit, fmt = 8004 ) path
713 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
714 WRITE( iounit, fmt = 8035 ) 1
715 WRITE( iounit, fmt = 8036 ) 2
716 WRITE( iounit, fmt = 8037 ) 3
717 WRITE( iounit, fmt = 8038 ) 4
718 WRITE( iounit, fmt = 8039 ) 5
719 WRITE( iounit, fmt = 8040 ) 6
720*
721 ELSE IF( lsamen( 2, p2, 'HH' ) ) THEN
722*
723* HH: Householder reconstruction for tall-skinny matrices
724*
725 WRITE( iounit, fmt = 8005 ) path
726 WRITE( iounit, fmt = '( '' Test ratios:'' )' )
727 WRITE( iounit, fmt = 8050 ) 1
728 WRITE( iounit, fmt = 8051 ) 2
729 WRITE( iounit, fmt = 8052 ) 3
730 WRITE( iounit, fmt = 8053 ) 4
731 WRITE( iounit, fmt = 8054 ) 5
732 WRITE( iounit, fmt = 8055 ) 6
733*
734 ELSE
735*
736* Print error message if no header is available.
737*
738 WRITE( iounit, fmt = 9980 )path
739 END IF
740*
741* First line of header
742*
743 9999 FORMAT( / 1x, a3, ': General dense matrices' )
744 9998 FORMAT( / 1x, a3, ': General band matrices' )
745 9997 FORMAT( / 1x, a3, ': General tridiagonal' )
746 9996 FORMAT( / 1x, a3, ': ', a9, ' positive definite matrices' )
747 9995 FORMAT( / 1x, a3, ': ', a9, ' positive definite packed matrices'
748 $ )
749 9994 FORMAT( / 1x, a3, ': ', a9, ' positive definite band matrices' )
750 9993 FORMAT( / 1x, a3, ': ', a9, ' positive definite tridiagonal' )
751 9992 FORMAT( / 1x, a3, ': ', a9, ' indefinite matrices',
752 $ ', partial (Bunch-Kaufman) pivoting' )
753 9991 FORMAT( / 1x, a3, ': ', a9, ' indefinite packed matrices',
754 $ ', partial (Bunch-Kaufman) pivoting' )
755 9892 FORMAT( / 1x, a3, ': ', a9, ' indefinite matrices',
756 $ ', "rook" (bounded Bunch-Kaufman) pivoting' )
757 9891 FORMAT( / 1x, a3, ': ', a9, ' indefinite packed matrices',
758 $ ', "rook" (bounded Bunch-Kaufman) pivoting' )
759 9990 FORMAT( / 1x, a3, ': Triangular matrices' )
760 9989 FORMAT( / 1x, a3, ': Triangular packed matrices' )
761 9988 FORMAT( / 1x, a3, ': Triangular band matrices' )
762 9987 FORMAT( / 1x, a3, ': ', a2, ' factorization of general matrices'
763 $ )
764 9986 FORMAT( / 1x, a3, ': QR factorization with column pivoting' )
765 9985 FORMAT( / 1x, a3, ': RQ factorization of trapezoidal matrix' )
766 9984 FORMAT( / 1x, a3, ': Least squares driver routines' )
767 9983 FORMAT( / 1x, a3, ': LU factorization variants' )
768 9982 FORMAT( / 1x, a3, ': Cholesky factorization variants' )
769 9981 FORMAT( / 1x, a3, ': QR factorization variants' )
770 9980 FORMAT( / 1x, a3, ': No header available' )
771 8000 FORMAT( / 1x, a3, ': QRT factorization for general matrices' )
772 8001 FORMAT( / 1x, a3, ': QRT factorization for ',
773 $ 'triangular-pentagonal matrices' )
774 8002 FORMAT( / 1x, a3, ': LQT factorization for general matrices' )
775 8003 FORMAT( / 1x, a3, ': LQT factorization for ',
776 $ 'triangular-pentagonal matrices' )
777 8004 FORMAT( / 1x, a3, ': TS factorization for ',
778 $ 'tall-skinny or short-wide matrices' )
779 8005 FORMAT( / 1x, a3, ': Householder recostruction from TSQR',
780 $ ' factorization output ', /,' for tall-skinny matrices.' )
781*
782* GE matrix types
783*
784 9979 FORMAT( 4x, '1. Diagonal', 24x, '7. Last n/2 columns zero', / 4x,
785 $ '2. Upper triangular', 16x,
786 $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
787 $ '3. Lower triangular', 16x, '9. Random, CNDNUM = 0.1/EPS',
788 $ / 4x, '4. Random, CNDNUM = 2', 13x,
789 $ '10. Scaled near underflow', / 4x, '5. First column zero',
790 $ 14x, '11. Scaled near overflow', / 4x,
791 $ '6. Last column zero' )
792*
793* GB matrix types
794*
795 9978 FORMAT( 4x, '1. Random, CNDNUM = 2', 14x,
796 $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
797 $ '2. First column zero', 15x, '6. Random, CNDNUM = .01/EPS',
798 $ / 4x, '3. Last column zero', 16x,
799 $ '7. Scaled near underflow', / 4x,
800 $ '4. Last n/2 columns zero', 11x, '8. Scaled near overflow' )
801*
802* GT matrix types
803*
804 9977 FORMAT( ' Matrix types (1-6 have specified condition numbers):',
805 $ / 4x, '1. Diagonal', 24x, '7. Random, unspecified CNDNUM',
806 $ / 4x, '2. Random, CNDNUM = 2', 14x, '8. First column zero',
807 $ / 4x, '3. Random, CNDNUM = sqrt(0.1/EPS)', 2x,
808 $ '9. Last column zero', / 4x, '4. Random, CNDNUM = 0.1/EPS',
809 $ 7x, '10. Last n/2 columns zero', / 4x,
810 $ '5. Scaled near underflow', 10x,
811 $ '11. Scaled near underflow', / 4x,
812 $ '6. Scaled near overflow', 11x, '12. Scaled near overflow' )
813*
814* PT matrix types
815*
816 9976 FORMAT( ' Matrix types (1-6 have specified condition numbers):',
817 $ / 4x, '1. Diagonal', 24x, '7. Random, unspecified CNDNUM',
818 $ / 4x, '2. Random, CNDNUM = 2', 14x,
819 $ '8. First row and column zero', / 4x,
820 $ '3. Random, CNDNUM = sqrt(0.1/EPS)', 2x,
821 $ '9. Last row and column zero', / 4x,
822 $ '4. Random, CNDNUM = 0.1/EPS', 7x,
823 $ '10. Middle row and column zero', / 4x,
824 $ '5. Scaled near underflow', 10x,
825 $ '11. Scaled near underflow', / 4x,
826 $ '6. Scaled near overflow', 11x, '12. Scaled near overflow' )
827*
828* PO, PP matrix types
829*
830 9975 FORMAT( 4x, '1. Diagonal', 24x,
831 $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
832 $ '2. Random, CNDNUM = 2', 14x, '7. Random, CNDNUM = 0.1/EPS',
833 $ / 3x, '*3. First row and column zero', 7x,
834 $ '8. Scaled near underflow', / 3x,
835 $ '*4. Last row and column zero', 8x,
836 $ '9. Scaled near overflow', / 3x,
837 $ '*5. Middle row and column zero', / 3x,
838 $ '(* - tests error exits from ', a3,
839 $ 'TRF, no test ratios are computed)' )
840*
841* CH matrix types
842*
843 9974 FORMAT( 4x, '1. Diagonal', 24x,
844 $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
845 $ '2. Random, CNDNUM = 2', 14x, '7. Random, CNDNUM = 0.1/EPS',
846 $ / 3x, '*3. First row and column zero', 7x,
847 $ '8. Scaled near underflow', / 3x,
848 $ '*4. Last row and column zero', 8x,
849 $ '9. Scaled near overflow', / 3x,
850 $ '*5. Middle row and column zero', / 3x,
851 $ '(* - tests error exits, no test ratios are computed)' )
852*
853* PS matrix types
854*
855 8973 FORMAT( 4x, '1. Diagonal', / 4x, '2. Random, CNDNUM = 2', 14x,
856 $ / 3x, '*3. Nonzero eigenvalues of: D(1:RANK-1)=1 and ',
857 $ 'D(RANK) = 1.0/', a4, / 3x,
858 $ '*4. Nonzero eigenvalues of: D(1)=1 and ',
859 $ ' D(2:RANK) = 1.0/', a4, / 3x,
860 $ '*5. Nonzero eigenvalues of: D(I) = ', a4,
861 $ '**(-(I-1)/(RANK-1)) ', ' I=1:RANK', / 4x,
862 $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
863 $ '7. Random, CNDNUM = 0.1/EPS', / 4x,
864 $ '8. Scaled near underflow', / 4x, '9. Scaled near overflow',
865 $ / 3x, '(* - Semi-definite tests )' )
866 8972 FORMAT( 3x, 'RANK minus computed rank, returned by ', a, 'PSTRF' )
867*
868* PB matrix types
869*
870 9973 FORMAT( 4x, '1. Random, CNDNUM = 2', 14x,
871 $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 3x,
872 $ '*2. First row and column zero', 7x,
873 $ '6. Random, CNDNUM = 0.1/EPS', / 3x,
874 $ '*3. Last row and column zero', 8x,
875 $ '7. Scaled near underflow', / 3x,
876 $ '*4. Middle row and column zero', 6x,
877 $ '8. Scaled near overflow', / 3x,
878 $ '(* - tests error exits from ', a3,
879 $ 'TRF, no test ratios are computed)' )
880*
881* SSY, SSR, SSP, CHE, CHR, CHP matrix types
882*
883 9972 FORMAT( 4x, '1. Diagonal', 24x,
884 $ '6. Last n/2 rows and columns zero', / 4x,
885 $ '2. Random, CNDNUM = 2', 14x,
886 $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
887 $ '3. First row and column zero', 7x,
888 $ '8. Random, CNDNUM = 0.1/EPS', / 4x,
889 $ '4. Last row and column zero', 8x,
890 $ '9. Scaled near underflow', / 4x,
891 $ '5. Middle row and column zero', 5x,
892 $ '10. Scaled near overflow' )
893*
894* CSY, CSR, CSP matrix types
895*
896 9971 FORMAT( 4x, '1. Diagonal', 24x,
897 $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
898 $ '2. Random, CNDNUM = 2', 14x, '8. Random, CNDNUM = 0.1/EPS',
899 $ / 4x, '3. First row and column zero', 7x,
900 $ '9. Scaled near underflow', / 4x,
901 $ '4. Last row and column zero', 7x,
902 $ '10. Scaled near overflow', / 4x,
903 $ '5. Middle row and column zero', 5x,
904 $ '11. Block diagonal matrix', / 4x,
905 $ '6. Last n/2 rows and columns zero' )
906*
907* QR matrix types
908*
909 9970 FORMAT( 4x, '1. Diagonal', 24x,
910 $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
911 $ '2. Upper triangular', 16x, '6. Random, CNDNUM = 0.1/EPS',
912 $ / 4x, '3. Lower triangular', 16x,
913 $ '7. Scaled near underflow', / 4x, '4. Random, CNDNUM = 2',
914 $ 14x, '8. Scaled near overflow' )
915*
916* QP matrix types
917*
918 9969 FORMAT( ' Matrix types (2-6 have condition 1/EPS):', / 4x,
919 $ '1. Zero matrix', 21x, '4. First n/2 columns fixed', / 4x,
920 $ '2. One small eigenvalue', 12x, '5. Last n/2 columns fixed',
921 $ / 4x, '3. Geometric distribution', 10x,
922 $ '6. Every second column fixed' )
923*
924* TZ matrix types
925*
926 9968 FORMAT( ' Matrix types (2-3 have condition 1/EPS):', / 4x,
927 $ '1. Zero matrix', / 4x, '2. One small eigenvalue', / 4x,
928 $ '3. Geometric distribution' )
929*
930* LS matrix types
931*
932 9967 FORMAT( ' Matrix types (1-3: full rank, 4-6: rank deficient):',
933 $ / 4x, '1 and 4. Normal scaling', / 4x,
934 $ '2 and 5. Scaled near overflow', / 4x,
935 $ '3 and 6. Scaled near underflow' )
936*
937* TR, TP matrix types
938*
939 9966 FORMAT( ' Matrix types for ', a3, ' routines:', / 4x,
940 $ '1. Diagonal', 24x, '6. Scaled near overflow', / 4x,
941 $ '2. Random, CNDNUM = 2', 14x, '7. Identity', / 4x,
942 $ '3. Random, CNDNUM = sqrt(0.1/EPS) ',
943 $ '8. Unit triangular, CNDNUM = 2', / 4x,
944 $ '4. Random, CNDNUM = 0.1/EPS', 8x,
945 $ '9. Unit, CNDNUM = sqrt(0.1/EPS)', / 4x,
946 $ '5. Scaled near underflow', 10x,
947 $ '10. Unit, CNDNUM = 0.1/EPS' )
948 9965 FORMAT( ' Special types for testing ', a, ':', / 3x,
949 $ '11. Matrix elements are O(1), large right hand side', / 3x,
950 $ '12. First diagonal causes overflow,',
951 $ ' offdiagonal column norms < 1', / 3x,
952 $ '13. First diagonal causes overflow,',
953 $ ' offdiagonal column norms > 1', / 3x,
954 $ '14. Growth factor underflows, solution does not overflow',
955 $ / 3x, '15. Small diagonal causes gradual overflow', / 3x,
956 $ '16. One zero diagonal element', / 3x,
957 $ '17. Large offdiagonals cause overflow when adding a column'
958 $ , / 3x, '18. Unit triangular with large right hand side' )
959*
960* TB matrix types
961*
962 9964 FORMAT( ' Matrix types for ', a3, ' routines:', / 4x,
963 $ '1. Random, CNDNUM = 2', 14x, '6. Identity', / 4x,
964 $ '2. Random, CNDNUM = sqrt(0.1/EPS) ',
965 $ '7. Unit triangular, CNDNUM = 2', / 4x,
966 $ '3. Random, CNDNUM = 0.1/EPS', 8x,
967 $ '8. Unit, CNDNUM = sqrt(0.1/EPS)', / 4x,
968 $ '4. Scaled near underflow', 11x,
969 $ '9. Unit, CNDNUM = 0.1/EPS', / 4x,
970 $ '5. Scaled near overflow' )
971 9963 FORMAT( ' Special types for testing ', a, ':', / 3x,
972 $ '10. Matrix elements are O(1), large right hand side', / 3x,
973 $ '11. First diagonal causes overflow,',
974 $ ' offdiagonal column norms < 1', / 3x,
975 $ '12. First diagonal causes overflow,',
976 $ ' offdiagonal column norms > 1', / 3x,
977 $ '13. Growth factor underflows, solution does not overflow',
978 $ / 3x, '14. Small diagonal causes gradual overflow', / 3x,
979 $ '15. One zero diagonal element', / 3x,
980 $ '16. Large offdiagonals cause overflow when adding a column'
981 $ , / 3x, '17. Unit triangular with large right hand side' )
982*
983* Test ratios
984*
985 9962 FORMAT( 3x, i2, ': norm( L * U - A ) / ( N * norm(A) * EPS )' )
986 9961 FORMAT( 3x, i2, ': norm( I - A*AINV ) / ',
987 $ '( N * norm(A) * norm(AINV) * EPS )' )
988 9960 FORMAT( 3x, i2, ': norm( B - A * X ) / ',
989 $ '( norm(A) * norm(X) * EPS )' )
990 6660 FORMAT( 3x, i2, ': diagonal is not non-negative')
991 9959 FORMAT( 3x, i2, ': norm( X - XACT ) / ',
992 $ '( norm(XACT) * CNDNUM * EPS )' )
993 9958 FORMAT( 3x, i2, ': norm( X - XACT ) / ',
994 $ '( norm(XACT) * CNDNUM * EPS ), refined' )
995 9957 FORMAT( 3x, i2, ': norm( X - XACT ) / ',
996 $ '( norm(XACT) * (error bound) )' )
997 9956 FORMAT( 3x, i2, ': (backward error) / EPS' )
998 9955 FORMAT( 3x, i2, ': RCOND * CNDNUM - 1.0' )
999 9954 FORMAT( 3x, i2, ': norm( U'' * U - A ) / ( N * norm(A) * EPS )',
1000 $ ', or', / 7x, 'norm( L * L'' - A ) / ( N * norm(A) * EPS )'
1001 $ )
1002 8950 FORMAT( 3x,
1003 $ 'norm( P * U'' * U * P'' - A ) / ( N * norm(A) * EPS )',
1004 $ ', or', / 3x,
1005 $ 'norm( P * L * L'' * P'' - A ) / ( N * norm(A) * EPS )' )
1006 9953 FORMAT( 3x, i2, ': norm( U*D*U'' - A ) / ( N * norm(A) * EPS )',
1007 $ ', or', / 7x, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
1008 $ )
1009 9952 FORMAT( 3x, i2, ': norm( U''*D*U - A ) / ( N * norm(A) * EPS )',
1010 $ ', or', / 7x, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
1011 $ )
1012 9951 FORMAT( ' Test ratio for ', a, ':', / 3x, i2,
1013 $ ': norm( s*b - A*x ) / ( norm(A) * norm(x) * EPS )' )
1014 9950 FORMAT( 3x, i2, ': norm( R - Q'' * A ) / ( M * norm(A) * EPS )' )
1015 6950 FORMAT( 3x, i2, ': norm( R - Q'' * A ) / ( M * norm(A) * EPS )
1016 $ [RFPG]' )
1017 9949 FORMAT( 3x, i2, ': norm( L - A * Q'' ) / ( N * norm(A) * EPS )' )
1018 9948 FORMAT( 3x, i2, ': norm( L - Q'' * A ) / ( M * norm(A) * EPS )' )
1019 9947 FORMAT( 3x, i2, ': norm( R - A * Q'' ) / ( N * norm(A) * EPS )' )
1020 9946 FORMAT( 3x, i2, ': norm( I - Q''*Q ) / ( M * EPS )' )
1021 9945 FORMAT( 3x, i2, ': norm( I - Q*Q'' ) / ( N * EPS )' )
1022 9944 FORMAT( 3x, i2, ': norm( Q*C - Q*C ) / ', '( ', a1,
1023 $ ' * norm(C) * EPS )' )
1024 9943 FORMAT( 3x, i2, ': norm( C*Q - C*Q ) / ', '( ', a1,
1025 $ ' * norm(C) * EPS )' )
1026 9942 FORMAT( 3x, i2, ': norm( Q''*C - Q''*C )/ ', '( ', a1,
1027 $ ' * norm(C) * EPS )' )
1028 9941 FORMAT( 3x, i2, ': norm( C*Q'' - C*Q'' )/ ', '( ', a1,
1029 $ ' * norm(C) * EPS )' )
1030 9940 FORMAT( 3x, i2, ': norm(svd(A) - svd(R)) / ',
1031 $ '( M * norm(svd(R)) * EPS )' )
1032 9939 FORMAT( 3x, i2, ': norm( A*P - Q*R ) / ( M * norm(A) * EPS )'
1033 $ )
1034 9938 FORMAT( 3x, i2, ': norm( I - Q''*Q ) / ( M * EPS )' )
1035 9937 FORMAT( 3x, i2, ': norm( A - R*Q ) / ( M * norm(A) * EPS )'
1036 $ )
1037 9935 FORMAT( 3x, i2, ': norm( B - A * X ) / ',
1038 $ '( max(M,N) * norm(A) * norm(X) * EPS )' )
1039 9934 FORMAT( 3x, i2, ': norm( (A*X-B)'' *A ) / ',
1040 $ '( max(M,N,NRHS) * norm(A) * norm(B) * EPS )' )
1041 9933 FORMAT( 3x, i2, ': norm(svd(A)-svd(R)) / ',
1042 $ '( min(M,N) * norm(svd(R)) * EPS )' )
1043 9932 FORMAT( 3x, i2, ': Check if X is in the row space of A or A''' )
1044 9931 FORMAT( 3x, i2, ': norm( (A*X-B)'' *A ) / ',
1045 $ '( max(M,N,NRHS) * norm(A) * norm(B) * EPS )', / 7x,
1046 $ 'if TRANS=''N'.GE.' and MN or TRANS=''T'.LT.' and MN, ',
1047 $ 'otherwise', / 7x,
1048 $ 'check if X is in the row space of A or A'' ',
1049 $ '(overdetermined case)' )
1050 9929 FORMAT( ' Test ratios (1-3: ', a1, 'TZRZF):' )
1051 9920 FORMAT( 3x, ' 7-10: same as 3-6', 3x, ' 11-14: same as 3-6' )
1052 9921 FORMAT( ' Test ratios:', / ' (1-2: ', a1, 'GELS, 3-6: ', a1,
1053 $ 'GELSY, 7-10: ', a1, 'GELSS, 11-14: ', a1, 'GELSD, 15-16: ',
1054 $ a1, 'GETSLS)')
1055 9928 FORMAT( 7x, 'where ALPHA = ( 1 + SQRT( 17 ) ) / 8' )
1056 9927 FORMAT( 3x, i2, ': ABS( Largest element in L )', / 12x,
1057 $ ' - ( 1 / ( 1 - ALPHA ) ) + THRESH' )
1058 9926 FORMAT( 3x, i2, ': Largest 2-Norm of 2-by-2 pivots', / 12x,
1059 $ ' - ( ( 1 + ALPHA ) / ( 1 - ALPHA ) ) + THRESH' )
1060 8011 FORMAT(3x,i2,': norm( R - Q''*A ) / ( M * norm(A) * EPS )' )
1061 8012 FORMAT(3x,i2,': norm( I - Q''*Q ) / ( M * EPS )' )
1062 8013 FORMAT(3x,i2,': norm( Q*C - Q*C ) / ( M * norm(C) * EPS )' )
1063 8014 FORMAT(3x,i2,': norm( Q''*C - Q''*C ) / ( M * norm(C) * EPS )')
1064 8015 FORMAT(3x,i2,': norm( C*Q - C*Q ) / ( M * norm(C) * EPS )' )
1065 8016 FORMAT(3x,i2,': norm( C*Q'' - C*Q'' ) / ( M * norm(C) * EPS )')
1066 8017 FORMAT(3x,i2,': norm( R - Q''*A ) / ( (M+N) * norm(A) * EPS )' )
1067 8018 FORMAT(3x,i2,': norm( I - Q''*Q ) / ( (M+N) * EPS )' )
1068 8019 FORMAT(3x,i2,': norm( Q*C - Q*C ) / ( (M+N) * norm(C) * EPS )' )
1069 8020 FORMAT(3x,i2,
1070 $ ': norm( Q''*C - Q''*C ) / ( (M+N) * norm(C) * EPS )')
1071 8021 FORMAT(3x,i2,': norm( C*Q - C*Q ) / ( (M+N) * norm(C) * EPS )' )
1072 8022 FORMAT(3x,i2,
1073 $ ': norm( C*Q'' - C*Q'' ) / ( (M+N) * norm(C) * EPS )')
1074 8023 FORMAT(3x,i2,': norm( L - A*Q'' ) / ( (M+N) * norm(A) * EPS )' )
1075 8024 FORMAT(3x,i2,': norm( I - Q*Q'' ) / ( (M+N) * EPS )' )
1076 8025 FORMAT(3x,i2,': norm( Q*C - Q*C ) / ( (M+N) * norm(C) * EPS )' )
1077 8026 FORMAT(3x,i2,
1078 $ ': norm( Q''*C - Q''*C ) / ( (M+N) * norm(C) * EPS )')
1079 8027 FORMAT(3x,i2,': norm( C*Q - C*Q ) / ( (M+N) * norm(C) * EPS )' )
1080 8028 FORMAT(3x,i2,
1081 $ ': norm( C*Q'' - C*Q'' ) / ( (M+N) * norm(C) * EPS )')
1082 8029 FORMAT(3x,i2,': norm( L - A*Q'' ) / ( (M+N) * norm(A) * EPS )' )
1083 8030 FORMAT(3x,i2,': norm( I - Q*Q'' ) / ( (M+N) * EPS )' )
1084 8031 FORMAT(3x,i2,': norm( Q*C - Q*C ) / ( (M+N) * norm(C) * EPS )' )
1085 8032 FORMAT(3x,i2,
1086 $ ': norm( Q''*C - Q''*C ) / ( (M+N) * norm(C) * EPS )')
1087 8033 FORMAT(3x,i2,': norm( C*Q - C*Q ) / ( (M+N) * norm(C) * EPS )' )
1088 8034 FORMAT(3x,i2,
1089 $ ': norm( C*Q'' - C*Q'' ) / ( (M+N) * norm(C) * EPS )')
1090 8035 FORMAT(3x,i2,': norm( R - Q''*A ) / ( (M+N) * norm(A) * EPS )' )
1091 8036 FORMAT(3x,i2,': norm( I - Q''*Q ) / ( (M+N) * EPS )' )
1092 8037 FORMAT(3x,i2,': norm( Q*C - Q*C ) / ( (M+N) * norm(C) * EPS )' )
1093 8038 FORMAT(3x,i2,
1094 $ ': norm( Q''*C - Q''*C ) / ( (M+N) * norm(C) * EPS )')
1095 8039 FORMAT(3x,i2,': norm( C*Q - C*Q ) / ( (M+N) * norm(C) * EPS )' )
1096 8040 FORMAT(3x,i2,
1097 $ ': norm( C*Q'' - C*Q'' ) / ( (M+N) * norm(C) * EPS )')
1098*
1099 8050 FORMAT(3x,i2,': norm( R - Q''*A ) / ( M * norm(A) * EPS )' )
1100 8051 FORMAT(3x,i2,': norm( I - Q''*Q ) / ( M * EPS )' )
1101 8052 FORMAT(3x,i2,': norm( Q*C - Q*C ) / ( M * norm(C) * EPS )' )
1102 8053 FORMAT(3x,i2,': norm( Q''*C - Q''*C ) / ( M * norm(C) * EPS )')
1103 8054 FORMAT(3x,i2,': norm( C*Q - C*Q ) / ( M * norm(C) * EPS )' )
1104 8055 FORMAT(3x,i2,': norm( C*Q'' - C*Q'' ) / ( M * norm(C) * EPS )')
1105
1106*
1107 RETURN
1108*
1109* End of ALAHD
1110*

◆ alareq()

subroutine alareq ( character*3 path,
integer nmats,
logical, dimension( * ) dotype,
integer ntypes,
integer nin,
integer nout )

ALAREQ

Purpose:
!>
!> ALAREQ handles input for the LAPACK test program.  It is called
!> to evaluate the input line which requested NMATS matrix types for
!> PATH.  The flow of control is as follows:
!>
!> If NMATS = NTYPES then
!>    DOTYPE(1:NTYPES) = .TRUE.
!> else
!>    Read the next input line for NMATS matrix types
!>    Set DOTYPE(I) = .TRUE. for each valid type I
!> endif
!>
Parameters
[in]PATH
!>          PATH is CHARACTER*3
!>          An LAPACK path name for testing.
!>
[in]NMATS
!>          NMATS is INTEGER
!>          The number of matrix types to be used in testing this path.
!>
[out]DOTYPE
!>          DOTYPE is LOGICAL array, dimension (NTYPES)
!>          The vector of flags indicating if each type will be tested.
!>
[in]NTYPES
!>          NTYPES is INTEGER
!>          The maximum number of matrix types for this path.
!>
[in]NIN
!>          NIN is INTEGER
!>          The unit number for input.  NIN >= 1.
!>
[in]NOUT
!>          NOUT is INTEGER
!>          The unit number for output.  NOUT >= 1.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 89 of file alareq.f.

90*
91* -- LAPACK test routine --
92* -- LAPACK is a software package provided by Univ. of Tennessee, --
93* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
94*
95* .. Scalar Arguments ..
96 CHARACTER*3 PATH
97 INTEGER NIN, NMATS, NOUT, NTYPES
98* ..
99* .. Array Arguments ..
100 LOGICAL DOTYPE( * )
101* ..
102*
103* =====================================================================
104*
105* .. Local Scalars ..
106 LOGICAL FIRSTT
107 CHARACTER C1
108 CHARACTER*10 INTSTR
109 CHARACTER*80 LINE
110 INTEGER I, I1, IC, J, K, LENP, NT
111* ..
112* .. Local Arrays ..
113 INTEGER NREQ( 100 )
114* ..
115* .. Intrinsic Functions ..
116 INTRINSIC len
117* ..
118* .. Data statements ..
119 DATA intstr / '0123456789' /
120* ..
121* .. Executable Statements ..
122*
123 IF( nmats.GE.ntypes ) THEN
124*
125* Test everything if NMATS >= NTYPES.
126*
127 DO 10 i = 1, ntypes
128 dotype( i ) = .true.
129 10 CONTINUE
130 ELSE
131 DO 20 i = 1, ntypes
132 dotype( i ) = .false.
133 20 CONTINUE
134 firstt = .true.
135*
136* Read a line of matrix types if 0 < NMATS < NTYPES.
137*
138 IF( nmats.GT.0 ) THEN
139 READ( nin, fmt = '(A80)', END = 90 )line
140 lenp = len( line )
141 i = 0
142 DO 60 j = 1, nmats
143 nreq( j ) = 0
144 i1 = 0
145 30 CONTINUE
146 i = i + 1
147 IF( i.GT.lenp ) THEN
148 IF( j.EQ.nmats .AND. i1.GT.0 ) THEN
149 GO TO 60
150 ELSE
151 WRITE( nout, fmt = 9995 )line
152 WRITE( nout, fmt = 9994 )nmats
153 GO TO 80
154 END IF
155 END IF
156 IF( line( i: i ).NE.' ' .AND. line( i: i ).NE.',' ) THEN
157 i1 = i
158 c1 = line( i1: i1 )
159*
160* Check that a valid integer was read
161*
162 DO 40 k = 1, 10
163 IF( c1.EQ.intstr( k: k ) ) THEN
164 ic = k - 1
165 GO TO 50
166 END IF
167 40 CONTINUE
168 WRITE( nout, fmt = 9996 )i, line
169 WRITE( nout, fmt = 9994 )nmats
170 GO TO 80
171 50 CONTINUE
172 nreq( j ) = 10*nreq( j ) + ic
173 GO TO 30
174 ELSE IF( i1.GT.0 ) THEN
175 GO TO 60
176 ELSE
177 GO TO 30
178 END IF
179 60 CONTINUE
180 END IF
181 DO 70 i = 1, nmats
182 nt = nreq( i )
183 IF( nt.GT.0 .AND. nt.LE.ntypes ) THEN
184 IF( dotype( nt ) ) THEN
185 IF( firstt )
186 $ WRITE( nout, fmt = * )
187 firstt = .false.
188 WRITE( nout, fmt = 9997 )nt, path
189 END IF
190 dotype( nt ) = .true.
191 ELSE
192 WRITE( nout, fmt = 9999 )path, nt, ntypes
193 9999 FORMAT( ' *** Invalid type request for ', a3, ', type ',
194 $ i4, ': must satisfy 1 <= type <= ', i2 )
195 END IF
196 70 CONTINUE
197 80 CONTINUE
198 END IF
199 RETURN
200*
201 90 CONTINUE
202 WRITE( nout, fmt = 9998 )path
203 9998 FORMAT( /' *** End of file reached when trying to read matrix ',
204 $ 'types for ', a3, /' *** Check that you are requesting the',
205 $ ' right number of types for each path', / )
206 9997 FORMAT( ' *** Warning: duplicate request of matrix type ', i2,
207 $ ' for ', a3 )
208 9996 FORMAT( //' *** Invalid integer value in column ', i2,
209 $ ' of input', ' line:', /a79 )
210 9995 FORMAT( //' *** Not enough matrix types on input line', /a79 )
211 9994 FORMAT( ' ==> Specify ', i4, ' matrix types on this line or ',
212 $ 'adjust NTYPES on previous line' )
213 WRITE( nout, fmt = * )
214 stop
215*
216* End of ALAREQ
217*

◆ alasum()

subroutine alasum ( character*3 type,
integer nout,
integer nfail,
integer nrun,
integer nerrs )

ALASUM

Purpose:
!>
!> ALASUM prints a summary of results from one of the -CHK- routines.
!>
Parameters
[in]TYPE
!>          TYPE is CHARACTER*3
!>          The LAPACK path name.
!>
[in]NOUT
!>          NOUT is INTEGER
!>          The unit number on which results are to be printed.
!>          NOUT >= 0.
!>
[in]NFAIL
!>          NFAIL is INTEGER
!>          The number of tests which did not pass the threshold ratio.
!>
[in]NRUN
!>          NRUN is INTEGER
!>          The total number of tests.
!>
[in]NERRS
!>          NERRS is INTEGER
!>          The number of error messages recorded.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 72 of file alasum.f.

73*
74* -- LAPACK test routine --
75* -- LAPACK is a software package provided by Univ. of Tennessee, --
76* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
77*
78* .. Scalar Arguments ..
79 CHARACTER*3 TYPE
80 INTEGER NFAIL, NOUT, NRUN, NERRS
81* ..
82*
83* =====================================================================
84*
85* .. Executable Statements ..
86*
87 IF( nfail.GT.0 ) THEN
88 WRITE( nout, fmt = 9999 )TYPE, NFAIL, NRUN
89 ELSE
90 WRITE( nout, fmt = 9998 )TYPE, NRUN
91 END IF
92 IF( nerrs.GT.0 ) THEN
93 WRITE( nout, fmt = 9997 )nerrs
94 END IF
95*
96 9999 FORMAT( 1x, a3, ': ', i6, ' out of ', i6,
97 $ ' tests failed to pass the threshold' )
98 9998 FORMAT( /1x, 'All tests for ', a3,
99 $ ' routines passed the threshold ( ', i6, ' tests run)' )
100 9997 FORMAT( 6x, i6, ' error messages recorded' )
101 RETURN
102*
103* End of ALASUM
104*

◆ alasvm()

subroutine alasvm ( character*3 type,
integer nout,
integer nfail,
integer nrun,
integer nerrs )

ALASVM

Purpose:
!>
!> ALASVM prints a summary of results from one of the -DRV- routines.
!>
Parameters
[in]TYPE
!>          TYPE is CHARACTER*3
!>          The LAPACK path name.
!>
[in]NOUT
!>          NOUT is INTEGER
!>          The unit number on which results are to be printed.
!>          NOUT >= 0.
!>
[in]NFAIL
!>          NFAIL is INTEGER
!>          The number of tests which did not pass the threshold ratio.
!>
[in]NRUN
!>          NRUN is INTEGER
!>          The total number of tests.
!>
[in]NERRS
!>          NERRS is INTEGER
!>          The number of error messages recorded.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 72 of file alasvm.f.

73*
74* -- LAPACK test routine --
75* -- LAPACK is a software package provided by Univ. of Tennessee, --
76* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
77*
78* .. Scalar Arguments ..
79 CHARACTER*3 TYPE
80 INTEGER NFAIL, NOUT, NRUN, NERRS
81* ..
82*
83* =====================================================================
84*
85* .. Executable Statements ..
86*
87 IF( nfail.GT.0 ) THEN
88 WRITE( nout, fmt = 9999 )TYPE, NFAIL, NRUN
89 ELSE
90 WRITE( nout, fmt = 9998 )TYPE, NRUN
91 END IF
92 IF( nerrs.GT.0 ) THEN
93 WRITE( nout, fmt = 9997 )nerrs
94 END IF
95*
96 9999 FORMAT( 1x, a3, ' drivers: ', i6, ' out of ', i6,
97 $ ' tests failed to pass the threshold' )
98 9998 FORMAT( /1x, 'All tests for ', a3, ' drivers passed the ',
99 $ 'threshold ( ', i6, ' tests run)' )
100 9997 FORMAT( 14x, i6, ' error messages recorded' )
101 RETURN
102*
103* End of ALASVM
104*

◆ icopy()

subroutine icopy ( integer n,
integer, dimension( * ) sx,
integer incx,
integer, dimension( * ) sy,
integer incy )

ICOPY

Purpose:
!>
!> ICOPY copies an integer vector x to an integer vector y.
!> Uses unrolled loops for increments equal to 1.
!>
Parameters
[in]N
!>          N is INTEGER
!>          The length of the vectors SX and SY.
!>
[in]SX
!>          SX is INTEGER array, dimension (1+(N-1)*abs(INCX))
!>          The vector X.
!>
[in]INCX
!>          INCX is INTEGER
!>          The spacing between consecutive elements of SX.
!>
[out]SY
!>          SY is INTEGER array, dimension (1+(N-1)*abs(INCY))
!>          The vector Y.
!>
[in]INCY
!>          INCY is INTEGER
!>          The spacing between consecutive elements of SY.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 74 of file icopy.f.

75*
76* -- LAPACK test routine --
77* -- LAPACK is a software package provided by Univ. of Tennessee, --
78* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
79*
80* .. Scalar Arguments ..
81 INTEGER INCX, INCY, N
82* ..
83* .. Array Arguments ..
84 INTEGER SX( * ), SY( * )
85* ..
86*
87* =====================================================================
88*
89* .. Local Scalars ..
90 INTEGER I, IX, IY, M, MP1
91* ..
92* .. Intrinsic Functions ..
93 INTRINSIC mod
94* ..
95* .. Executable Statements ..
96*
97 IF( n.LE.0 )
98 $ RETURN
99 IF( incx.EQ.1 .AND. incy.EQ.1 )
100 $ GO TO 20
101*
102* Code for unequal increments or equal increments not equal to 1
103*
104 ix = 1
105 iy = 1
106 IF( incx.LT.0 )
107 $ ix = ( -n+1 )*incx + 1
108 IF( incy.LT.0 )
109 $ iy = ( -n+1 )*incy + 1
110 DO 10 i = 1, n
111 sy( iy ) = sx( ix )
112 ix = ix + incx
113 iy = iy + incy
114 10 CONTINUE
115 RETURN
116*
117* Code for both increments equal to 1
118*
119* Clean-up loop
120*
121 20 CONTINUE
122 m = mod( n, 7 )
123 IF( m.EQ.0 )
124 $ GO TO 40
125 DO 30 i = 1, m
126 sy( i ) = sx( i )
127 30 CONTINUE
128 IF( n.LT.7 )
129 $ RETURN
130 40 CONTINUE
131 mp1 = m + 1
132 DO 50 i = mp1, n, 7
133 sy( i ) = sx( i )
134 sy( i+1 ) = sx( i+1 )
135 sy( i+2 ) = sx( i+2 )
136 sy( i+3 ) = sx( i+3 )
137 sy( i+4 ) = sx( i+4 )
138 sy( i+5 ) = sx( i+5 )
139 sy( i+6 ) = sx( i+6 )
140 50 CONTINUE
141 RETURN
142*
143* End of ICOPY
144*

◆ ilaenv()

integer function ilaenv ( integer ispec,
character*( * ) name,
character*( * ) opts,
integer n1,
integer n2,
integer n3,
integer n4 )

ILAENV

Purpose:
!>
!> ILAENV returns problem-dependent parameters for the local
!> environment.  See ISPEC for a description of the parameters.
!>
!> In this version, the problem-dependent parameters are contained in
!> the integer array IPARMS in the common block CLAENV and the value
!> with index ISPEC is copied to ILAENV.  This version of ILAENV is
!> to be used in conjunction with XLAENV in TESTING and TIMING.
!>
Parameters
[in]ISPEC
!>          ISPEC is INTEGER
!>          Specifies the parameter to be returned as the value of
!>          ILAENV.
!>          = 1: the optimal blocksize; if this value is 1, an unblocked
!>               algorithm will give the best performance.
!>          = 2: the minimum block size for which the block routine
!>               should be used; if the usable block size is less than
!>               this value, an unblocked routine should be used.
!>          = 3: the crossover point (in a block routine, for N less
!>               than this value, an unblocked routine should be used)
!>          = 4: the number of shifts, used in the nonsymmetric
!>               eigenvalue routines
!>          = 5: the minimum column dimension for blocking to be used;
!>               rectangular blocks must have dimension at least k by m,
!>               where k is given by ILAENV(2,...) and m by ILAENV(5,...)
!>          = 6: the crossover point for the SVD (when reducing an m by n
!>               matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
!>               this value, a QR factorization is used first to reduce
!>               the matrix to a triangular form.)
!>          = 7: the number of processors
!>          = 8: the crossover point for the multishift QR and QZ methods
!>               for nonsymmetric eigenvalue problems.
!>          = 9: maximum size of the subproblems at the bottom of the
!>               computation tree in the divide-and-conquer algorithm
!>          =10: ieee NaN arithmetic can be trusted not to trap
!>          =11: infinity arithmetic can be trusted not to trap
!>
!>          Other specifications (up to 100) can be added later.
!>
[in]NAME
!>          NAME is CHARACTER*(*)
!>          The name of the calling subroutine.
!>
[in]OPTS
!>          OPTS is CHARACTER*(*)
!>          The character options to the subroutine NAME, concatenated
!>          into a single character string.  For example, UPLO = 'U',
!>          TRANS = 'T', and DIAG = 'N' for a triangular routine would
!>          be specified as OPTS = 'UTN'.
!>
[in]N1
!>          N1 is INTEGER
!>
[in]N2
!>          N2 is INTEGER
!>
[in]N3
!>          N3 is INTEGER
!>
[in]N4
!>          N4 is INTEGER
!>
!>          Problem dimensions for the subroutine NAME; these may not all
!>          be required.
!>
Returns
ILAENV 
!>          ILAENV is INTEGER
!>          >= 0: the value of the parameter specified by ISPEC
!>          < 0:  if ILAENV = -k, the k-th argument had an illegal value.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  The following conventions have been used when calling ILAENV from the
!>  LAPACK routines:
!>  1)  OPTS is a concatenation of all of the character options to
!>      subroutine NAME, in the same order that they appear in the
!>      argument list for NAME, even if they are not used in determining
!>      the value of the parameter specified by ISPEC.
!>  2)  The problem dimensions N1, N2, N3, N4 are specified in the order
!>      that they appear in the argument list for NAME.  N1 is used
!>      first, N2 second, and so on, and unused problem dimensions are
!>      passed a value of -1.
!>  3)  The parameter value returned by ILAENV is checked for validity in
!>      the calling subroutine.  For example, ILAENV is used to retrieve
!>      the optimal blocksize for STRTRI as follows:
!>
!>      NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
!>      IF( NB.LE.1 ) NB = MAX( 1, N )
!>

Definition at line 148 of file ilaenv.f.

150*
151* -- LAPACK test routine --
152* -- LAPACK is a software package provided by Univ. of Tennessee, --
153* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
154*
155* .. Scalar Arguments ..
156 CHARACTER*( * ) NAME, OPTS
157 INTEGER ISPEC, N1, N2, N3, N4
158* ..
159*
160* =====================================================================
161*
162* .. Intrinsic Functions ..
163 INTRINSIC int, min, real
164* ..
165* .. External Functions ..
166 INTEGER IEEECK
167 EXTERNAL ieeeck
168* ..
169* .. Arrays in Common ..
170 INTEGER IPARMS( 100 )
171* ..
172* .. Common blocks ..
173 COMMON / claenv / iparms
174* ..
175* .. Save statement ..
176 SAVE / claenv /
177* ..
178* .. Executable Statements ..
179*
180 IF( ispec.GE.1 .AND. ispec.LE.5 ) THEN
181*
182* Return a value from the common block.
183*
184 IF ( name(2:6).EQ.'GEQR ' ) THEN
185 IF (n3.EQ.2) THEN
186 ilaenv = iparms( 2 )
187 ELSE
188 ilaenv = iparms( 1 )
189 END IF
190 ELSE IF ( name(2:6).EQ.'GELQ ' ) THEN
191 IF (n3.EQ.2) THEN
192 ilaenv = iparms( 2 )
193 ELSE
194 ilaenv = iparms( 1 )
195 END IF
196 ELSE
197 ilaenv = iparms( ispec )
198 END IF
199*
200 ELSE IF( ispec.EQ.6 ) THEN
201*
202* Compute SVD crossover point.
203*
204 ilaenv = int( real( min( n1, n2 ) )*1.6e0 )
205*
206 ELSE IF( ispec.GE.7 .AND. ispec.LE.9 ) THEN
207*
208* Return a value from the common block.
209*
210 ilaenv = iparms( ispec )
211*
212 ELSE IF( ispec.EQ.10 ) THEN
213*
214* IEEE NaN arithmetic can be trusted not to trap
215*
216C ILAENV = 0
217 ilaenv = 1
218 IF( ilaenv.EQ.1 ) THEN
219 ilaenv = ieeeck( 1, 0.0, 1.0 )
220 END IF
221*
222 ELSE IF( ispec.EQ.11 ) THEN
223*
224* Infinity arithmetic can be trusted not to trap
225*
226C ILAENV = 0
227 ilaenv = 1
228 IF( ilaenv.EQ.1 ) THEN
229 ilaenv = ieeeck( 0, 0.0, 1.0 )
230 END IF
231*
232 ELSE
233*
234* Invalid value for ISPEC
235*
236 ilaenv = -1
237 END IF
238*
239 RETURN
240*
241* End of ILAENV
242*
ieeeck
integer function ieeeck(ispec, zero, one)
IEEECK
Definition ieeeck.f:82
ilaenv
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:150
min
#define min(a, b)
Definition macros.h:20

◆ xlaenv()

subroutine xlaenv ( integer ispec,
integer nvalue )

XLAENV

Purpose:
!>
!> XLAENV sets certain machine- and problem-dependent quantities
!> which will later be retrieved by ILAENV.
!>
Parameters
[in]ISPEC
!>          ISPEC is INTEGER
!>          Specifies the parameter to be set in the COMMON array IPARMS.
!>          = 1: the optimal blocksize; if this value is 1, an unblocked
!>               algorithm will give the best performance.
!>          = 2: the minimum block size for which the block routine
!>               should be used; if the usable block size is less than
!>               this value, an unblocked routine should be used.
!>          = 3: the crossover point (in a block routine, for N less
!>               than this value, an unblocked routine should be used)
!>          = 4: the number of shifts, used in the nonsymmetric
!>               eigenvalue routines
!>          = 5: the minimum column dimension for blocking to be used;
!>               rectangular blocks must have dimension at least k by m,
!>               where k is given by ILAENV(2,...) and m by ILAENV(5,...)
!>          = 6: the crossover point for the SVD (when reducing an m by n
!>               matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
!>               this value, a QR factorization is used first to reduce
!>               the matrix to a triangular form)
!>          = 7: the number of processors
!>          = 8: another crossover point, for the multishift QR and QZ
!>               methods for nonsymmetric eigenvalue problems.
!>          = 9: maximum size of the subproblems at the bottom of the
!>               computation tree in the divide-and-conquer algorithm
!>               (used by xGELSD and xGESDD)
!>          =10: ieee NaN arithmetic can be trusted not to trap
!>          =11: infinity arithmetic can be trusted not to trap
!>
[in]NVALUE
!>          NVALUE is INTEGER
!>          The value of the parameter specified by ISPEC.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 77 of file xlaenv.f.

78*
79* -- LAPACK test routine --
80* -- LAPACK is a software package provided by Univ. of Tennessee, --
81* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
82*
83* .. Scalar Arguments ..
84 INTEGER ISPEC, NVALUE
85* ..
86*
87* =====================================================================
88*
89* .. Arrays in Common ..
90 INTEGER IPARMS( 100 )
91* ..
92* .. Common blocks ..
93 COMMON / claenv / iparms
94* ..
95* .. Save statement ..
96 SAVE / claenv /
97* ..
98* .. Executable Statements ..
99*
100 IF( ispec.GE.1 .AND. ispec.LE.9 ) THEN
101 iparms( ispec ) = nvalue
102 END IF
103*
104 RETURN
105*
106* End of XLAENV
107*