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