LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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 *> _SP: Symmetric indefinite packed
52 *> _HE: (complex) Hermitian indefinite
53 *> _HP: (complex) Hermitian indefinite packed
54 *> The first character must be one of S, D, C, or Z (C or Z only
55 *> if complex).
56 *> \endverbatim
57 *
58 * Authors:
59 * ========
60 *
61 *> \author Univ. of Tennessee
62 *> \author Univ. of California Berkeley
63 *> \author Univ. of Colorado Denver
64 *> \author NAG Ltd.
65 *
66 *> \date April 2012
67 *
68 *> \ingroup aux_lin
69 *
70 * =====================================================================
71  SUBROUTINE aladhd( IOUNIT, PATH )
72 *
73 * -- LAPACK test routine (version 3.4.1) --
74 * -- LAPACK is a software package provided by Univ. of Tennessee, --
75 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
76 * April 2012
77 *
78 * .. Scalar Arguments ..
79  CHARACTER*3 path
80  INTEGER iounit
81 * ..
82 *
83 * =====================================================================
84 *
85 * .. Local Scalars ..
86  LOGICAL corz, sord
87  CHARACTER c1, c3
88  CHARACTER*2 p2
89  CHARACTER*9 sym
90 * ..
91 * .. External Functions ..
92  LOGICAL lsame, lsamen
93  EXTERNAL lsame, lsamen
94 * ..
95 * .. Executable Statements ..
96 *
97  IF( iounit.LE.0 )
98  $ return
99  c1 = path( 1: 1 )
100  c3 = path( 3: 3 )
101  p2 = path( 2: 3 )
102  sord = lsame( c1, 'S' ) .OR. lsame( c1, 'D' )
103  corz = lsame( c1, 'C' ) .OR. lsame( c1, 'Z' )
104  IF( .NOT.( sord .OR. corz ) )
105  $ return
106 *
107  IF( lsamen( 2, p2, 'GE' ) ) THEN
108 *
109 * GE: General dense
110 *
111  WRITE( iounit, fmt = 9999 )path
112  WRITE( iounit, fmt = '( '' Matrix types:'' )' )
113  WRITE( iounit, fmt = 9989 )
114  WRITE( iounit, fmt = '( '' Test ratios:'' )' )
115  WRITE( iounit, fmt = 9981 )1
116  WRITE( iounit, fmt = 9980 )2
117  WRITE( iounit, fmt = 9979 )3
118  WRITE( iounit, fmt = 9978 )4
119  WRITE( iounit, fmt = 9977 )5
120  WRITE( iounit, fmt = 9976 )6
121  WRITE( iounit, fmt = 9972 )7
122  WRITE( iounit, fmt = '( '' Messages:'' )' )
123 *
124  ELSE IF( lsamen( 2, p2, 'GB' ) ) THEN
125 *
126 * GB: General band
127 *
128  WRITE( iounit, fmt = 9998 )path
129  WRITE( iounit, fmt = '( '' Matrix types:'' )' )
130  WRITE( iounit, fmt = 9988 )
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, 'GT' ) ) THEN
142 *
143 * GT: General tridiagonal
144 *
145  WRITE( iounit, fmt = 9997 )path
146  WRITE( iounit, fmt = 9987 )
147  WRITE( iounit, fmt = '( '' Test ratios:'' )' )
148  WRITE( iounit, fmt = 9981 )1
149  WRITE( iounit, fmt = 9980 )2
150  WRITE( iounit, fmt = 9979 )3
151  WRITE( iounit, fmt = 9978 )4
152  WRITE( iounit, fmt = 9977 )5
153  WRITE( iounit, fmt = 9976 )6
154  WRITE( iounit, fmt = '( '' Messages:'' )' )
155 *
156  ELSE IF( lsamen( 2, p2, 'PO' ) .OR. lsamen( 2, p2, 'PP' )
157  $ .OR. lsamen( 2, p2, 'PS' ) ) THEN
158 *
159 * PO: Positive definite full
160 * PS: Positive definite full
161 * PP: Positive definite packed
162 *
163  IF( sord ) THEN
164  sym = 'Symmetric'
165  ELSE
166  sym = 'Hermitian'
167  END IF
168  IF( lsame( c3, 'O' ) ) THEN
169  WRITE( iounit, fmt = 9996 )path, sym
170  ELSE
171  WRITE( iounit, fmt = 9995 )path, sym
172  END IF
173  WRITE( iounit, fmt = '( '' Matrix types:'' )' )
174  WRITE( iounit, fmt = 9985 )path
175  WRITE( iounit, fmt = '( '' Test ratios:'' )' )
176  WRITE( iounit, fmt = 9975 )1
177  WRITE( iounit, fmt = 9980 )2
178  WRITE( iounit, fmt = 9979 )3
179  WRITE( iounit, fmt = 9978 )4
180  WRITE( iounit, fmt = 9977 )5
181  WRITE( iounit, fmt = 9976 )6
182  WRITE( iounit, fmt = '( '' Messages:'' )' )
183 *
184  ELSE IF( lsamen( 2, p2, 'PB' ) ) THEN
185 *
186 * PB: Positive definite band
187 *
188  IF( sord ) THEN
189  WRITE( iounit, fmt = 9994 )path, 'Symmetric'
190  ELSE
191  WRITE( iounit, fmt = 9994 )path, 'Hermitian'
192  END IF
193  WRITE( iounit, fmt = '( '' Matrix types:'' )' )
194  WRITE( iounit, fmt = 9984 )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, 'PT' ) ) THEN
205 *
206 * PT: Positive definite tridiagonal
207 *
208  IF( sord ) THEN
209  WRITE( iounit, fmt = 9993 )path, 'Symmetric'
210  ELSE
211  WRITE( iounit, fmt = 9993 )path, 'Hermitian'
212  END IF
213  WRITE( iounit, fmt = 9986 )
214  WRITE( iounit, fmt = '( '' Test ratios:'' )' )
215  WRITE( iounit, fmt = 9973 )1
216  WRITE( iounit, fmt = 9980 )2
217  WRITE( iounit, fmt = 9979 )3
218  WRITE( iounit, fmt = 9978 )4
219  WRITE( iounit, fmt = 9977 )5
220  WRITE( iounit, fmt = 9976 )6
221  WRITE( iounit, fmt = '( '' Messages:'' )' )
222 *
223  ELSE IF( lsamen( 2, p2, 'SY' ) .OR. lsamen( 2, p2, 'SP' ) ) THEN
224 *
225 * SY: Symmetric indefinite full
226 * SP: Symmetric indefinite packed
227 *
228  IF( lsame( c3, 'Y' ) ) THEN
229  WRITE( iounit, fmt = 9992 )path, 'Symmetric'
230  ELSE
231  WRITE( iounit, fmt = 9991 )path, 'Symmetric'
232  END IF
233  WRITE( iounit, fmt = '( '' Matrix types:'' )' )
234  IF( sord ) THEN
235  WRITE( iounit, fmt = 9983 )
236  ELSE
237  WRITE( iounit, fmt = 9982 )
238  END IF
239  WRITE( iounit, fmt = '( '' Test ratios:'' )' )
240  WRITE( iounit, fmt = 9974 )1
241  WRITE( iounit, fmt = 9980 )2
242  WRITE( iounit, fmt = 9979 )3
243  WRITE( iounit, fmt = 9977 )4
244  WRITE( iounit, fmt = 9978 )5
245  WRITE( iounit, fmt = 9976 )6
246  WRITE( iounit, fmt = '( '' Messages:'' )' )
247 *
248  ELSE IF( lsamen( 2, p2, 'HE' ) .OR. lsamen( 2, p2, 'HP' ) ) THEN
249 *
250 * HE: Hermitian indefinite full
251 * HP: Hermitian indefinite packed
252 *
253  IF( lsame( c3, 'E' ) ) THEN
254  WRITE( iounit, fmt = 9992 )path, 'Hermitian'
255  ELSE
256  WRITE( iounit, fmt = 9991 )path, 'Hermitian'
257  END IF
258  WRITE( iounit, fmt = '( '' Matrix types:'' )' )
259  WRITE( iounit, fmt = 9983 )
260  WRITE( iounit, fmt = '( '' Test ratios:'' )' )
261  WRITE( iounit, fmt = 9974 )1
262  WRITE( iounit, fmt = 9980 )2
263  WRITE( iounit, fmt = 9979 )3
264  WRITE( iounit, fmt = 9977 )4
265  WRITE( iounit, fmt = 9978 )5
266  WRITE( iounit, fmt = 9976 )6
267  WRITE( iounit, fmt = '( '' Messages:'' )' )
268 *
269  ELSE
270 *
271 * Print error message if no header is available.
272 *
273  WRITE( iounit, fmt = 9990 )path
274  END IF
275 *
276 * First line of header
277 *
278  9999 format( / 1x, a3, ' drivers: General dense matrices' )
279  9998 format( / 1x, a3, ' drivers: General band matrices' )
280  9997 format( / 1x, a3, ' drivers: General tridiagonal' )
281  9996 format( / 1x, a3, ' drivers: ', a9,
282  $ ' positive definite matrices' )
283  9995 format( / 1x, a3, ' drivers: ', a9,
284  $ ' positive definite packed matrices' )
285  9994 format( / 1x, a3, ' drivers: ', a9,
286  $ ' positive definite band matrices' )
287  9993 format( / 1x, a3, ' drivers: ', a9,
288  $ ' positive definite tridiagonal' )
289  9992 format( / 1x, a3, ' drivers: ', a9, ' indefinite matrices' )
290  9991 format( / 1x, a3, ' drivers: ', a9,
291  $ ' indefinite packed matrices',
292  $ ', partial (Bunch-Kaufman) pivoting' )
293  9990 format( / 1x, a3, ': No header available' )
294 *
295 * GE matrix types
296 *
297  9989 format( 4x, '1. Diagonal', 24x, '7. Last n/2 columns zero', / 4x,
298  $ '2. Upper triangular', 16x,
299  $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
300  $ '3. Lower triangular', 16x, '9. Random, CNDNUM = 0.1/EPS',
301  $ / 4x, '4. Random, CNDNUM = 2', 13x,
302  $ '10. Scaled near underflow', / 4x, '5. First column zero',
303  $ 14x, '11. Scaled near overflow', / 4x,
304  $ '6. Last column zero' )
305 *
306 * GB matrix types
307 *
308  9988 format( 4x, '1. Random, CNDNUM = 2', 14x,
309  $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
310  $ '2. First column zero', 15x, '6. Random, CNDNUM = 0.1/EPS',
311  $ / 4x, '3. Last column zero', 16x,
312  $ '7. Scaled near underflow', / 4x,
313  $ '4. Last n/2 columns zero', 11x, '8. Scaled near overflow' )
314 *
315 * GT matrix types
316 *
317  9987 format( ' Matrix types (1-6 have specified condition numbers):',
318  $ / 4x, '1. Diagonal', 24x, '7. Random, unspecified CNDNUM',
319  $ / 4x, '2. Random, CNDNUM = 2', 14x, '8. First column zero',
320  $ / 4x, '3. Random, CNDNUM = sqrt(0.1/EPS)', 2x,
321  $ '9. Last column zero', / 4x, '4. Random, CNDNUM = 0.1/EPS',
322  $ 7x, '10. Last n/2 columns zero', / 4x,
323  $ '5. Scaled near underflow', 10x,
324  $ '11. Scaled near underflow', / 4x,
325  $ '6. Scaled near overflow', 11x, '12. Scaled near overflow' )
326 *
327 * PT matrix types
328 *
329  9986 format( ' Matrix types (1-6 have specified condition numbers):',
330  $ / 4x, '1. Diagonal', 24x, '7. Random, unspecified CNDNUM',
331  $ / 4x, '2. Random, CNDNUM = 2', 14x,
332  $ '8. First row and column zero', / 4x,
333  $ '3. Random, CNDNUM = sqrt(0.1/EPS)', 2x,
334  $ '9. Last row and column zero', / 4x,
335  $ '4. Random, CNDNUM = 0.1/EPS', 7x,
336  $ '10. Middle row and column zero', / 4x,
337  $ '5. Scaled near underflow', 10x,
338  $ '11. Scaled near underflow', / 4x,
339  $ '6. Scaled near overflow', 11x, '12. Scaled near overflow' )
340 *
341 * PO, PP matrix types
342 *
343  9985 format( 4x, '1. Diagonal', 24x,
344  $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
345  $ '2. Random, CNDNUM = 2', 14x, '7. Random, CNDNUM = 0.1/EPS',
346  $ / 3x, '*3. First row and column zero', 7x,
347  $ '8. Scaled near underflow', / 3x,
348  $ '*4. Last row and column zero', 8x,
349  $ '9. Scaled near overflow', / 3x,
350  $ '*5. Middle row and column zero', / 3x,
351  $ '(* - tests error exits from ', a3,
352  $ 'TRF, no test ratios are computed)' )
353 *
354 * PB matrix types
355 *
356  9984 format( 4x, '1. Random, CNDNUM = 2', 14x,
357  $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 3x,
358  $ '*2. First row and column zero', 7x,
359  $ '6. Random, CNDNUM = 0.1/EPS', / 3x,
360  $ '*3. Last row and column zero', 8x,
361  $ '7. Scaled near underflow', / 3x,
362  $ '*4. Middle row and column zero', 6x,
363  $ '8. Scaled near overflow', / 3x,
364  $ '(* - tests error exits from ', a3,
365  $ 'TRF, no test ratios are computed)' )
366 *
367 * SSY, SSP, CHE, CHP matrix types
368 *
369  9983 format( 4x, '1. Diagonal', 24x,
370  $ '6. Last n/2 rows and columns zero', / 4x,
371  $ '2. Random, CNDNUM = 2', 14x,
372  $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
373  $ '3. First row and column zero', 7x,
374  $ '8. Random, CNDNUM = 0.1/EPS', / 4x,
375  $ '4. Last row and column zero', 8x,
376  $ '9. Scaled near underflow', / 4x,
377  $ '5. Middle row and column zero', 5x,
378  $ '10. Scaled near overflow' )
379 *
380 * CSY, CSP matrix types
381 *
382  9982 format( 4x, '1. Diagonal', 24x,
383  $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4x,
384  $ '2. Random, CNDNUM = 2', 14x, '8. Random, CNDNUM = 0.1/EPS',
385  $ / 4x, '3. First row and column zero', 7x,
386  $ '9. Scaled near underflow', / 4x,
387  $ '4. Last row and column zero', 7x,
388  $ '10. Scaled near overflow', / 4x,
389  $ '5. Middle row and column zero', 5x,
390  $ '11. Block diagonal matrix', / 4x,
391  $ '6. Last n/2 rows and columns zero' )
392 *
393 * Test ratios
394 *
395  9981 format( 3x, i2, ': norm( L * U - A ) / ( N * norm(A) * EPS )' )
396  9980 format( 3x, i2, ': norm( B - A * X ) / ',
397  $ '( norm(A) * norm(X) * EPS )' )
398  9979 format( 3x, i2, ': norm( X - XACT ) / ',
399  $ '( norm(XACT) * CNDNUM * EPS )' )
400  9978 format( 3x, i2, ': norm( X - XACT ) / ',
401  $ '( norm(XACT) * (error bound) )' )
402  9977 format( 3x, i2, ': (backward error) / EPS' )
403  9976 format( 3x, i2, ': RCOND * CNDNUM - 1.0' )
404  9975 format( 3x, i2, ': norm( U'' * U - A ) / ( N * norm(A) * EPS )',
405  $ ', or', / 7x, 'norm( L * L'' - A ) / ( N * norm(A) * EPS )'
406  $ )
407  9974 format( 3x, i2, ': norm( U*D*U'' - A ) / ( N * norm(A) * EPS )',
408  $ ', or', / 7x, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
409  $ )
410  9973 format( 3x, i2, ': norm( U''*D*U - A ) / ( N * norm(A) * EPS )',
411  $ ', or', / 7x, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
412  $ )
413  9972 format( 3x, i2, ': abs( WORK(1) - RPVGRW ) /',
414  $ ' ( max( WORK(1), RPVGRW ) * EPS )' )
415 *
416  return
417 *
418 * End of ALADHD
419 *
420  END