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