LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
dchkaa.f
Go to the documentation of this file.
1 *> \brief \b DCHKAA
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * PROGRAM DCHKAA
12 *
13 *
14 *> \par Purpose:
15 * =============
16 *>
17 *> \verbatim
18 *>
19 *> DCHKAA is the main test program for the DOUBLE PRECISION LAPACK
20 *> linear equation routines
21 *>
22 *> The program must be driven by a short data file. The first 15 records
23 *> (not including the first comment line) specify problem dimensions
24 *> and program options using list-directed input. The remaining lines
25 *> specify the LAPACK test paths and the number of matrix types to use
26 *> in testing. An annotated example of a data file can be obtained by
27 *> deleting the first 3 characters from the following 40 lines:
28 *> Data file for testing DOUBLE PRECISION LAPACK linear eqn. routines
29 *> 7 Number of values of M
30 *> 0 1 2 3 5 10 16 Values of M (row dimension)
31 *> 7 Number of values of N
32 *> 0 1 2 3 5 10 16 Values of N (column dimension)
33 *> 1 Number of values of NRHS
34 *> 2 Values of NRHS (number of right hand sides)
35 *> 5 Number of values of NB
36 *> 1 3 3 3 20 Values of NB (the blocksize)
37 *> 1 0 5 9 1 Values of NX (crossover point)
38 *> 3 Number of values of RANK
39 *> 30 50 90 Values of rank (as a % of N)
40 *> 20.0 Threshold value of test ratio
41 *> T Put T to test the LAPACK routines
42 *> T Put T to test the driver routines
43 *> T Put T to test the error exits
44 *> DGE 11 List types on next line if 0 < NTYPES < 11
45 *> DGB 8 List types on next line if 0 < NTYPES < 8
46 *> DGT 12 List types on next line if 0 < NTYPES < 12
47 *> DPO 9 List types on next line if 0 < NTYPES < 9
48 *> DPS 9 List types on next line if 0 < NTYPES < 9
49 *> DPP 9 List types on next line if 0 < NTYPES < 9
50 *> DPB 8 List types on next line if 0 < NTYPES < 8
51 *> DPT 12 List types on next line if 0 < NTYPES < 12
52 *> DSY 10 List types on next line if 0 < NTYPES < 10
53 *> DSR 10 List types on next line if 0 < NTYPES < 10
54 *> DSP 10 List types on next line if 0 < NTYPES < 10
55 *> DTR 18 List types on next line if 0 < NTYPES < 18
56 *> DTP 18 List types on next line if 0 < NTYPES < 18
57 *> DTB 17 List types on next line if 0 < NTYPES < 17
58 *> DQR 8 List types on next line if 0 < NTYPES < 8
59 *> DRQ 8 List types on next line if 0 < NTYPES < 8
60 *> DLQ 8 List types on next line if 0 < NTYPES < 8
61 *> DQL 8 List types on next line if 0 < NTYPES < 8
62 *> DQP 6 List types on next line if 0 < NTYPES < 6
63 *> DTZ 3 List types on next line if 0 < NTYPES < 3
64 *> DLS 6 List types on next line if 0 < NTYPES < 6
65 *> DEQ
66 *> DQT
67 *> DQX
68 *> \endverbatim
69 *
70 * Parameters:
71 * ==========
72 *
73 *> \verbatim
74 *> NMAX INTEGER
75 *> The maximum allowable value for M and N.
76 *>
77 *> MAXIN INTEGER
78 *> The number of different values that can be used for each of
79 *> M, N, NRHS, NB, NX and RANK
80 *>
81 *> MAXRHS INTEGER
82 *> The maximum number of right hand sides
83 *>
84 *> MATMAX INTEGER
85 *> The maximum number of matrix types to use for testing
86 *>
87 *> NIN INTEGER
88 *> The unit number for input
89 *>
90 *> NOUT INTEGER
91 *> The unit number for output
92 *> \endverbatim
93 *
94 * Authors:
95 * ========
96 *
97 *> \author Univ. of Tennessee
98 *> \author Univ. of California Berkeley
99 *> \author Univ. of Colorado Denver
100 *> \author NAG Ltd.
101 *
102 *> \date April 2012
103 *
104 *> \ingroup double_lin
105 *
106 * =====================================================================
107  PROGRAM dchkaa
108 *
109 * -- LAPACK test routine (version 3.4.1) --
110 * -- LAPACK is a software package provided by Univ. of Tennessee, --
111 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
112 * April 2012
113 *
114 * =====================================================================
115 *
116 * .. Parameters ..
117  INTEGER nmax
118  parameter( nmax = 132 )
119  INTEGER maxin
120  parameter( maxin = 12 )
121  INTEGER maxrhs
122  parameter( maxrhs = 16 )
123  INTEGER matmax
124  parameter( matmax = 30 )
125  INTEGER nin, nout
126  parameter( nin = 5, nout = 6 )
127  INTEGER kdmax
128  parameter( kdmax = nmax+( nmax+1 ) / 4 )
129 * ..
130 * .. Local Scalars ..
131  LOGICAL fatal, tstchk, tstdrv, tsterr
132  CHARACTER c1
133  CHARACTER*2 c2
134  CHARACTER*3 path
135  CHARACTER*10 intstr
136  CHARACTER*72 aline
137  INTEGER i, ic, j, k, la, lafac, lda, nb, nm, nmats, nn,
138  $ nnb, nnb2, nns, nrhs, ntypes, nrank,
139  $ vers_major, vers_minor, vers_patch
140  DOUBLE PRECISION eps, s1, s2, threq, thresh
141 * ..
142 * .. Local Arrays ..
143  LOGICAL dotype( matmax )
144  INTEGER iwork( 25*nmax ), mval( maxin ),
145  $ nbval( maxin ), nbval2( maxin ),
146  $ nsval( maxin ), nval( maxin ), nxval( maxin ),
147  $ rankval( maxin ), piv( nmax )
148  DOUBLE PRECISION a( ( kdmax+1 )*nmax, 7 ), b( nmax*maxrhs, 4 ),
149  $ rwork( 5*nmax+2*maxrhs ), s( 2*nmax ),
150  $ work( nmax, nmax+maxrhs+30 )
151 * ..
152 * .. External Functions ..
153  LOGICAL lsame, lsamen
154  DOUBLE PRECISION dlamch, dsecnd
155  EXTERNAL lsame, lsamen, dlamch, dsecnd
156 * ..
157 * .. External Subroutines ..
158  EXTERNAL alareq, dchkeq, dchkgb, dchkge, dchkgt, dchklq,
159  $ dchkpb, dchkpo, dchkps, dchkpp, dchkpt, dchkq3,
160  $ dchkql, dchkqp, dchkqr, dchkrq, dchksp, dchksy,
161  $ dchktb, dchktp, dchktr, dchktz,
162  $ ddrvgb, ddrvge, ddrvgt, ddrvls, ddrvpb, ddrvpo,
163  $ ddrvpp, ddrvpt, ddrvsp, ddrvsy,
164  $ ilaver, dchkqrt, dchkqrtp
165 * ..
166 * .. Scalars in Common ..
167  LOGICAL lerr, ok
168  CHARACTER*32 srnamt
169  INTEGER infot, nunit
170 * ..
171 * .. Arrays in Common ..
172  INTEGER iparms( 100 )
173 * ..
174 * .. Common blocks ..
175  common / infoc / infot, nunit, ok, lerr
176  common / srnamc / srnamt
177  common / claenv / iparms
178 * ..
179 * .. Data statements ..
180  DATA threq / 2.0d0 / , intstr / '0123456789' /
181 * ..
182 * .. Executable Statements ..
183 *
184  s1 = dsecnd( )
185  lda = nmax
186  fatal = .false.
187 *
188 * Read a dummy line.
189 *
190  READ( nin, fmt = * )
191 *
192 * Report values of parameters.
193 *
194  CALL ilaver( vers_major, vers_minor, vers_patch )
195  WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
196 *
197 * Read the values of M
198 *
199  READ( nin, fmt = * )nm
200  IF( nm.LT.1 ) THEN
201  WRITE( nout, fmt = 9996 )' NM ', nm, 1
202  nm = 0
203  fatal = .true.
204  ELSE IF( nm.GT.maxin ) THEN
205  WRITE( nout, fmt = 9995 )' NM ', nm, maxin
206  nm = 0
207  fatal = .true.
208  END IF
209  READ( nin, fmt = * )( mval( i ), i = 1, nm )
210  DO 10 i = 1, nm
211  IF( mval( i ).LT.0 ) THEN
212  WRITE( nout, fmt = 9996 )' M ', mval( i ), 0
213  fatal = .true.
214  ELSE IF( mval( i ).GT.nmax ) THEN
215  WRITE( nout, fmt = 9995 )' M ', mval( i ), nmax
216  fatal = .true.
217  END IF
218  10 continue
219  IF( nm.GT.0 )
220  $ WRITE( nout, fmt = 9993 )'M ', ( mval( i ), i = 1, nm )
221 *
222 * Read the values of N
223 *
224  READ( nin, fmt = * )nn
225  IF( nn.LT.1 ) THEN
226  WRITE( nout, fmt = 9996 )' NN ', nn, 1
227  nn = 0
228  fatal = .true.
229  ELSE IF( nn.GT.maxin ) THEN
230  WRITE( nout, fmt = 9995 )' NN ', nn, maxin
231  nn = 0
232  fatal = .true.
233  END IF
234  READ( nin, fmt = * )( nval( i ), i = 1, nn )
235  DO 20 i = 1, nn
236  IF( nval( i ).LT.0 ) THEN
237  WRITE( nout, fmt = 9996 )' N ', nval( i ), 0
238  fatal = .true.
239  ELSE IF( nval( i ).GT.nmax ) THEN
240  WRITE( nout, fmt = 9995 )' N ', nval( i ), nmax
241  fatal = .true.
242  END IF
243  20 continue
244  IF( nn.GT.0 )
245  $ WRITE( nout, fmt = 9993 )'N ', ( nval( i ), i = 1, nn )
246 *
247 * Read the values of NRHS
248 *
249  READ( nin, fmt = * )nns
250  IF( nns.LT.1 ) THEN
251  WRITE( nout, fmt = 9996 )' NNS', nns, 1
252  nns = 0
253  fatal = .true.
254  ELSE IF( nns.GT.maxin ) THEN
255  WRITE( nout, fmt = 9995 )' NNS', nns, maxin
256  nns = 0
257  fatal = .true.
258  END IF
259  READ( nin, fmt = * )( nsval( i ), i = 1, nns )
260  DO 30 i = 1, nns
261  IF( nsval( i ).LT.0 ) THEN
262  WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
263  fatal = .true.
264  ELSE IF( nsval( i ).GT.maxrhs ) THEN
265  WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
266  fatal = .true.
267  END IF
268  30 continue
269  IF( nns.GT.0 )
270  $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
271 *
272 * Read the values of NB
273 *
274  READ( nin, fmt = * )nnb
275  IF( nnb.LT.1 ) THEN
276  WRITE( nout, fmt = 9996 )'NNB ', nnb, 1
277  nnb = 0
278  fatal = .true.
279  ELSE IF( nnb.GT.maxin ) THEN
280  WRITE( nout, fmt = 9995 )'NNB ', nnb, maxin
281  nnb = 0
282  fatal = .true.
283  END IF
284  READ( nin, fmt = * )( nbval( i ), i = 1, nnb )
285  DO 40 i = 1, nnb
286  IF( nbval( i ).LT.0 ) THEN
287  WRITE( nout, fmt = 9996 )' NB ', nbval( i ), 0
288  fatal = .true.
289  END IF
290  40 continue
291  IF( nnb.GT.0 )
292  $ WRITE( nout, fmt = 9993 )'NB ', ( nbval( i ), i = 1, nnb )
293 *
294 * Set NBVAL2 to be the set of unique values of NB
295 *
296  nnb2 = 0
297  DO 60 i = 1, nnb
298  nb = nbval( i )
299  DO 50 j = 1, nnb2
300  IF( nb.EQ.nbval2( j ) )
301  $ go to 60
302  50 continue
303  nnb2 = nnb2 + 1
304  nbval2( nnb2 ) = nb
305  60 continue
306 *
307 * Read the values of NX
308 *
309  READ( nin, fmt = * )( nxval( i ), i = 1, nnb )
310  DO 70 i = 1, nnb
311  IF( nxval( i ).LT.0 ) THEN
312  WRITE( nout, fmt = 9996 )' NX ', nxval( i ), 0
313  fatal = .true.
314  END IF
315  70 continue
316  IF( nnb.GT.0 )
317  $ WRITE( nout, fmt = 9993 )'NX ', ( nxval( i ), i = 1, nnb )
318 *
319 * Read the values of RANKVAL
320 *
321  READ( nin, fmt = * )nrank
322  IF( nn.LT.1 ) THEN
323  WRITE( nout, fmt = 9996 )' NRANK ', nrank, 1
324  nrank = 0
325  fatal = .true.
326  ELSE IF( nn.GT.maxin ) THEN
327  WRITE( nout, fmt = 9995 )' NRANK ', nrank, maxin
328  nrank = 0
329  fatal = .true.
330  END IF
331  READ( nin, fmt = * )( rankval( i ), i = 1, nrank )
332  DO i = 1, nrank
333  IF( rankval( i ).LT.0 ) THEN
334  WRITE( nout, fmt = 9996 )' RANK ', rankval( i ), 0
335  fatal = .true.
336  ELSE IF( rankval( i ).GT.100 ) THEN
337  WRITE( nout, fmt = 9995 )' RANK ', rankval( i ), 100
338  fatal = .true.
339  END IF
340  END DO
341  IF( nrank.GT.0 )
342  $ WRITE( nout, fmt = 9993 )'RANK % OF N',
343  $ ( rankval( i ), i = 1, nrank )
344 *
345 * Read the threshold value for the test ratios.
346 *
347  READ( nin, fmt = * )thresh
348  WRITE( nout, fmt = 9992 )thresh
349 *
350 * Read the flag that indicates whether to test the LAPACK routines.
351 *
352  READ( nin, fmt = * )tstchk
353 *
354 * Read the flag that indicates whether to test the driver routines.
355 *
356  READ( nin, fmt = * )tstdrv
357 *
358 * Read the flag that indicates whether to test the error exits.
359 *
360  READ( nin, fmt = * )tsterr
361 *
362  IF( fatal ) THEN
363  WRITE( nout, fmt = 9999 )
364  stop
365  END IF
366 *
367 * Calculate and print the machine dependent constants.
368 *
369  eps = dlamch( 'Underflow threshold' )
370  WRITE( nout, fmt = 9991 )'underflow', eps
371  eps = dlamch( 'Overflow threshold' )
372  WRITE( nout, fmt = 9991 )'overflow ', eps
373  eps = dlamch( 'Epsilon' )
374  WRITE( nout, fmt = 9991 )'precision', eps
375  WRITE( nout, fmt = * )
376 *
377  80 continue
378 *
379 * Read a test path and the number of matrix types to use.
380 *
381  READ( nin, fmt = '(A72)', END = 140 )aline
382  path = aline( 1: 3 )
383  nmats = matmax
384  i = 3
385  90 continue
386  i = i + 1
387  IF( i.GT.72 ) THEN
388  nmats = matmax
389  go to 130
390  END IF
391  IF( aline( i: i ).EQ.' ' )
392  $ go to 90
393  nmats = 0
394  100 continue
395  c1 = aline( i: i )
396  DO 110 k = 1, 10
397  IF( c1.EQ.intstr( k: k ) ) THEN
398  ic = k - 1
399  go to 120
400  END IF
401  110 continue
402  go to 130
403  120 continue
404  nmats = nmats*10 + ic
405  i = i + 1
406  IF( i.GT.72 )
407  $ go to 130
408  go to 100
409  130 continue
410  c1 = path( 1: 1 )
411  c2 = path( 2: 3 )
412  nrhs = nsval( 1 )
413 *
414 * Check first character for correct precision.
415 *
416  IF( .NOT.lsame( c1, 'Double precision' ) ) THEN
417  WRITE( nout, fmt = 9990 )path
418 *
419  ELSE IF( nmats.LE.0 ) THEN
420 *
421 * Check for a positive number of tests requested.
422 *
423  WRITE( nout, fmt = 9989 )path
424 *
425  ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
426 *
427 * GE: general matrices
428 *
429  ntypes = 11
430  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
431 *
432  IF( tstchk ) THEN
433  CALL dchkge( dotype, nm, mval, nn, nval, nnb2, nbval2, nns,
434  $ nsval, thresh, tsterr, lda, a( 1, 1 ),
435  $ a( 1, 2 ), a( 1, 3 ), b( 1, 1 ), b( 1, 2 ),
436  $ b( 1, 3 ), work, rwork, iwork, nout )
437  ELSE
438  WRITE( nout, fmt = 9989 )path
439  END IF
440 *
441  IF( tstdrv ) THEN
442  CALL ddrvge( dotype, nn, nval, nrhs, thresh, tsterr, lda,
443  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
444  $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
445  $ rwork, iwork, nout )
446  ELSE
447  WRITE( nout, fmt = 9988 )path
448  END IF
449 *
450  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
451 *
452 * GB: general banded matrices
453 *
454  la = ( 2*kdmax+1 )*nmax
455  lafac = ( 3*kdmax+1 )*nmax
456  ntypes = 8
457  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
458 *
459  IF( tstchk ) THEN
460  CALL dchkgb( dotype, nm, mval, nn, nval, nnb2, nbval2, nns,
461  $ nsval, thresh, tsterr, a( 1, 1 ), la,
462  $ a( 1, 3 ), lafac, b( 1, 1 ), b( 1, 2 ),
463  $ b( 1, 3 ), work, rwork, iwork, nout )
464  ELSE
465  WRITE( nout, fmt = 9989 )path
466  END IF
467 *
468  IF( tstdrv ) THEN
469  CALL ddrvgb( dotype, nn, nval, nrhs, thresh, tsterr,
470  $ a( 1, 1 ), la, a( 1, 3 ), lafac, a( 1, 6 ),
471  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s,
472  $ work, rwork, iwork, nout )
473  ELSE
474  WRITE( nout, fmt = 9988 )path
475  END IF
476 *
477  ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
478 *
479 * GT: general tridiagonal matrices
480 *
481  ntypes = 12
482  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
483 *
484  IF( tstchk ) THEN
485  CALL dchkgt( dotype, nn, nval, nns, nsval, thresh, tsterr,
486  $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
487  $ b( 1, 3 ), work, rwork, iwork, nout )
488  ELSE
489  WRITE( nout, fmt = 9989 )path
490  END IF
491 *
492  IF( tstdrv ) THEN
493  CALL ddrvgt( dotype, nn, nval, nrhs, thresh, tsterr,
494  $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
495  $ b( 1, 3 ), work, rwork, iwork, nout )
496  ELSE
497  WRITE( nout, fmt = 9988 )path
498  END IF
499 *
500  ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
501 *
502 * PO: positive definite matrices
503 *
504  ntypes = 9
505  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
506 *
507  IF( tstchk ) THEN
508  CALL dchkpo( dotype, nn, nval, nnb2, nbval2, nns, nsval,
509  $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
510  $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
511  $ work, rwork, iwork, nout )
512  ELSE
513  WRITE( nout, fmt = 9989 )path
514  END IF
515 *
516  IF( tstdrv ) THEN
517  CALL ddrvpo( dotype, nn, nval, nrhs, thresh, tsterr, lda,
518  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
519  $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
520  $ rwork, iwork, nout )
521  ELSE
522  WRITE( nout, fmt = 9988 )path
523  END IF
524 *
525  ELSE IF( lsamen( 2, c2, 'PS' ) ) THEN
526 *
527 * PS: positive semi-definite matrices
528 *
529  ntypes = 9
530 *
531  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
532 *
533  IF( tstchk ) THEN
534  CALL dchkps( dotype, nn, nval, nnb2, nbval2, nrank,
535  $ rankval, thresh, tsterr, lda, a( 1, 1 ),
536  $ a( 1, 2 ), a( 1, 3 ), piv, work, rwork,
537  $ nout )
538  ELSE
539  WRITE( nout, fmt = 9989 )path
540  END IF
541 *
542  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
543 *
544 * PP: positive definite packed matrices
545 *
546  ntypes = 9
547  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
548 *
549  IF( tstchk ) THEN
550  CALL dchkpp( dotype, nn, nval, nns, nsval, thresh, tsterr,
551  $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
552  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
553  $ iwork, nout )
554  ELSE
555  WRITE( nout, fmt = 9989 )path
556  END IF
557 *
558  IF( tstdrv ) THEN
559  CALL ddrvpp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
560  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
561  $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
562  $ rwork, iwork, nout )
563  ELSE
564  WRITE( nout, fmt = 9988 )path
565  END IF
566 *
567  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
568 *
569 * PB: positive definite banded matrices
570 *
571  ntypes = 8
572  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
573 *
574  IF( tstchk ) THEN
575  CALL dchkpb( dotype, nn, nval, nnb2, nbval2, nns, nsval,
576  $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
577  $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
578  $ work, rwork, iwork, nout )
579  ELSE
580  WRITE( nout, fmt = 9989 )path
581  END IF
582 *
583  IF( tstdrv ) THEN
584  CALL ddrvpb( dotype, nn, nval, nrhs, thresh, tsterr, lda,
585  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
586  $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
587  $ rwork, iwork, nout )
588  ELSE
589  WRITE( nout, fmt = 9988 )path
590  END IF
591 *
592  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
593 *
594 * PT: positive definite tridiagonal matrices
595 *
596  ntypes = 12
597  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
598 *
599  IF( tstchk ) THEN
600  CALL dchkpt( dotype, nn, nval, nns, nsval, thresh, tsterr,
601  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
602  $ b( 1, 2 ), b( 1, 3 ), work, rwork, nout )
603  ELSE
604  WRITE( nout, fmt = 9989 )path
605  END IF
606 *
607  IF( tstdrv ) THEN
608  CALL ddrvpt( dotype, nn, nval, nrhs, thresh, tsterr,
609  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
610  $ b( 1, 2 ), b( 1, 3 ), work, rwork, nout )
611  ELSE
612  WRITE( nout, fmt = 9988 )path
613  END IF
614 *
615  ELSE IF( lsamen( 2, c2, 'SY' ) ) THEN
616 *
617 * SY: symmetric indefinite matrices,
618 * with partial (Bunch-Kaufman) pivoting algorithm
619 *
620  ntypes = 10
621  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
622 *
623  IF( tstchk ) THEN
624  CALL dchksy( dotype, nn, nval, nnb2, nbval2, nns, nsval,
625  $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
626  $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
627  $ work, rwork, iwork, nout )
628  ELSE
629  WRITE( nout, fmt = 9989 )path
630  END IF
631 *
632  IF( tstdrv ) THEN
633  CALL ddrvsy( dotype, nn, nval, nrhs, thresh, tsterr, lda,
634  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
635  $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
636  $ nout )
637  ELSE
638  WRITE( nout, fmt = 9988 )path
639  END IF
640 *
641  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
642 *
643 * SP: symmetric indefinite packed matrices,
644 * with partial (Bunch-Kaufman) pivoting algorithm
645 *
646  ntypes = 10
647  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
648 *
649  IF( tstchk ) THEN
650  CALL dchksp( dotype, nn, nval, nns, nsval, thresh, tsterr,
651  $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
652  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
653  $ iwork, nout )
654  ELSE
655  WRITE( nout, fmt = 9989 )path
656  END IF
657 *
658  IF( tstdrv ) THEN
659  CALL ddrvsp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
660  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
661  $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
662  $ nout )
663  ELSE
664  WRITE( nout, fmt = 9988 )path
665  END IF
666 *
667  ELSE IF( lsamen( 2, c2, 'TR' ) ) THEN
668 *
669 * TR: triangular matrices
670 *
671  ntypes = 18
672  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
673 *
674  IF( tstchk ) THEN
675  CALL dchktr( dotype, nn, nval, nnb2, nbval2, nns, nsval,
676  $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
677  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
678  $ iwork, nout )
679  ELSE
680  WRITE( nout, fmt = 9989 )path
681  END IF
682 *
683  ELSE IF( lsamen( 2, c2, 'TP' ) ) THEN
684 *
685 * TP: triangular packed matrices
686 *
687  ntypes = 18
688  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
689 *
690  IF( tstchk ) THEN
691  CALL dchktp( dotype, nn, nval, nns, nsval, thresh, tsterr,
692  $ lda, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
693  $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
694  $ nout )
695  ELSE
696  WRITE( nout, fmt = 9989 )path
697  END IF
698 *
699  ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
700 *
701 * TB: triangular banded matrices
702 *
703  ntypes = 17
704  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
705 *
706  IF( tstchk ) THEN
707  CALL dchktb( dotype, nn, nval, nns, nsval, thresh, tsterr,
708  $ lda, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
709  $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
710  $ nout )
711  ELSE
712  WRITE( nout, fmt = 9989 )path
713  END IF
714 *
715  ELSE IF( lsamen( 2, c2, 'QR' ) ) THEN
716 *
717 * QR: QR factorization
718 *
719  ntypes = 8
720  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
721 *
722  IF( tstchk ) THEN
723  CALL dchkqr( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
724  $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
725  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
726  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
727  $ work, rwork, iwork, nout )
728  ELSE
729  WRITE( nout, fmt = 9989 )path
730  END IF
731 *
732  ELSE IF( lsamen( 2, c2, 'LQ' ) ) THEN
733 *
734 * LQ: LQ factorization
735 *
736  ntypes = 8
737  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
738 *
739  IF( tstchk ) THEN
740  CALL dchklq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
741  $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
742  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
743  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
744  $ work, rwork, nout )
745  ELSE
746  WRITE( nout, fmt = 9989 )path
747  END IF
748 *
749  ELSE IF( lsamen( 2, c2, 'QL' ) ) THEN
750 *
751 * QL: QL factorization
752 *
753  ntypes = 8
754  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
755 *
756  IF( tstchk ) THEN
757  CALL dchkql( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
758  $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
759  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
760  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
761  $ work, rwork, iwork, nout )
762  ELSE
763  WRITE( nout, fmt = 9989 )path
764  END IF
765 *
766  ELSE IF( lsamen( 2, c2, 'RQ' ) ) THEN
767 *
768 * RQ: RQ factorization
769 *
770  ntypes = 8
771  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
772 *
773  IF( tstchk ) THEN
774  CALL dchkrq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
775  $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
776  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
777  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
778  $ work, rwork, iwork, nout )
779  ELSE
780  WRITE( nout, fmt = 9989 )path
781  END IF
782 *
783  ELSE IF( lsamen( 2, c2, 'QP' ) ) THEN
784 *
785 * QP: QR factorization with pivoting
786 *
787  ntypes = 6
788  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
789 *
790  IF( tstchk ) THEN
791  CALL dchkqp( dotype, nm, mval, nn, nval, thresh, tsterr,
792  $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
793  $ b( 1, 3 ), work, iwork, nout )
794  CALL dchkq3( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
795  $ thresh, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
796  $ b( 1, 3 ), work, iwork, nout )
797  ELSE
798  WRITE( nout, fmt = 9989 )path
799  END IF
800 *
801  ELSE IF( lsamen( 2, c2, 'TZ' ) ) THEN
802 *
803 * TZ: Trapezoidal matrix
804 *
805  ntypes = 3
806  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
807 *
808  IF( tstchk ) THEN
809  CALL dchktz( dotype, nm, mval, nn, nval, thresh, tsterr,
810  $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
811  $ b( 1, 3 ), work, nout )
812  ELSE
813  WRITE( nout, fmt = 9989 )path
814  END IF
815 *
816  ELSE IF( lsamen( 2, c2, 'LS' ) ) THEN
817 *
818 * LS: Least squares drivers
819 *
820  ntypes = 6
821  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
822 *
823  IF( tstdrv ) THEN
824  CALL ddrvls( dotype, nm, mval, nn, nval, nns, nsval, nnb,
825  $ nbval, nxval, thresh, tsterr, a( 1, 1 ),
826  $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
827  $ rwork, rwork( nmax+1 ), work, iwork, nout )
828  ELSE
829  WRITE( nout, fmt = 9988 )path
830  END IF
831 *
832  ELSE IF( lsamen( 2, c2, 'EQ' ) ) THEN
833 *
834 * EQ: Equilibration routines for general and positive definite
835 * matrices (THREQ should be between 2 and 10)
836 *
837  IF( tstchk ) THEN
838  CALL dchkeq( threq, nout )
839  ELSE
840  WRITE( nout, fmt = 9989 )path
841  END IF
842 *
843  ELSE IF( lsamen( 2, c2, 'QT' ) ) THEN
844 *
845 * QT: QRT routines for general matrices
846 *
847  IF( tstchk ) THEN
848  CALL dchkqrt( thresh, tsterr, nm, mval, nn, nval, nnb,
849  $ nbval, nout )
850  ELSE
851  WRITE( nout, fmt = 9989 )path
852  END IF
853 *
854  ELSE IF( lsamen( 2, c2, 'QX' ) ) THEN
855 *
856 * QX: QRT routines for triangular-pentagonal matrices
857 *
858  IF( tstchk ) THEN
859  CALL dchkqrtp( thresh, tsterr, nm, mval, nn, nval, nnb,
860  $ nbval, nout )
861  ELSE
862  WRITE( nout, fmt = 9989 )path
863  END IF
864 *
865  ELSE
866 *
867  WRITE( nout, fmt = 9990 )path
868  END IF
869 *
870 * Go back to get another input line.
871 *
872  go to 80
873 *
874 * Branch to this line when the last record is read.
875 *
876  140 continue
877  CLOSE ( nin )
878  s2 = dsecnd( )
879  WRITE( nout, fmt = 9998 )
880  WRITE( nout, fmt = 9997 )s2 - s1
881 *
882  9999 format( / ' Execution not attempted due to input errors' )
883  9998 format( / ' End of tests' )
884  9997 format( ' Total time used = ', f12.2, ' seconds', / )
885  9996 format( ' Invalid input value: ', a4, '=', i6, '; must be >=',
886  $ i6 )
887  9995 format( ' Invalid input value: ', a4, '=', i6, '; must be <=',
888  $ i6 )
889  9994 format( ' Tests of the DOUBLE PRECISION LAPACK routines ',
890  $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
891  $ / / ' The following parameter values will be used:' )
892  9993 format( 4x, a4, ': ', 10i6, / 11x, 10i6 )
893  9992 format( / ' Routines pass computational tests if test ratio is ',
894  $ 'less than', f8.2, / )
895  9991 format( ' Relative machine ', a, ' is taken to be', d16.6 )
896  9990 format( / 1x, a3, ': Unrecognized path name' )
897  9989 format( / 1x, a3, ' routines were not tested' )
898  9988 format( / 1x, a3, ' driver routines were not tested' )
899 *
900 * End of DCHKAA
901 *
902  END