LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
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.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  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 schkqp( dotype, nm, mval, nn, nval, thresh, tsterr,
818  $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
819  $ b( 1, 3 ), work, iwork, nout )
820  CALL schkq3( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
821  $ thresh, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
822  $ b( 1, 3 ), work, iwork, nout )
823  ELSE
824  WRITE( nout, fmt = 9989 )path
825  END IF
826 *
827  ELSE IF( lsamen( 2, c2, 'TZ' ) ) THEN
828 *
829 * TZ: Trapezoidal matrix
830 *
831  ntypes = 3
832  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
833 *
834  IF( tstchk ) THEN
835  CALL schktz( dotype, nm, mval, nn, nval, thresh, tsterr,
836  $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
837  $ b( 1, 3 ), work, nout )
838  ELSE
839  WRITE( nout, fmt = 9989 )path
840  END IF
841 *
842  ELSE IF( lsamen( 2, c2, 'LS' ) ) THEN
843 *
844 * LS: Least squares drivers
845 *
846  ntypes = 6
847  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
848 *
849  IF( tstdrv ) THEN
850  CALL sdrvls( dotype, nm, mval, nn, nval, nns, nsval, nnb,
851  $ nbval, nxval, thresh, tsterr, a( 1, 1 ),
852  $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
853  $ rwork, rwork( nmax+1 ), work, iwork, nout )
854  ELSE
855  WRITE( nout, fmt = 9988 )path
856  END IF
857 *
858  ELSE IF( lsamen( 2, c2, 'EQ' ) ) THEN
859 *
860 * EQ: Equilibration routines for general and positive definite
861 * matrices (THREQ should be between 2 and 10)
862 *
863  IF( tstchk ) THEN
864  CALL schkeq( threq, nout )
865  ELSE
866  WRITE( nout, fmt = 9989 )path
867  END IF
868 *
869  ELSE IF( lsamen( 2, c2, 'QT' ) ) THEN
870 *
871 * QT: QRT routines for general matrices
872 *
873  IF( tstchk ) THEN
874  CALL schkqrt( thresh, tsterr, nm, mval, nn, nval, nnb,
875  $ nbval, nout )
876  ELSE
877  WRITE( nout, fmt = 9989 )path
878  END IF
879 *
880  ELSE IF( lsamen( 2, c2, 'QX' ) ) THEN
881 *
882 * QX: QRT routines for triangular-pentagonal matrices
883 *
884  IF( tstchk ) THEN
885  CALL schkqrtp( thresh, tsterr, nm, mval, nn, nval, nnb,
886  $ nbval, nout )
887  ELSE
888  WRITE( nout, fmt = 9989 )path
889  END IF
890 *
891  ELSE
892 *
893  WRITE( nout, fmt = 9990 )path
894  END IF
895 *
896 * Go back to get another input line.
897 *
898  go to 80
899 *
900 * Branch to this line when the last record is read.
901 *
902  140 CONTINUE
903  CLOSE ( nin )
904  s2 = second( )
905  WRITE( nout, fmt = 9998 )
906  WRITE( nout, fmt = 9997 )s2 - s1
907 *
908  9999 FORMAT( / ' Execution not attempted due to input errors' )
909  9998 FORMAT( / ' End of tests' )
910  9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
911  9996 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be >=',
912  $ i6 )
913  9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
914  $ i6 )
915  9994 FORMAT( ' Tests of the REAL LAPACK routines ',
916  $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
917  $ / / ' The following parameter values will be used:' )
918  9993 FORMAT( 4x, a4, ': ', 10i6, / 11x, 10i6 )
919  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
920  $ 'less than', f8.2, / )
921  9991 FORMAT( ' Relative machine ', a, ' is taken to be', e16.6 )
922  9990 FORMAT( / 1x, a3, ': Unrecognized path name' )
923  9989 FORMAT( / 1x, a3, ' routines were not tested' )
924  9988 FORMAT( / 1x, a3, ' driver routines were not tested' )
925 *
926 * End of SCHKAA
927 *
928  END
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:184
real function second()
SECOND Using ETIME
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:195
subroutine schkgt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKGT
Definition: schkgt.f:146
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:195
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
Definition: ilaver.f:49
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:166
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:163
subroutine schkeq(THRESH, NOUT)
SCHKEQ
Definition: schkeq.f:55
subroutine schksp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKSP
Definition: schksp.f:162
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:152
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:171
subroutine schkps(DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, RWORK, NOUT)
SCHKPS
Definition: schkps.f:153
subroutine schkqrt(THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
SCHKQRT
Definition: schkqrt.f:100
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:171
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:171
subroutine schktb(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AB, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKTB
Definition: schktb.f:154
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine sdrvsp(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SDRVSP
Definition: sdrvsp.f:155
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:200
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:170
subroutine schkpt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
SCHKPT
Definition: schkpt.f:146
program schkaa
SCHKAA
Definition: schkaa.f:107
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:54
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:190
subroutine schkq3(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, IWORK, NOUT)
SCHKQ3
Definition: schkq3.f:152
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:202
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:169
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:75
subroutine sdrvgt(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SDRVGT
Definition: sdrvgt.f:139
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:91
subroutine sdrvpt(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
SDRVPT
Definition: sdrvpt.f:140
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
Definition: xerbla-fortran:9
subroutine schkpp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKPP
Definition: schkpp.f:162
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:166
subroutine sdrvsy(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SDRVSY
Definition: sdrvsy.f:151
subroutine schktz(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, NOUT)
SCHKTZ
Definition: schktz.f:132
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:163
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:200
subroutine schktp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AP, AINVP, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKTP
Definition: schktp.f:156
subroutine schkqrtp(THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
SCHKQRTP
Definition: schkqrtp.f:102
subroutine schkqp(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, IWORK, NOUT)
SCHKQP
Definition: schkqp.f:137
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:163