LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
schkaa.f
Go to the documentation of this file.
1 *> \brief \b SCHKAA
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 SCHKAA
12 *
13 *
14 *> \par Purpose:
15 * =============
16 *>
17 *> \verbatim
18 *>
19 *> SCHKAA is the main test program for the REAL 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 REAL 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 *> SGE 11 List types on next line if 0 < NTYPES < 11
45 *> SGB 8 List types on next line if 0 < NTYPES < 8
46 *> SGT 12 List types on next line if 0 < NTYPES < 12
47 *> SPO 9 List types on next line if 0 < NTYPES < 9
48 *> SPS 9 List types on next line if 0 < NTYPES < 9
49 *> SPP 9 List types on next line if 0 < NTYPES < 9
50 *> SPB 8 List types on next line if 0 < NTYPES < 8
51 *> SPT 12 List types on next line if 0 < NTYPES < 12
52 *> SSY 10 List types on next line if 0 < NTYPES < 10
53 *> SSR 10 List types on next line if 0 < NTYPES < 10
54 *> SSP 10 List types on next line if 0 < NTYPES < 10
55 *> STR 18 List types on next line if 0 < NTYPES < 18
56 *> STP 18 List types on next line if 0 < NTYPES < 18
57 *> STB 17 List types on next line if 0 < NTYPES < 17
58 *> SQR 8 List types on next line if 0 < NTYPES < 8
59 *> SRQ 8 List types on next line if 0 < NTYPES < 8
60 *> SLQ 8 List types on next line if 0 < NTYPES < 8
61 *> SQL 8 List types on next line if 0 < NTYPES < 8
62 *> SQP 6 List types on next line if 0 < NTYPES < 6
63 *> STZ 3 List types on next line if 0 < NTYPES < 3
64 *> SLS 6 List types on next line if 0 < NTYPES < 6
65 *> SEQ
66 *> SQT
67 *> SQX
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 single_lin
105 *
106 * =====================================================================
107  PROGRAM schkaa
108 *
109 * -- LAPACK test routine (version 3.6.0) --
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  REAL 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  REAL 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  REAL SECOND, SLAMCH
155  EXTERNAL lsame, lsamen, second, slamch
156 * ..
157 * .. External Subroutines ..
158  EXTERNAL alareq, schkeq, schkgb, schkge, schkgt, schklq,
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 / claenv / iparms
176  COMMON / infoc / infot, nunit, ok, lerr
177  COMMON / srnamc / srnamt
178 * ..
179 * .. Data statements ..
180  DATA threq / 2.0e0 / , intstr / '0123456789' /
181 * ..
182 * .. Executable Statements ..
183 *
184  s1 = second( )
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 = slamch( 'Underflow threshold' )
370  WRITE( nout, fmt = 9991 )'underflow', eps
371  eps = slamch( 'Overflow threshold' )
372  WRITE( nout, fmt = 9991 )'overflow ', eps
373  eps = slamch( '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, 'Single 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 schkge( 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 sdrvge( 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 schkgb( 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 sdrvgb( 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 schkgt( 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 sdrvgt( 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 schkpo( 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 sdrvpo( 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 schkps( 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 schkpp( 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 sdrvpp( 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 schkpb( 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 sdrvpb( 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 schkpt( 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 sdrvpt( 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 schksy( 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 sdrvsy( 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, 'SR' ) ) THEN
642 *
643 * SR: symmetric indefinite matrices with Rook pivoting,
644 * with rook (bounded Bunch-Kaufman) pivoting algorithm
645 *
646  ntypes = 10
647  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
648 *
649  IF( tstchk ) THEN
650  CALL schksy_rook(dotype, nn, nval, nnb2, nbval2, nns, nsval,
651  $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
652  $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
653  $ work, rwork, iwork, nout )
654  ELSE
655  WRITE( nout, fmt = 9989 )path
656  END IF
657 *
658  IF( tstdrv ) THEN
659  CALL sdrvsy_rook( dotype, nn, nval, nrhs, thresh, tsterr,
660  $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
661  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
662  $ work, rwork, iwork, nout )
663  ELSE
664  WRITE( nout, fmt = 9988 )path
665  END IF
666 *
667  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
668 *
669 * SP: symmetric indefinite packed matrices,
670 * with partial (Bunch-Kaufman) pivoting algorithm
671 *
672  ntypes = 10
673  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
674 *
675  IF( tstchk ) THEN
676  CALL schksp( dotype, nn, nval, nns, nsval, thresh, tsterr,
677  $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
678  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
679  $ iwork, nout )
680  ELSE
681  WRITE( nout, fmt = 9989 )path
682  END IF
683 *
684  IF( tstdrv ) THEN
685  CALL sdrvsp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
686  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
687  $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
688  $ nout )
689  ELSE
690  WRITE( nout, fmt = 9988 )path
691  END IF
692 *
693  ELSE IF( lsamen( 2, c2, 'TR' ) ) THEN
694 *
695 * TR: triangular matrices
696 *
697  ntypes = 18
698  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
699 *
700  IF( tstchk ) THEN
701  CALL schktr( dotype, nn, nval, nnb2, nbval2, nns, nsval,
702  $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
703  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
704  $ iwork, nout )
705  ELSE
706  WRITE( nout, fmt = 9989 )path
707  END IF
708 *
709  ELSE IF( lsamen( 2, c2, 'TP' ) ) THEN
710 *
711 * TP: triangular packed matrices
712 *
713  ntypes = 18
714  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
715 *
716  IF( tstchk ) THEN
717  CALL schktp( dotype, nn, nval, nns, nsval, thresh, tsterr,
718  $ lda, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
719  $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
720  $ nout )
721  ELSE
722  WRITE( nout, fmt = 9989 )path
723  END IF
724 *
725  ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
726 *
727 * TB: triangular banded matrices
728 *
729  ntypes = 17
730  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
731 *
732  IF( tstchk ) THEN
733  CALL schktb( dotype, nn, nval, nns, nsval, thresh, tsterr,
734  $ lda, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
735  $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
736  $ nout )
737  ELSE
738  WRITE( nout, fmt = 9989 )path
739  END IF
740 *
741  ELSE IF( lsamen( 2, c2, 'QR' ) ) THEN
742 *
743 * QR: QR factorization
744 *
745  ntypes = 8
746  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
747 *
748  IF( tstchk ) THEN
749  CALL schkqr( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
750  $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
751  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
752  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
753  $ work, rwork, iwork, nout )
754  ELSE
755  WRITE( nout, fmt = 9989 )path
756  END IF
757 *
758  ELSE IF( lsamen( 2, c2, 'LQ' ) ) THEN
759 *
760 * LQ: LQ factorization
761 *
762  ntypes = 8
763  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
764 *
765  IF( tstchk ) THEN
766  CALL schklq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
767  $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
768  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
769  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
770  $ work, rwork, nout )
771  ELSE
772  WRITE( nout, fmt = 9989 )path
773  END IF
774 *
775  ELSE IF( lsamen( 2, c2, 'QL' ) ) THEN
776 *
777 * QL: QL factorization
778 *
779  ntypes = 8
780  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
781 *
782  IF( tstchk ) THEN
783  CALL schkql( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
784  $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
785  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
786  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
787  $ work, rwork, nout )
788  ELSE
789  WRITE( nout, fmt = 9989 )path
790  END IF
791 *
792  ELSE IF( lsamen( 2, c2, 'RQ' ) ) THEN
793 *
794 * RQ: RQ factorization
795 *
796  ntypes = 8
797  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
798 *
799  IF( tstchk ) THEN
800  CALL schkrq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
801  $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
802  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
803  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
804  $ work, rwork, iwork, nout )
805  ELSE
806  WRITE( nout, fmt = 9989 )path
807  END IF
808 *
809  ELSE IF( lsamen( 2, c2, 'QP' ) ) THEN
810 *
811 * QP: QR factorization with pivoting
812 *
813  ntypes = 6
814  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
815 *
816  IF( tstchk ) THEN
817  CALL schkq3( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
818  $ thresh, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
819  $ b( 1, 3 ), work, iwork, nout )
820  ELSE
821  WRITE( nout, fmt = 9989 )path
822  END IF
823 *
824  ELSE IF( lsamen( 2, c2, 'TZ' ) ) THEN
825 *
826 * TZ: Trapezoidal matrix
827 *
828  ntypes = 3
829  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
830 *
831  IF( tstchk ) THEN
832  CALL schktz( dotype, nm, mval, nn, nval, thresh, tsterr,
833  $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
834  $ b( 1, 3 ), work, nout )
835  ELSE
836  WRITE( nout, fmt = 9989 )path
837  END IF
838 *
839  ELSE IF( lsamen( 2, c2, 'LS' ) ) THEN
840 *
841 * LS: Least squares drivers
842 *
843  ntypes = 6
844  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
845 *
846  IF( tstdrv ) THEN
847  CALL sdrvls( dotype, nm, mval, nn, nval, nns, nsval, nnb,
848  $ nbval, nxval, thresh, tsterr, a( 1, 1 ),
849  $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
850  $ rwork, rwork( nmax+1 ), work, iwork, nout )
851  ELSE
852  WRITE( nout, fmt = 9988 )path
853  END IF
854 *
855  ELSE IF( lsamen( 2, c2, 'EQ' ) ) THEN
856 *
857 * EQ: Equilibration routines for general and positive definite
858 * matrices (THREQ should be between 2 and 10)
859 *
860  IF( tstchk ) THEN
861  CALL schkeq( threq, nout )
862  ELSE
863  WRITE( nout, fmt = 9989 )path
864  END IF
865 *
866  ELSE IF( lsamen( 2, c2, 'QT' ) ) THEN
867 *
868 * QT: QRT routines for general matrices
869 *
870  IF( tstchk ) THEN
871  CALL schkqrt( thresh, tsterr, nm, mval, nn, nval, nnb,
872  $ nbval, nout )
873  ELSE
874  WRITE( nout, fmt = 9989 )path
875  END IF
876 *
877  ELSE IF( lsamen( 2, c2, 'QX' ) ) THEN
878 *
879 * QX: QRT routines for triangular-pentagonal matrices
880 *
881  IF( tstchk ) THEN
882  CALL schkqrtp( thresh, tsterr, nm, mval, nn, nval, nnb,
883  $ nbval, nout )
884  ELSE
885  WRITE( nout, fmt = 9989 )path
886  END IF
887 *
888  ELSE
889 *
890  WRITE( nout, fmt = 9990 )path
891  END IF
892 *
893 * Go back to get another input line.
894 *
895  GO TO 80
896 *
897 * Branch to this line when the last record is read.
898 *
899  140 CONTINUE
900  CLOSE ( nin )
901  s2 = second( )
902  WRITE( nout, fmt = 9998 )
903  WRITE( nout, fmt = 9997 )s2 - s1
904 *
905  9999 FORMAT( / ' Execution not attempted due to input errors' )
906  9998 FORMAT( / ' End of tests' )
907  9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
908  9996 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be >=',
909  $ i6 )
910  9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
911  $ i6 )
912  9994 FORMAT( ' Tests of the REAL LAPACK routines ',
913  $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
914  $ / / ' The following parameter values will be used:' )
915  9993 FORMAT( 4x, a4, ': ', 10i6, / 11x, 10i6 )
916  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
917  $ 'less than', f8.2, / )
918  9991 FORMAT( ' Relative machine ', a, ' is taken to be', e16.6 )
919  9990 FORMAT( / 1x, a3, ': Unrecognized path name' )
920  9989 FORMAT( / 1x, a3, ' routines were not tested' )
921  9988 FORMAT( / 1x, a3, ' driver routines were not tested' )
922 *
923 * End of SCHKAA
924 *
925  END
subroutine sdrvpp(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
SDRVPP
Definition: sdrvpp.f:169
subroutine sdrvsy(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SDRVSY
Definition: sdrvsy.f:154
subroutine sdrvsy_rook(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SDRVSY_ROOK
Definition: sdrvsy_rook.f:155
subroutine schktr(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKTR
Definition: schktr.f:169
subroutine schktp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AP, AINVP, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKTP
Definition: schktp.f:159
subroutine sdrvsp(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SDRVSP
Definition: sdrvsp.f:158
subroutine schkge(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKGE
Definition: schkge.f:187
subroutine schkpo(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKPO
Definition: schkpo.f:174
subroutine sdrvgb(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA, AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
SDRVGB
Definition: sdrvgb.f:174
subroutine sdrvge(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
SDRVGE
Definition: sdrvge.f:166
subroutine schkpp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKPP
Definition: schkpp.f:165
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:92
subroutine sdrvpo(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
SDRVPO
Definition: sdrvpo.f:166
subroutine schklq(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
SCHKLQ
Definition: schklq.f:198
subroutine schkql(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
SCHKQL
Definition: schkql.f:198
subroutine schkps(DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, RWORK, NOUT)
SCHKPS
Definition: schkps.f:156
subroutine schktz(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, NOUT)
SCHKTZ
Definition: schktz.f:134
subroutine schkqrtp(THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
SCHKQRTP
Definition: schkqrtp.f:104
subroutine schkq3(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, IWORK, NOUT)
SCHKQ3
Definition: schkq3.f:155
subroutine schksp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKSP
Definition: schksp.f:165
subroutine schksy(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKSY
Definition: schksy.f:172
subroutine sdrvls(DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, COPYB, C, S, COPYS, WORK, IWORK, NOUT)
SDRVLS
Definition: sdrvls.f:205
subroutine schkgb(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKGB
Definition: schkgb.f:193
subroutine schkrq(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT)
SCHKRQ
Definition: schkrq.f:203
subroutine schkqrt(THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
SCHKQRT
Definition: schkqrt.f:102
subroutine sdrvpb(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
SDRVPB
Definition: sdrvpb.f:166
subroutine sdrvgt(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SDRVGT
Definition: sdrvgt.f:141
subroutine schksy_rook(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKSY_ROOK
Definition: schksy_rook.f:173
program schkaa
SCHKAA
Definition: schkaa.f:107
subroutine sdrvpt(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
SDRVPT
Definition: sdrvpt.f:142
subroutine schkpt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
SCHKPT
Definition: schkpt.f:148
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
Definition: ilaver.f:50
subroutine schkqr(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT)
SCHKQR
Definition: schkqr.f:203
subroutine schkgt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKGT
Definition: schkgt.f:148
subroutine schkpb(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKPB
Definition: schkpb.f:174
subroutine schkeq(THRESH, NOUT)
SCHKEQ
Definition: schkeq.f:56
subroutine schktb(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AB, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKTB
Definition: schktb.f:157