LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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*> ZHR 10 List types on next line if 0 < NTYPES < 10
54*> ZHK 10 List types on next line if 0 < NTYPES < 10
55*> ZHA 10 List types on next line if 0 < NTYPES < 10
56*> ZH2 10 List types on next line if 0 < NTYPES < 10
57*> ZSA 11 List types on next line if 0 < NTYPES < 10
58*> ZS2 11 List types on next line if 0 < NTYPES < 10
59*> ZHP 10 List types on next line if 0 < NTYPES < 10
60*> ZSY 11 List types on next line if 0 < NTYPES < 11
61*> ZSR 11 List types on next line if 0 < NTYPES < 11
62*> ZSK 11 List types on next line if 0 < NTYPES < 11
63*> ZSP 11 List types on next line if 0 < NTYPES < 11
64*> ZTR 18 List types on next line if 0 < NTYPES < 18
65*> ZTP 18 List types on next line if 0 < NTYPES < 18
66*> ZTB 17 List types on next line if 0 < NTYPES < 17
67*> ZQR 8 List types on next line if 0 < NTYPES < 8
68*> ZRQ 8 List types on next line if 0 < NTYPES < 8
69*> ZLQ 8 List types on next line if 0 < NTYPES < 8
70*> ZQL 8 List types on next line if 0 < NTYPES < 8
71*> ZQP 6 List types on next line if 0 < NTYPES < 6
72*> ZQK 19 List types on next line if 0 < NTYPES < 19
73*> ZTZ 3 List types on next line if 0 < NTYPES < 3
74*> ZLS 6 List types on next line if 0 < NTYPES < 6
75*> ZEQ
76*> ZQT
77*> ZQX
78*> ZTS
79*> ZHH
80*> \endverbatim
81*
82* Parameters:
83* ==========
84*
85*> \verbatim
86*> NMAX INTEGER
87*> The maximum allowable value for M and N.
88*>
89*> MAXIN INTEGER
90*> The number of different values that can be used for each of
91*> M, N, NRHS, NB, NX and RANK
92*>
93*> MAXRHS INTEGER
94*> The maximum number of right hand sides
95*>
96*> MATMAX INTEGER
97*> The maximum number of matrix types to use for testing
98*>
99*> NIN INTEGER
100*> The unit number for input
101*>
102*> NOUT INTEGER
103*> The unit number for output
104*> \endverbatim
105*
106* Authors:
107* ========
108*
109*> \author Univ. of Tennessee
110*> \author Univ. of California Berkeley
111*> \author Univ. of Colorado Denver
112*> \author NAG Ltd.
113*
114*> \ingroup complex16_lin
115*
116* =====================================================================
117 PROGRAM zchkaa
118*
119* -- LAPACK test routine --
120* -- LAPACK is a software package provided by Univ. of Tennessee, --
121* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
122*
123* =====================================================================
124*
125* .. Parameters ..
126 INTEGER nmax
127 parameter( nmax = 132 )
128 INTEGER maxin
129 parameter( maxin = 12 )
130 INTEGER maxrhs
131 parameter( maxrhs = 16 )
132 INTEGER matmax
133 parameter( matmax = 30 )
134 INTEGER nin, nout
135 parameter( nin = 5, nout = 6 )
136 INTEGER kdmax
137 parameter( kdmax = nmax+( nmax+1 ) / 4 )
138* ..
139* .. Local Scalars ..
140 LOGICAL fatal, tstchk, tstdrv, tsterr
141 CHARACTER c1
142 CHARACTER*2 c2
143 CHARACTER*3 path
144 CHARACTER*10 intstr
145 CHARACTER*72 aline
146 INTEGER i, ic, j, k, la, lafac, lda, nb, nm, nmats, nn,
147 $ nnb, nnb2, nns, nrhs, ntypes, nrank,
148 $ vers_major, vers_minor, vers_patch
149 DOUBLE PRECISION eps, s1, s2, threq, thresh
150* ..
151* .. Local Arrays ..
152 LOGICAL dotype( matmax )
153 INTEGER iwork( 25*nmax ), mval( maxin ),
154 $ nbval( maxin ), nbval2( maxin ),
155 $ nsval( maxin ), nval( maxin ), nxval( maxin ),
156 $ rankval( maxin ), piv( nmax )
157* ..
158* .. Allocatable Arrays ..
159 INTEGER allocatestatus
160 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE:: rwork, s
161 COMPLEX*16, DIMENSION(:), ALLOCATABLE :: e
162 COMPLEX*16, DIMENSION(:,:), ALLOCATABLE:: a, b, work
163* ..
164* .. External Functions ..
165 LOGICAL lsame, lsamen
166 DOUBLE PRECISION dlamch, dsecnd
167 EXTERNAL lsame, lsamen, dlamch, dsecnd
168* ..
169* .. External Subroutines ..
170 EXTERNAL alareq, zchkeq, zchkgb, zchkge, zchkgt, zchkhe,
183* ..
184* .. Scalars in Common ..
185 LOGICAL lerr, ok
186 CHARACTER*32 srnamt
187 INTEGER infot, nunit
188* ..
189* .. Arrays in Common ..
190 INTEGER iparms( 100 )
191* ..
192* .. Common blocks ..
193 COMMON / infoc / infot, nunit, ok, lerr
194 COMMON / srnamc / srnamt
195 COMMON / claenv / iparms
196* ..
197* .. Data statements ..
198 DATA threq / 2.0d0 / , intstr / '0123456789' /
199*
200* .. Allocate memory dynamically ..
201*
202 ALLOCATE ( a( (kdmax+1) * nmax, 7 ), stat = allocatestatus)
203 IF (allocatestatus /= 0) stop "*** Not enough memory ***"
204 ALLOCATE ( b( nmax * maxrhs, 4 ), stat = allocatestatus)
205 IF (allocatestatus /= 0 ) stop "*** Not enough memory ***"
206 ALLOCATE ( work( nmax, nmax+maxrhs+10 ), stat = allocatestatus)
207 IF (allocatestatus /= 0) stop "*** Not enough memory ***"
208 ALLOCATE ( e( nmax ), stat = allocatestatus )
209 IF (allocatestatus /= 0) stop "*** Not enough memory ***"
210 ALLOCATE ( s( 2*nmax ), stat = allocatestatus)
211 IF (allocatestatus /= 0) stop "*** Not enough memory ***"
212 ALLOCATE ( rwork( 150*nmax+2*maxrhs ), stat = allocatestatus)
213 IF (allocatestatus /= 0) stop "*** Not enough memory ***"
214* ..
215* .. Executable Statements ..
216*
217 s1 = dsecnd( )
218 lda = nmax
219 fatal = .false.
220*
221* Read a dummy line.
222*
223 READ( nin, fmt = * )
224*
225* Report values of parameters.
226*
227 CALL ilaver( vers_major, vers_minor, vers_patch )
228 WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
229*
230* Read the values of M
231*
232 READ( nin, fmt = * )nm
233 IF( nm.LT.1 ) THEN
234 WRITE( nout, fmt = 9996 )' NM ', nm, 1
235 nm = 0
236 fatal = .true.
237 ELSE IF( nm.GT.maxin ) THEN
238 WRITE( nout, fmt = 9995 )' NM ', nm, maxin
239 nm = 0
240 fatal = .true.
241 END IF
242 READ( nin, fmt = * )( mval( i ), i = 1, nm )
243 DO 10 i = 1, nm
244 IF( mval( i ).LT.0 ) THEN
245 WRITE( nout, fmt = 9996 )' M ', mval( i ), 0
246 fatal = .true.
247 ELSE IF( mval( i ).GT.nmax ) THEN
248 WRITE( nout, fmt = 9995 )' M ', mval( i ), nmax
249 fatal = .true.
250 END IF
251 10 CONTINUE
252 IF( nm.GT.0 )
253 $ WRITE( nout, fmt = 9993 )'M ', ( mval( i ), i = 1, nm )
254*
255* Read the values of N
256*
257 READ( nin, fmt = * )nn
258 IF( nn.LT.1 ) THEN
259 WRITE( nout, fmt = 9996 )' NN ', nn, 1
260 nn = 0
261 fatal = .true.
262 ELSE IF( nn.GT.maxin ) THEN
263 WRITE( nout, fmt = 9995 )' NN ', nn, maxin
264 nn = 0
265 fatal = .true.
266 END IF
267 READ( nin, fmt = * )( nval( i ), i = 1, nn )
268 DO 20 i = 1, nn
269 IF( nval( i ).LT.0 ) THEN
270 WRITE( nout, fmt = 9996 )' N ', nval( i ), 0
271 fatal = .true.
272 ELSE IF( nval( i ).GT.nmax ) THEN
273 WRITE( nout, fmt = 9995 )' N ', nval( i ), nmax
274 fatal = .true.
275 END IF
276 20 CONTINUE
277 IF( nn.GT.0 )
278 $ WRITE( nout, fmt = 9993 )'N ', ( nval( i ), i = 1, nn )
279*
280* Read the values of NRHS
281*
282 READ( nin, fmt = * )nns
283 IF( nns.LT.1 ) THEN
284 WRITE( nout, fmt = 9996 )' NNS', nns, 1
285 nns = 0
286 fatal = .true.
287 ELSE IF( nns.GT.maxin ) THEN
288 WRITE( nout, fmt = 9995 )' NNS', nns, maxin
289 nns = 0
290 fatal = .true.
291 END IF
292 READ( nin, fmt = * )( nsval( i ), i = 1, nns )
293 DO 30 i = 1, nns
294 IF( nsval( i ).LT.0 ) THEN
295 WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
296 fatal = .true.
297 ELSE IF( nsval( i ).GT.maxrhs ) THEN
298 WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
299 fatal = .true.
300 END IF
301 30 CONTINUE
302 IF( nns.GT.0 )
303 $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
304*
305* Read the values of NB
306*
307 READ( nin, fmt = * )nnb
308 IF( nnb.LT.1 ) THEN
309 WRITE( nout, fmt = 9996 )'NNB ', nnb, 1
310 nnb = 0
311 fatal = .true.
312 ELSE IF( nnb.GT.maxin ) THEN
313 WRITE( nout, fmt = 9995 )'NNB ', nnb, maxin
314 nnb = 0
315 fatal = .true.
316 END IF
317 READ( nin, fmt = * )( nbval( i ), i = 1, nnb )
318 DO 40 i = 1, nnb
319 IF( nbval( i ).LT.0 ) THEN
320 WRITE( nout, fmt = 9996 )' NB ', nbval( i ), 0
321 fatal = .true.
322 END IF
323 40 CONTINUE
324 IF( nnb.GT.0 )
325 $ WRITE( nout, fmt = 9993 )'NB ', ( nbval( i ), i = 1, nnb )
326*
327* Set NBVAL2 to be the set of unique values of NB
328*
329 nnb2 = 0
330 DO 60 i = 1, nnb
331 nb = nbval( i )
332 DO 50 j = 1, nnb2
333 IF( nb.EQ.nbval2( j ) )
334 $ GO TO 60
335 50 CONTINUE
336 nnb2 = nnb2 + 1
337 nbval2( nnb2 ) = nb
338 60 CONTINUE
339*
340* Read the values of NX
341*
342 READ( nin, fmt = * )( nxval( i ), i = 1, nnb )
343 DO 70 i = 1, nnb
344 IF( nxval( i ).LT.0 ) THEN
345 WRITE( nout, fmt = 9996 )' NX ', nxval( i ), 0
346 fatal = .true.
347 END IF
348 70 CONTINUE
349 IF( nnb.GT.0 )
350 $ WRITE( nout, fmt = 9993 )'NX ', ( nxval( i ), i = 1, nnb )
351*
352* Read the values of RANKVAL
353*
354 READ( nin, fmt = * )nrank
355 IF( nn.LT.1 ) THEN
356 WRITE( nout, fmt = 9996 )' NRANK ', nrank, 1
357 nrank = 0
358 fatal = .true.
359 ELSE IF( nn.GT.maxin ) THEN
360 WRITE( nout, fmt = 9995 )' NRANK ', nrank, maxin
361 nrank = 0
362 fatal = .true.
363 END IF
364 READ( nin, fmt = * )( rankval( i ), i = 1, nrank )
365 DO i = 1, nrank
366 IF( rankval( i ).LT.0 ) THEN
367 WRITE( nout, fmt = 9996 )' RANK ', rankval( i ), 0
368 fatal = .true.
369 ELSE IF( rankval( i ).GT.100 ) THEN
370 WRITE( nout, fmt = 9995 )' RANK ', rankval( i ), 100
371 fatal = .true.
372 END IF
373 END DO
374 IF( nrank.GT.0 )
375 $ WRITE( nout, fmt = 9993 )'RANK % OF N',
376 $ ( rankval( i ), i = 1, nrank )
377*
378* Read the threshold value for the test ratios.
379*
380 READ( nin, fmt = * )thresh
381 WRITE( nout, fmt = 9992 )thresh
382*
383* Read the flag that indicates whether to test the LAPACK routines.
384*
385 READ( nin, fmt = * )tstchk
386*
387* Read the flag that indicates whether to test the driver routines.
388*
389 READ( nin, fmt = * )tstdrv
390*
391* Read the flag that indicates whether to test the error exits.
392*
393 READ( nin, fmt = * )tsterr
394*
395 IF( fatal ) THEN
396 WRITE( nout, fmt = 9999 )
397 stop
398 END IF
399*
400* Calculate and print the machine dependent constants.
401*
402 eps = dlamch( 'Underflow threshold' )
403 WRITE( nout, fmt = 9991 )'underflow', eps
404 eps = dlamch( 'Overflow threshold' )
405 WRITE( nout, fmt = 9991 )'overflow ', eps
406 eps = dlamch( 'Epsilon' )
407 WRITE( nout, fmt = 9991 )'precision', eps
408 WRITE( nout, fmt = * )
409 nrhs = nsval( 1 )
410*
411 80 CONTINUE
412*
413* Read a test path and the number of matrix types to use.
414*
415 READ( nin, fmt = '(A72)', END = 140 )aline
416 path = aline( 1: 3 )
417 nmats = matmax
418 i = 3
419 90 CONTINUE
420 i = i + 1
421 IF( i.GT.72 )
422 $ GO TO 130
423 IF( aline( i: i ).EQ.' ' )
424 $ GO TO 90
425 nmats = 0
426 100 CONTINUE
427 c1 = aline( i: i )
428 DO 110 k = 1, 10
429 IF( c1.EQ.intstr( k: k ) ) THEN
430 ic = k - 1
431 GO TO 120
432 END IF
433 110 CONTINUE
434 GO TO 130
435 120 CONTINUE
436 nmats = nmats*10 + ic
437 i = i + 1
438 IF( i.GT.72 )
439 $ GO TO 130
440 GO TO 100
441 130 CONTINUE
442 c1 = path( 1: 1 )
443 c2 = path( 2: 3 )
444*
445* Check first character for correct precision.
446*
447 IF( .NOT.lsame( c1, 'Zomplex precision' ) ) THEN
448 WRITE( nout, fmt = 9990 )path
449*
450 ELSE IF( nmats.LE.0 ) THEN
451*
452* Check for a positive number of tests requested.
453*
454 WRITE( nout, fmt = 9989 )path
455*
456 ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
457*
458* GE: general matrices
459*
460 ntypes = 11
461 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
462*
463 IF( tstchk ) THEN
464 CALL zchkge( dotype, nm, mval, nn, nval, nnb2, nbval2, nns,
465 $ nsval, thresh, tsterr, lda, a( 1, 1 ),
466 $ a( 1, 2 ), a( 1, 3 ), b( 1, 1 ), b( 1, 2 ),
467 $ b( 1, 3 ), work, rwork, iwork, nout )
468 ELSE
469 WRITE( nout, fmt = 9989 )path
470 END IF
471*
472 IF( tstdrv ) THEN
473 CALL zdrvge( dotype, nn, nval, nrhs, thresh, tsterr, lda,
474 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
475 $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
476 $ rwork, iwork, nout )
477 ELSE
478 WRITE( nout, fmt = 9988 )path
479 END IF
480*
481 ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
482*
483* GB: general banded matrices
484*
485 la = ( 2*kdmax+1 )*nmax
486 lafac = ( 3*kdmax+1 )*nmax
487 ntypes = 8
488 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
489*
490 IF( tstchk ) THEN
491 CALL zchkgb( dotype, nm, mval, nn, nval, nnb2, nbval2, nns,
492 $ nsval, thresh, tsterr, a( 1, 1 ), la,
493 $ a( 1, 3 ), lafac, b( 1, 1 ), b( 1, 2 ),
494 $ b( 1, 3 ), work, rwork, iwork, nout )
495 ELSE
496 WRITE( nout, fmt = 9989 )path
497 END IF
498*
499 IF( tstdrv ) THEN
500 CALL zdrvgb( dotype, nn, nval, nrhs, thresh, tsterr,
501 $ a( 1, 1 ), la, a( 1, 3 ), lafac, a( 1, 6 ),
502 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s,
503 $ work, rwork, iwork, nout )
504 ELSE
505 WRITE( nout, fmt = 9988 )path
506 END IF
507*
508 ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
509*
510* GT: general tridiagonal matrices
511*
512 ntypes = 12
513 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
514*
515 IF( tstchk ) THEN
516 CALL zchkgt( dotype, nn, nval, nns, nsval, thresh, tsterr,
517 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
518 $ b( 1, 3 ), work, rwork, iwork, nout )
519 ELSE
520 WRITE( nout, fmt = 9989 )path
521 END IF
522*
523 IF( tstdrv ) THEN
524 CALL zdrvgt( dotype, nn, nval, nrhs, thresh, tsterr,
525 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
526 $ b( 1, 3 ), work, rwork, iwork, nout )
527 ELSE
528 WRITE( nout, fmt = 9988 )path
529 END IF
530*
531 ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
532*
533* PO: positive definite matrices
534*
535 ntypes = 9
536 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
537*
538 IF( tstchk ) THEN
539 CALL zchkpo( dotype, nn, nval, nnb2, nbval2, nns, nsval,
540 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
541 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
542 $ work, rwork, nout )
543 ELSE
544 WRITE( nout, fmt = 9989 )path
545 END IF
546*
547 IF( tstdrv ) THEN
548 CALL zdrvpo( dotype, nn, nval, nrhs, thresh, tsterr, lda,
549 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
550 $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
551 $ rwork, nout )
552 ELSE
553 WRITE( nout, fmt = 9988 )path
554 END IF
555*
556 ELSE IF( lsamen( 2, c2, 'PS' ) ) THEN
557*
558* PS: positive semi-definite matrices
559*
560 ntypes = 9
561*
562 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
563*
564 IF( tstchk ) THEN
565 CALL zchkps( dotype, nn, nval, nnb2, nbval2, nrank,
566 $ rankval, thresh, tsterr, lda, a( 1, 1 ),
567 $ a( 1, 2 ), a( 1, 3 ), piv, work, rwork,
568 $ nout )
569 ELSE
570 WRITE( nout, fmt = 9989 )path
571 END IF
572*
573 ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
574*
575* PP: positive definite packed matrices
576*
577 ntypes = 9
578 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
579*
580 IF( tstchk ) THEN
581 CALL zchkpp( dotype, nn, nval, nns, nsval, thresh, tsterr,
582 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
583 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
584 $ nout )
585 ELSE
586 WRITE( nout, fmt = 9989 )path
587 END IF
588*
589 IF( tstdrv ) THEN
590 CALL zdrvpp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
591 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
592 $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
593 $ rwork, nout )
594 ELSE
595 WRITE( nout, fmt = 9988 )path
596 END IF
597*
598 ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
599*
600* PB: positive definite banded matrices
601*
602 ntypes = 8
603 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
604*
605 IF( tstchk ) THEN
606 CALL zchkpb( dotype, nn, nval, nnb2, nbval2, nns, nsval,
607 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
608 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
609 $ work, rwork, nout )
610 ELSE
611 WRITE( nout, fmt = 9989 )path
612 END IF
613*
614 IF( tstdrv ) THEN
615 CALL zdrvpb( dotype, nn, nval, nrhs, thresh, tsterr, lda,
616 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
617 $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
618 $ rwork, nout )
619 ELSE
620 WRITE( nout, fmt = 9988 )path
621 END IF
622*
623 ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
624*
625* PT: positive definite tridiagonal matrices
626*
627 ntypes = 12
628 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
629*
630 IF( tstchk ) THEN
631 CALL zchkpt( dotype, nn, nval, nns, nsval, thresh, tsterr,
632 $ a( 1, 1 ), s, a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
633 $ b( 1, 3 ), work, rwork, nout )
634 ELSE
635 WRITE( nout, fmt = 9989 )path
636 END IF
637*
638 IF( tstdrv ) THEN
639 CALL zdrvpt( dotype, nn, nval, nrhs, thresh, tsterr,
640 $ a( 1, 1 ), s, a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
641 $ b( 1, 3 ), work, rwork, nout )
642 ELSE
643 WRITE( nout, fmt = 9988 )path
644 END IF
645*
646 ELSE IF( lsamen( 2, c2, 'HE' ) ) THEN
647*
648* HE: Hermitian indefinite matrices
649*
650 ntypes = 10
651 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
652*
653 IF( tstchk ) THEN
654 CALL zchkhe( dotype, nn, nval, nnb2, nbval2, nns, nsval,
655 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
656 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
657 $ work, rwork, iwork, nout )
658 ELSE
659 WRITE( nout, fmt = 9989 )path
660 END IF
661*
662 IF( tstdrv ) THEN
663 CALL zdrvhe( dotype, nn, nval, nrhs, thresh, tsterr, lda,
664 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
665 $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
666 $ nout )
667 ELSE
668 WRITE( nout, fmt = 9988 )path
669 END IF
670
671 ELSE IF( lsamen( 2, c2, 'HR' ) ) THEN
672*
673* HR: Hermitian indefinite matrices,
674* with bounded Bunch-Kaufman (rook) pivoting algorithm,
675*
676 ntypes = 10
677 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
678*
679 IF( tstchk ) THEN
680 CALL zchkhe_rook(dotype, nn, nval, nnb2, nbval2, nns, nsval,
681 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
682 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
683 $ work, rwork, iwork, nout )
684 ELSE
685 WRITE( nout, fmt = 9989 )path
686 END IF
687*
688 IF( tstdrv ) THEN
689 CALL zdrvhe_rook( dotype, nn, nval, nrhs, thresh, tsterr,
690 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
691 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work,
692 $ rwork, iwork, nout )
693 ELSE
694 WRITE( nout, fmt = 9988 )path
695 END IF
696*
697 ELSE IF( lsamen( 2, c2, 'HK' ) ) THEN
698*
699* HK: Hermitian indefinite matrices,
700* with bounded Bunch-Kaufman (rook) pivoting algorithm,
701* different matrix storage format than HR path version.
702*
703 ntypes = 10
704 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
705*
706 IF( tstchk ) THEN
707 CALL zchkhe_rk ( dotype, nn, nval, nnb2, nbval2, nns, nsval,
708 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
709 $ e, a( 1, 3 ), b( 1, 1 ), b( 1, 2 ),
710 $ b( 1, 3 ), work, rwork, iwork, nout )
711 ELSE
712 WRITE( nout, fmt = 9989 )path
713 END IF
714*
715 IF( tstdrv ) THEN
716 CALL zdrvhe_rk( dotype, nn, nval, nrhs, thresh, tsterr,
717 $ lda, a( 1, 1 ), a( 1, 2 ), e, a( 1, 3 ),
718 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work,
719 $ rwork, iwork, nout )
720 ELSE
721 WRITE( nout, fmt = 9988 )path
722 END IF
723*
724 ELSE IF( lsamen( 2, c2, 'HA' ) ) THEN
725*
726* HA: Hermitian matrices,
727* Aasen Algorithm
728*
729 ntypes = 10
730 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
731*
732 IF( tstchk ) THEN
733 CALL zchkhe_aa( dotype, nn, nval, nnb2, nbval2, nns,
734 $ nsval, thresh, tsterr, lda,
735 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
736 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
737 $ work, rwork, iwork, nout )
738 ELSE
739 WRITE( nout, fmt = 9989 )path
740 END IF
741*
742 IF( tstdrv ) THEN
743 CALL zdrvhe_aa( dotype, nn, nval, nrhs, thresh, tsterr,
744 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
745 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
746 $ work, rwork, iwork, nout )
747 ELSE
748 WRITE( nout, fmt = 9988 )path
749 END IF
750*
751 ELSE IF( lsamen( 2, c2, 'H2' ) ) THEN
752*
753* H2: Hermitian matrices,
754* with partial (Aasen's) pivoting algorithm
755*
756 ntypes = 10
757 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
758*
759 IF( tstchk ) THEN
760 CALL zchkhe_aa_2stage( dotype, nn, nval, nnb2, nbval2,
761 $ nns, nsval, thresh, tsterr, lda,
762 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
763 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
764 $ work, rwork, iwork, nout )
765 ELSE
766 WRITE( nout, fmt = 9989 )path
767 END IF
768*
769 IF( tstdrv ) THEN
770 CALL zdrvhe_aa_2stage(
771 $ dotype, nn, nval, nrhs, thresh, tsterr,
772 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
773 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
774 $ work, rwork, iwork, nout )
775 ELSE
776 WRITE( nout, fmt = 9988 )path
777 END IF
778*
779*
780 ELSE IF( lsamen( 2, c2, 'HP' ) ) THEN
781*
782* HP: Hermitian indefinite packed matrices
783*
784 ntypes = 10
785 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
786*
787 IF( tstchk ) THEN
788 CALL zchkhp( dotype, nn, nval, nns, nsval, thresh, tsterr,
789 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
790 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
791 $ iwork, nout )
792 ELSE
793 WRITE( nout, fmt = 9989 )path
794 END IF
795*
796 IF( tstdrv ) THEN
797 CALL zdrvhp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
798 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
799 $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
800 $ nout )
801 ELSE
802 WRITE( nout, fmt = 9988 )path
803 END IF
804*
805 ELSE IF( lsamen( 2, c2, 'SY' ) ) THEN
806*
807* SY: symmetric indefinite matrices,
808* with partial (Bunch-Kaufman) pivoting algorithm
809*
810 ntypes = 11
811 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
812*
813 IF( tstchk ) THEN
814 CALL zchksy( dotype, nn, nval, nnb2, nbval2, nns, nsval,
815 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
816 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
817 $ work, rwork, iwork, nout )
818 ELSE
819 WRITE( nout, fmt = 9989 )path
820 END IF
821*
822 IF( tstdrv ) THEN
823 CALL zdrvsy( dotype, nn, nval, nrhs, thresh, tsterr, lda,
824 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
825 $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
826 $ nout )
827 ELSE
828 WRITE( nout, fmt = 9988 )path
829 END IF
830*
831 ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
832*
833* SR: symmetric indefinite matrices,
834* with bounded Bunch-Kaufman (rook) pivoting algorithm
835*
836 ntypes = 11
837 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
838*
839 IF( tstchk ) THEN
840 CALL zchksy_rook(dotype, nn, nval, nnb2, nbval2, nns, nsval,
841 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
842 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
843 $ work, rwork, iwork, nout )
844 ELSE
845 WRITE( nout, fmt = 9989 )path
846 END IF
847*
848 IF( tstdrv ) THEN
849 CALL zdrvsy_rook( dotype, nn, nval, nrhs, thresh, tsterr,
850 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
851 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work,
852 $ rwork, iwork, nout )
853 ELSE
854 WRITE( nout, fmt = 9988 )path
855 END IF
856*
857 ELSE IF( lsamen( 2, c2, 'SK' ) ) THEN
858*
859* SK: symmetric indefinite matrices,
860* with bounded Bunch-Kaufman (rook) pivoting algorithm,
861* different matrix storage format than SR path version.
862*
863 ntypes = 11
864 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
865*
866 IF( tstchk ) THEN
867 CALL zchksy_rk( dotype, nn, nval, nnb2, nbval2, nns, nsval,
868 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
869 $ e, a( 1, 3 ), b( 1, 1 ), b( 1, 2 ),
870 $ b( 1, 3 ), work, rwork, iwork, nout )
871 ELSE
872 WRITE( nout, fmt = 9989 )path
873 END IF
874*
875 IF( tstdrv ) THEN
876 CALL zdrvsy_rk( dotype, nn, nval, nrhs, thresh, tsterr,
877 $ lda, a( 1, 1 ), a( 1, 2 ), e, a( 1, 3 ),
878 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work,
879 $ rwork, iwork, nout )
880 ELSE
881 WRITE( nout, fmt = 9988 )path
882 END IF
883*
884 ELSE IF( lsamen( 2, c2, 'SA' ) ) THEN
885*
886* SA: symmetric indefinite matrices with Aasen's algorithm,
887*
888 ntypes = 11
889 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
890*
891 IF( tstchk ) THEN
892 CALL zchksy_aa( dotype, nn, nval, nnb2, nbval2, nns, nsval,
893 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
894 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ),
895 $ b( 1, 3 ), work, rwork, iwork, nout )
896 ELSE
897 WRITE( nout, fmt = 9989 )path
898 END IF
899*
900 IF( tstdrv ) THEN
901 CALL zdrvsy_aa( dotype, nn, nval, nrhs, thresh, tsterr,
902 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
903 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work,
904 $ rwork, iwork, nout )
905 ELSE
906 WRITE( nout, fmt = 9988 )path
907 END IF
908*
909 ELSE IF( lsamen( 2, c2, 'S2' ) ) THEN
910*
911* S2: symmetric indefinite matrices with Aasen's algorithm
912* 2 stage
913*
914 ntypes = 11
915 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
916*
917 IF( tstchk ) THEN
918 CALL zchksy_aa_2stage( dotype, nn, nval, nnb2, nbval2, nns,
919 $ nsval, thresh, tsterr, lda,
920 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
921 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
922 $ work, rwork, iwork, nout )
923 ELSE
924 WRITE( nout, fmt = 9989 )path
925 END IF
926*
927 IF( tstdrv ) THEN
928 CALL zdrvsy_aa_2stage(
929 $ dotype, nn, nval, nrhs, thresh, tsterr,
930 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
931 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work,
932 $ rwork, iwork, nout )
933 ELSE
934 WRITE( nout, fmt = 9988 )path
935 END IF
936*
937 ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
938*
939* SP: symmetric indefinite packed matrices,
940* with partial (Bunch-Kaufman) pivoting algorithm
941*
942 ntypes = 11
943 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
944*
945 IF( tstchk ) THEN
946 CALL zchksp( dotype, nn, nval, nns, nsval, thresh, tsterr,
947 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
948 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
949 $ iwork, nout )
950 ELSE
951 WRITE( nout, fmt = 9989 )path
952 END IF
953*
954 IF( tstdrv ) THEN
955 CALL zdrvsp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
956 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
957 $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
958 $ nout )
959 ELSE
960 WRITE( nout, fmt = 9988 )path
961 END IF
962*
963 ELSE IF( lsamen( 2, c2, 'TR' ) ) THEN
964*
965* TR: triangular matrices
966*
967 ntypes = 18
968 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
969*
970 IF( tstchk ) THEN
971 CALL zchktr( dotype, nn, nval, nnb2, nbval2, nns, nsval,
972 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
973 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
974 $ nout )
975 ELSE
976 WRITE( nout, fmt = 9989 )path
977 END IF
978*
979 ELSE IF( lsamen( 2, c2, 'TP' ) ) THEN
980*
981* TP: triangular packed matrices
982*
983 ntypes = 18
984 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
985*
986 IF( tstchk ) THEN
987 CALL zchktp( dotype, nn, nval, nns, nsval, thresh, tsterr,
988 $ lda, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
989 $ b( 1, 2 ), b( 1, 3 ), work, rwork, nout )
990 ELSE
991 WRITE( nout, fmt = 9989 )path
992 END IF
993*
994 ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
995*
996* TB: triangular banded matrices
997*
998 ntypes = 17
999 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
1000*
1001 IF( tstchk ) THEN
1002 CALL zchktb( dotype, nn, nval, nns, nsval, thresh, tsterr,
1003 $ lda, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
1004 $ b( 1, 2 ), b( 1, 3 ), work, rwork, nout )
1005 ELSE
1006 WRITE( nout, fmt = 9989 )path
1007 END IF
1008*
1009 ELSE IF( lsamen( 2, c2, 'QR' ) ) THEN
1010*
1011* QR: QR factorization
1012*
1013 ntypes = 8
1014 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
1015*
1016 IF( tstchk ) THEN
1017 CALL zchkqr( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
1018 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
1019 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
1020 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
1021 $ work, rwork, iwork, nout )
1022 ELSE
1023 WRITE( nout, fmt = 9989 )path
1024 END IF
1025*
1026 ELSE IF( lsamen( 2, c2, 'LQ' ) ) THEN
1027*
1028* LQ: LQ factorization
1029*
1030 ntypes = 8
1031 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
1032*
1033 IF( tstchk ) THEN
1034 CALL zchklq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
1035 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
1036 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
1037 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
1038 $ work, rwork, nout )
1039 ELSE
1040 WRITE( nout, fmt = 9989 )path
1041 END IF
1042*
1043 ELSE IF( lsamen( 2, c2, 'QL' ) ) THEN
1044*
1045* QL: QL factorization
1046*
1047 ntypes = 8
1048 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
1049*
1050 IF( tstchk ) THEN
1051 CALL zchkql( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
1052 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
1053 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
1054 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
1055 $ work, rwork, nout )
1056 ELSE
1057 WRITE( nout, fmt = 9989 )path
1058 END IF
1059*
1060 ELSE IF( lsamen( 2, c2, 'RQ' ) ) THEN
1061*
1062* RQ: RQ factorization
1063*
1064 ntypes = 8
1065 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
1066*
1067 IF( tstchk ) THEN
1068 CALL zchkrq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
1069 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
1070 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
1071 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
1072 $ work, rwork, iwork, nout )
1073 ELSE
1074 WRITE( nout, fmt = 9989 )path
1075 END IF
1076*
1077 ELSE IF( lsamen( 2, c2, 'EQ' ) ) THEN
1078*
1079* EQ: Equilibration routines for general and positive definite
1080* matrices (THREQ should be between 2 and 10)
1081*
1082 IF( tstchk ) THEN
1083 CALL zchkeq( threq, nout )
1084 ELSE
1085 WRITE( nout, fmt = 9989 )path
1086 END IF
1087*
1088 ELSE IF( lsamen( 2, c2, 'TZ' ) ) THEN
1089*
1090* TZ: Trapezoidal matrix
1091*
1092 ntypes = 3
1093 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
1094*
1095 IF( tstchk ) THEN
1096 CALL zchktz( dotype, nm, mval, nn, nval, thresh, tsterr,
1097 $ a( 1, 1 ), a( 1, 2 ), s( 1 ),
1098 $ b( 1, 1 ), work, rwork, nout )
1099 ELSE
1100 WRITE( nout, fmt = 9989 )path
1101 END IF
1102*
1103 ELSE IF( lsamen( 2, c2, 'QP' ) ) THEN
1104*
1105* QP: QR factorization with pivoting
1106*
1107 ntypes = 6
1108 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
1109*
1110 IF( tstchk ) THEN
1111 CALL zchkq3( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
1112 $ thresh, a( 1, 1 ), a( 1, 2 ), s( 1 ),
1113 $ b( 1, 1 ), work, rwork, iwork,
1114 $ nout )
1115 ELSE
1116 WRITE( nout, fmt = 9989 )path
1117 END IF
1118*
1119 ELSE IF( lsamen( 2, c2, 'QK' ) ) THEN
1120*
1121* QK: truncated QR factorization with pivoting
1122*
1123 ntypes = 19
1124 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
1125*
1126 IF( tstchk ) THEN
1127 CALL zchkqp3rk( dotype, nm, mval, nn, nval, nns, nsval,
1128 $ nnb, nbval, nxval, thresh, a( 1, 1 ),
1129 $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
1130 $ s( 1 ), b( 1, 4 ),
1131 $ work, rwork, iwork, nout )
1132 ELSE
1133 WRITE( nout, fmt = 9989 )path
1134 END IF
1135*
1136 ELSE IF( lsamen( 2, c2, 'LS' ) ) THEN
1137*
1138* LS: Least squares drivers
1139*
1140 ntypes = 6
1141 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
1142*
1143 IF( tstdrv ) THEN
1144 CALL zdrvls( dotype, nm, mval, nn, nval, nns, nsval, nnb,
1145 $ nbval, nxval, thresh, tsterr, a( 1, 1 ),
1146 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
1147 $ s( 1 ), s( nmax+1 ), nout )
1148 ELSE
1149 WRITE( nout, fmt = 9989 )path
1150 END IF
1151*
1152*
1153 ELSE IF( lsamen( 2, c2, 'QT' ) ) THEN
1154*
1155* QT: QRT routines for general matrices
1156*
1157 IF( tstchk ) THEN
1158 CALL zchkqrt( thresh, tsterr, nm, mval, nn, nval, nnb,
1159 $ nbval, nout )
1160 ELSE
1161 WRITE( nout, fmt = 9989 )path
1162 END IF
1163*
1164 ELSE IF( lsamen( 2, c2, 'QX' ) ) THEN
1165*
1166* QX: QRT routines for triangular-pentagonal matrices
1167*
1168 IF( tstchk ) THEN
1169 CALL zchkqrtp( thresh, tsterr, nm, mval, nn, nval, nnb,
1170 $ nbval, nout )
1171 ELSE
1172 WRITE( nout, fmt = 9989 )path
1173 END IF
1174*
1175 ELSE IF( lsamen( 2, c2, 'TQ' ) ) THEN
1176*
1177* TQ: LQT routines for general matrices
1178*
1179 IF( tstchk ) THEN
1180 CALL zchklqt( thresh, tsterr, nm, mval, nn, nval, nnb,
1181 $ nbval, nout )
1182 ELSE
1183 WRITE( nout, fmt = 9989 )path
1184 END IF
1185*
1186 ELSE IF( lsamen( 2, c2, 'XQ' ) ) THEN
1187*
1188* XQ: LQT routines for triangular-pentagonal matrices
1189*
1190 IF( tstchk ) THEN
1191 CALL zchklqtp( thresh, tsterr, nm, mval, nn, nval, nnb,
1192 $ nbval, nout )
1193 ELSE
1194 WRITE( nout, fmt = 9989 )path
1195 END IF
1196*
1197 ELSE IF( lsamen( 2, c2, 'TS' ) ) THEN
1198*
1199* TS: QR routines for tall-skinny matrices
1200*
1201 IF( tstchk ) THEN
1202 CALL zchktsqr( thresh, tsterr, nm, mval, nn, nval, nnb,
1203 $ nbval, nout )
1204 ELSE
1205 WRITE( nout, fmt = 9989 )path
1206 END IF
1207*
1208 ELSE IF( lsamen( 2, c2, 'TQ' ) ) THEN
1209*
1210* TQ: LQT routines for general matrices
1211*
1212 IF( tstchk ) THEN
1213 CALL zchklqt( thresh, tsterr, nm, mval, nn, nval, nnb,
1214 $ nbval, nout )
1215 ELSE
1216 WRITE( nout, fmt = 9989 )path
1217 END IF
1218*
1219 ELSE IF( lsamen( 2, c2, 'XQ' ) ) THEN
1220*
1221* XQ: LQT routines for triangular-pentagonal matrices
1222*
1223 IF( tstchk ) THEN
1224 CALL zchklqtp( thresh, tsterr, nm, mval, nn, nval, nnb,
1225 $ nbval, nout )
1226 ELSE
1227 WRITE( nout, fmt = 9989 )path
1228 END IF
1229*
1230 ELSE IF( lsamen( 2, c2, 'TS' ) ) THEN
1231*
1232* TS: QR routines for tall-skinny matrices
1233*
1234 IF( tstchk ) THEN
1235 CALL zchktsqr( thresh, tsterr, nm, mval, nn, nval, nnb,
1236 $ nbval, nout )
1237 ELSE
1238 WRITE( nout, fmt = 9989 )path
1239 END IF
1240*
1241 ELSE IF( lsamen( 2, c2, 'HH' ) ) THEN
1242*
1243* HH: Householder reconstruction for tall-skinny matrices
1244*
1245 IF( tstchk ) THEN
1246 CALL zchkunhr_col( thresh, tsterr, nm, mval, nn, nval, nnb,
1247 $ nbval, nout )
1248 ELSE
1249 WRITE( nout, fmt = 9989 ) path
1250 END IF
1251*
1252 ELSE
1253*
1254 WRITE( nout, fmt = 9990 )path
1255 END IF
1256*
1257* Go back to get another input line.
1258*
1259 GO TO 80
1260*
1261* Branch to this line when the last record is read.
1262*
1263 140 CONTINUE
1264 CLOSE ( nin )
1265 s2 = dsecnd( )
1266 WRITE( nout, fmt = 9998 )
1267 WRITE( nout, fmt = 9997 )s2 - s1
1268*
1269 DEALLOCATE (a, stat = allocatestatus)
1270 DEALLOCATE (b, stat = allocatestatus)
1271 DEALLOCATE (rwork, stat = allocatestatus)
1272 DEALLOCATE (work, stat = allocatestatus)
1273*
1274 9999 FORMAT( / ' Execution not attempted due to input errors' )
1275 9998 FORMAT( / ' End of tests' )
1276 9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
1277 9996 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be >=',
1278 $ i6 )
1279 9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
1280 $ i6 )
1281 9994 FORMAT( ' Tests of the COMPLEX*16 LAPACK routines ',
1282 $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
1283 $ / / ' The following parameter values will be used:' )
1284 9993 FORMAT( 4x, a4, ': ', 10i6, / 11x, 10i6 )
1285 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
1286 $ 'less than', f8.2, / )
1287 9991 FORMAT( ' Relative machine ', a, ' is taken to be', d16.6 )
1288 9990 FORMAT( / 1x, a3, ': Unrecognized path name' )
1289 9989 FORMAT( / 1x, a3, ' routines were not tested' )
1290 9988 FORMAT( / 1x, a3, ' driver routines were not tested' )
1291*
1292* End of ZCHKAA
1293*
1294 END
subroutine alareq(path, nmats, dotype, ntypes, nin, nout)
ALAREQ
Definition alareq.f:90
subroutine ilaver(vers_major, vers_minor, vers_patch)
ILAVER returns the LAPACK version.
Definition ilaver.f:51
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
double precision function dsecnd()
DSECND Using ETIME
program zchkaa
ZCHKAA
Definition zchkaa.F:117
subroutine zchkeq(thresh, nout)
ZCHKEQ
Definition zchkeq.f:54
subroutine zchkgb(dotype, nm, mval, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, a, la, afac, lafac, b, x, xact, work, rwork, iwork, nout)
ZCHKGB
Definition zchkgb.f:191
subroutine zchkge(dotype, nm, mval, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKGE
Definition zchkge.f:186
subroutine zchkgt(dotype, nn, nval, nns, nsval, thresh, tsterr, a, af, b, x, xact, work, rwork, iwork, nout)
ZCHKGT
Definition zchkgt.f:147
subroutine zchkhe(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKHE
Definition zchkhe.f:171
subroutine zchkhe_aa(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKHE_AA
Definition zchkhe_aa.f:171
subroutine zchkhe_aa_2stage(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKHE_AA_2STAGE
subroutine zchkhe_rk(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, e, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKHE_RK
Definition zchkhe_rk.f:177
subroutine zchkhe_rook(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKHE_ROOK
subroutine zchkhp(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKHP
Definition zchkhp.f:164
subroutine zchklq(dotype, nm, mval, nn, nval, nnb, nbval, nxval, nrhs, thresh, tsterr, nmax, a, af, aq, al, ac, b, x, xact, tau, work, rwork, nout)
ZCHKLQ
Definition zchklq.f:196
subroutine zchklqt(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
ZCHKLQT
Definition zchklqt.f:102
subroutine zchklqtp(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
ZCHKLQTP
Definition zchklqtp.f:102
subroutine zchkpb(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, nout)
ZCHKPB
Definition zchkpb.f:168
subroutine zchkpo(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, nout)
ZCHKPO
Definition zchkpo.f:168
subroutine zchkpp(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, nout)
ZCHKPP
Definition zchkpp.f:159
subroutine zchkps(dotype, nn, nval, nnb, nbval, nrank, rankval, thresh, tsterr, nmax, a, afac, perm, piv, work, rwork, nout)
ZCHKPS
Definition zchkps.f:154
subroutine zchkpt(dotype, nn, nval, nns, nsval, thresh, tsterr, a, d, e, b, x, xact, work, rwork, nout)
ZCHKPT
Definition zchkpt.f:147
subroutine zchkq3(dotype, nm, mval, nn, nval, nnb, nbval, nxval, thresh, a, copya, s, tau, work, rwork, iwork, nout)
ZCHKQ3
Definition zchkq3.f:158
subroutine zchkql(dotype, nm, mval, nn, nval, nnb, nbval, nxval, nrhs, thresh, tsterr, nmax, a, af, aq, al, ac, b, x, xact, tau, work, rwork, nout)
ZCHKQL
Definition zchkql.f:196
subroutine zchkqp3rk(dotype, nm, mval, nn, nval, nns, nsval, nnb, nbval, nxval, thresh, a, copya, b, copyb, s, tau, work, rwork, iwork, nout)
ZCHKQP3RK
Definition zchkqp3rk.f:184
subroutine zchkqr(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)
ZCHKQR
Definition zchkqr.f:201
subroutine zchkqrt(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
ZCHKQRT
Definition zchkqrt.f:101
subroutine zchkqrtp(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
ZCHKQRTP
Definition zchkqrtp.f:102
subroutine zchkrq(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)
ZCHKRQ
Definition zchkrq.f:201
subroutine zchksp(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKSP
Definition zchksp.f:164
subroutine zchksy(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKSY
Definition zchksy.f:171
subroutine zchksy_aa(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKSY_AA
Definition zchksy_aa.f:171
subroutine zchksy_aa_2stage(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKSY_AA_2STAGE
subroutine zchksy_rk(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, e, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKSY_RK
Definition zchksy_rk.f:177
subroutine zchksy_rook(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKSY_ROOK
subroutine zchktb(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, ab, ainv, b, x, xact, work, rwork, nout)
ZCHKTB
Definition zchktb.f:149
subroutine zchktp(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, ap, ainvp, b, x, xact, work, rwork, nout)
ZCHKTP
Definition zchktp.f:151
subroutine zchktr(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, ainv, b, x, xact, work, rwork, nout)
ZCHKTR
Definition zchktr.f:163
subroutine zchktsqr(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
DCHKQRT
Definition zchktsqr.f:102
subroutine zchktz(dotype, nm, mval, nn, nval, thresh, tsterr, a, copya, s, tau, work, rwork, nout)
ZCHKTZ
Definition zchktz.f:137
subroutine zchkunhr_col(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
ZCHKUNHR_COL
subroutine zdrvgb(dotype, nn, nval, nrhs, thresh, tsterr, a, la, afb, lafb, asav, b, bsav, x, xact, s, work, rwork, iwork, nout)
ZDRVGB
Definition zdrvgb.f:172
subroutine zdrvge(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, iwork, nout)
ZDRVGE
Definition zdrvge.f:164
subroutine zdrvgt(dotype, nn, nval, nrhs, thresh, tsterr, a, af, b, x, xact, work, rwork, iwork, nout)
ZDRVGT
Definition zdrvgt.f:139
subroutine zdrvhe(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVHE
Definition zdrvhe.f:153
subroutine zdrvhe_aa(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVHE_AA
Definition zdrvhe_aa.f:153
subroutine zdrvhe_aa_2stage(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVHE_AA_2STAGE
subroutine zdrvhe_rk(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, e, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVHE_RK
Definition zdrvhe_rk.f:158
subroutine zdrvhe_rook(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVHE_ROOK
subroutine zdrvhp(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVHP
Definition zdrvhp.f:157
subroutine zdrvls(dotype, nm, mval, nn, nval, nns, nsval, nnb, nbval, nxval, thresh, tsterr, a, copya, b, copyb, c, s, copys, nout)
ZDRVLS
Definition zdrvls.f:192
subroutine zdrvpb(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, nout)
ZDRVPB
Definition zdrvpb.f:159
subroutine zdrvpo(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, nout)
ZDRVPO
Definition zdrvpo.f:159
subroutine zdrvpp(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, nout)
ZDRVPP
Definition zdrvpp.f:159
subroutine zdrvpt(dotype, nn, nval, nrhs, thresh, tsterr, a, d, e, b, x, xact, work, rwork, nout)
ZDRVPT
Definition zdrvpt.f:140
subroutine zdrvsp(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVSP
Definition zdrvsp.f:157
subroutine zdrvsy(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVSY
Definition zdrvsy.f:153
subroutine zdrvsy_aa(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVSY_AA
Definition zdrvsy_aa.f:153
subroutine zdrvsy_aa_2stage(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVSY_AA_2STAGE
subroutine zdrvsy_rk(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, e, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVSY_RK
Definition zdrvsy_rk.f:158
subroutine zdrvsy_rook(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVSY_ROOK