121 parameter( nmax = 132 )
123 parameter( maxin = 12 )
125 parameter( maxrhs = 16 )
127 parameter( matmax = 30 )
129 parameter( nin = 5, nout = 6 )
131 parameter( kdmax = nmax+( nmax+1 ) / 4 )
134 LOGICAL fatal, tstchk, tstdrv, tsterr
140 INTEGER i, ic, j, k, la, lafac, lda, nb, nm, nmats, nn,
141 $ nnb, nnb2, nns, nrhs, ntypes, nrank,
142 $ vers_major, vers_minor, vers_patch
143 REAL eps, s1, s2, threq, thresh
146 LOGICAL dotype( matmax )
147 INTEGER iwork( 25*nmax ), mval( maxin ),
148 $ nbval( maxin ), nbval2( maxin ),
149 $ nsval( maxin ), nval( maxin ), nxval( maxin ),
150 $ rankval( maxin ), piv( nmax )
153 INTEGER allocatestatus
154 REAL,
DIMENSION(:),
ALLOCATABLE :: rwork, s
155 REAL,
DIMENSION(:),
ALLOCATABLE :: e
156 REAL,
DIMENSION(:,:),
ALLOCATABLE :: a, b, work
180 INTEGER iparms( 100 )
183 COMMON / claenv / iparms
184 COMMON / infoc / infot, nunit, ok, lerr
185 COMMON / srnamc / srnamt
188 DATA threq / 2.0e0 / , intstr /
'0123456789' /
192 ALLOCATE ( a( ( kdmax+1 )*nmax, 7 ), stat = allocatestatus )
193 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
194 ALLOCATE ( b( nmax*maxrhs, 4 ), stat = allocatestatus )
195 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
196 ALLOCATE ( work( nmax, 3*nmax+maxrhs+30 ), stat = allocatestatus )
197 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
198 ALLOCATE ( e( nmax ), stat = allocatestatus )
199 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
200 ALLOCATE ( s( 2*nmax ), stat = allocatestatus )
201 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
202 ALLOCATE ( rwork( 5*nmax+2*maxrhs ), stat = allocatestatus )
203 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
217 CALL ilaver( vers_major, vers_minor, vers_patch )
218 WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
222 READ( nin, fmt = * )nm
224 WRITE( nout, fmt = 9996 )
' NM ', nm, 1
227 ELSE IF( nm.GT.maxin )
THEN
228 WRITE( nout, fmt = 9995 )
' NM ', nm, maxin
232 READ( nin, fmt = * )( mval( i ), i = 1, nm )
234 IF( mval( i ).LT.0 )
THEN
235 WRITE( nout, fmt = 9996 )
' M ', mval( i ), 0
237 ELSE IF( mval( i ).GT.nmax )
THEN
238 WRITE( nout, fmt = 9995 )
' M ', mval( i ), nmax
243 $
WRITE( nout, fmt = 9993 )
'M ', ( mval( i ), i = 1, nm )
247 READ( nin, fmt = * )nn
249 WRITE( nout, fmt = 9996 )
' NN ', nn, 1
252 ELSE IF( nn.GT.maxin )
THEN
253 WRITE( nout, fmt = 9995 )
' NN ', nn, maxin
257 READ( nin, fmt = * )( nval( i ), i = 1, nn )
259 IF( nval( i ).LT.0 )
THEN
260 WRITE( nout, fmt = 9996 )
' N ', nval( i ), 0
262 ELSE IF( nval( i ).GT.nmax )
THEN
263 WRITE( nout, fmt = 9995 )
' N ', nval( i ), nmax
268 $
WRITE( nout, fmt = 9993 )
'N ', ( nval( i ), i = 1, nn )
272 READ( nin, fmt = * )nns
274 WRITE( nout, fmt = 9996 )
' NNS', nns, 1
277 ELSE IF( nns.GT.maxin )
THEN
278 WRITE( nout, fmt = 9995 )
' NNS', nns, maxin
282 READ( nin, fmt = * )( nsval( i ), i = 1, nns )
284 IF( nsval( i ).LT.0 )
THEN
285 WRITE( nout, fmt = 9996 )
'NRHS', nsval( i ), 0
287 ELSE IF( nsval( i ).GT.maxrhs )
THEN
288 WRITE( nout, fmt = 9995 )
'NRHS', nsval( i ), maxrhs
293 $
WRITE( nout, fmt = 9993 )
'NRHS', ( nsval( i ), i = 1, nns )
297 READ( nin, fmt = * )nnb
299 WRITE( nout, fmt = 9996 )
'NNB ', nnb, 1
302 ELSE IF( nnb.GT.maxin )
THEN
303 WRITE( nout, fmt = 9995 )
'NNB ', nnb, maxin
307 READ( nin, fmt = * )( nbval( i ), i = 1, nnb )
309 IF( nbval( i ).LT.0 )
THEN
310 WRITE( nout, fmt = 9996 )
' NB ', nbval( i ), 0
315 $
WRITE( nout, fmt = 9993 )
'NB ', ( nbval( i ), i = 1, nnb )
323 IF( nb.EQ.nbval2( j ) )
332 READ( nin, fmt = * )( nxval( i ), i = 1, nnb )
334 IF( nxval( i ).LT.0 )
THEN
335 WRITE( nout, fmt = 9996 )
' NX ', nxval( i ), 0
340 $
WRITE( nout, fmt = 9993 )
'NX ', ( nxval( i ), i = 1, nnb )
344 READ( nin, fmt = * )nrank
346 WRITE( nout, fmt = 9996 )
' NRANK ', nrank, 1
349 ELSE IF( nn.GT.maxin )
THEN
350 WRITE( nout, fmt = 9995 )
' NRANK ', nrank, maxin
354 READ( nin, fmt = * )( rankval( i ), i = 1, nrank )
356 IF( rankval( i ).LT.0 )
THEN
357 WRITE( nout, fmt = 9996 )
' RANK ', rankval( i ), 0
359 ELSE IF( rankval( i ).GT.100 )
THEN
360 WRITE( nout, fmt = 9995 )
' RANK ', rankval( i ), 100
365 $
WRITE( nout, fmt = 9993 )
'RANK % OF N',
366 $ ( rankval( i ), i = 1, nrank )
370 READ( nin, fmt = * )thresh
371 WRITE( nout, fmt = 9992 )thresh
375 READ( nin, fmt = * )tstchk
379 READ( nin, fmt = * )tstdrv
383 READ( nin, fmt = * )tsterr
386 WRITE( nout, fmt = 9999 )
392 eps =
slamch(
'Underflow threshold' )
393 WRITE( nout, fmt = 9991 )
'underflow', eps
394 eps =
slamch(
'Overflow threshold' )
395 WRITE( nout, fmt = 9991 )
'overflow ', eps
397 WRITE( nout, fmt = 9991 )
'precision', eps
398 WRITE( nout, fmt = * )
404 READ( nin, fmt =
'(A72)',
END = 140 )aline
414 IF( aline( i: i ).EQ.
' ' )
420 IF( c1.EQ.intstr( k: k ) )
THEN
427 nmats = nmats*10 + ic
439 IF( .NOT.
lsame( c1,
'Single precision' ) )
THEN
440 WRITE( nout, fmt = 9990 )path
442 ELSE IF( nmats.LE.0 )
THEN
446 WRITE( nout, fmt = 9989 )path
448 ELSE IF(
lsamen( 2, c2,
'GE' ) )
THEN
453 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
456 CALL schkge( dotype, nm, mval, nn, nval, nnb2, nbval2, nns,
457 $ nsval, thresh, tsterr, lda, a( 1, 1 ),
458 $ a( 1, 2 ), a( 1, 3 ), b( 1, 1 ), b( 1, 2 ),
459 $ b( 1, 3 ), work, rwork, iwork, nout )
461 WRITE( nout, fmt = 9989 )path
465 CALL sdrvge( dotype, nn, nval, nrhs, thresh, tsterr, lda,
466 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
467 $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
468 $ rwork, iwork, nout )
470 WRITE( nout, fmt = 9988 )path
473 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
477 la = ( 2*kdmax+1 )*nmax
478 lafac = ( 3*kdmax+1 )*nmax
480 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
483 CALL schkgb( dotype, nm, mval, nn, nval, nnb2, nbval2, nns,
484 $ nsval, thresh, tsterr, a( 1, 1 ), la,
485 $ a( 1, 3 ), lafac, b( 1, 1 ), b( 1, 2 ),
486 $ b( 1, 3 ), work, rwork, iwork, nout )
488 WRITE( nout, fmt = 9989 )path
492 CALL sdrvgb( dotype, nn, nval, nrhs, thresh, tsterr,
493 $ a( 1, 1 ), la, a( 1, 3 ), lafac, a( 1, 6 ),
494 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s,
495 $ work, rwork, iwork, nout )
497 WRITE( nout, fmt = 9988 )path
500 ELSE IF(
lsamen( 2, c2,
'GT' ) )
THEN
505 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
508 CALL schkgt( dotype, nn, nval, nns, nsval, thresh, tsterr,
509 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
510 $ b( 1, 3 ), work, rwork, iwork, nout )
512 WRITE( nout, fmt = 9989 )path
516 CALL sdrvgt( dotype, nn, nval, nrhs, thresh, tsterr,
517 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
518 $ b( 1, 3 ), work, rwork, iwork, nout )
520 WRITE( nout, fmt = 9988 )path
523 ELSE IF(
lsamen( 2, c2,
'PO' ) )
THEN
528 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
531 CALL schkpo( dotype, nn, nval, nnb2, nbval2, nns, nsval,
532 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
533 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
534 $ work, rwork, iwork, nout )
536 WRITE( nout, fmt = 9989 )path
540 CALL sdrvpo( dotype, nn, nval, nrhs, thresh, tsterr, lda,
541 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
542 $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
543 $ rwork, iwork, nout )
545 WRITE( nout, fmt = 9988 )path
548 ELSE IF(
lsamen( 2, c2,
'PS' ) )
THEN
554 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
557 CALL schkps( dotype, nn, nval, nnb2, nbval2, nrank,
558 $ rankval, thresh, tsterr, lda, a( 1, 1 ),
559 $ a( 1, 2 ), a( 1, 3 ), piv, work, rwork,
562 WRITE( nout, fmt = 9989 )path
565 ELSE IF(
lsamen( 2, c2,
'PP' ) )
THEN
570 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
573 CALL schkpp( dotype, nn, nval, nns, nsval, thresh, tsterr,
574 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
575 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
578 WRITE( nout, fmt = 9989 )path
582 CALL sdrvpp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
583 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
584 $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
585 $ rwork, iwork, nout )
587 WRITE( nout, fmt = 9988 )path
590 ELSE IF(
lsamen( 2, c2,
'PB' ) )
THEN
595 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
598 CALL schkpb( dotype, nn, nval, nnb2, nbval2, nns, nsval,
599 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
600 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
601 $ work, rwork, iwork, nout )
603 WRITE( nout, fmt = 9989 )path
607 CALL sdrvpb( dotype, nn, nval, nrhs, thresh, tsterr, lda,
608 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
609 $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
610 $ rwork, iwork, nout )
612 WRITE( nout, fmt = 9988 )path
615 ELSE IF(
lsamen( 2, c2,
'PT' ) )
THEN
620 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
623 CALL schkpt( dotype, nn, nval, nns, nsval, thresh, tsterr,
624 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
625 $ b( 1, 2 ), b( 1, 3 ), work, rwork, nout )
627 WRITE( nout, fmt = 9989 )path
631 CALL sdrvpt( dotype, nn, nval, nrhs, thresh, tsterr,
632 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
633 $ b( 1, 2 ), b( 1, 3 ), work, rwork, nout )
635 WRITE( nout, fmt = 9988 )path
638 ELSE IF(
lsamen( 2, c2,
'SY' ) )
THEN
644 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
647 CALL schksy( dotype, nn, nval, nnb2, nbval2, nns, nsval,
648 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
649 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
650 $ work, rwork, iwork, nout )
652 WRITE( nout, fmt = 9989 )path
656 CALL sdrvsy( dotype, nn, nval, nrhs, thresh, tsterr, lda,
657 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
658 $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
661 WRITE( nout, fmt = 9988 )path
664 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
670 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
673 CALL schksy_rook(dotype, nn, nval, nnb2, nbval2, nns, nsval,
674 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
675 $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
676 $ work, rwork, iwork, nout )
678 WRITE( nout, fmt = 9989 )path
682 CALL sdrvsy_rook( dotype, nn, nval, nrhs, thresh, tsterr,
683 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
684 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
685 $ work, rwork, iwork, nout )
687 WRITE( nout, fmt = 9988 )path
690 ELSE IF(
lsamen( 2, c2,
'SK' ) )
THEN
697 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
700 CALL schksy_rk( dotype, nn, nval, nnb2, nbval2, nns, nsval,
701 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
702 $ e, a( 1, 3 ), b( 1, 1 ), b( 1, 2 ),
703 $ b( 1, 3 ), work, rwork, iwork, nout )
705 WRITE( nout, fmt = 9989 )path
709 CALL sdrvsy_rk( dotype, nn, nval, nrhs, thresh, tsterr,
710 $ lda, a( 1, 1 ), a( 1, 2 ), e, a( 1, 3 ),
711 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
712 $ work, rwork, iwork, nout )
714 WRITE( nout, fmt = 9988 )path
717 ELSE IF(
lsamen( 2, c2,
'SA' ) )
THEN
723 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
726 CALL schksy_aa( dotype, nn, nval, nnb2, nbval2, nns,
727 $ nsval, thresh, tsterr, lda,
728 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
729 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
730 $ work, rwork, iwork, nout )
732 WRITE( nout, fmt = 9989 )path
736 CALL sdrvsy_aa( dotype, nn, nval, nrhs, thresh, tsterr,
737 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
738 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
739 $ work, rwork, iwork, nout )
741 WRITE( nout, fmt = 9988 )path
744 ELSE IF(
lsamen( 2, c2,
'S2' ) )
THEN
750 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
754 $ nns, nsval, thresh, tsterr, lda,
755 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
756 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
757 $ work, rwork, iwork, nout )
759 WRITE( nout, fmt = 9989 )path
764 $ dotype, nn, nval, nrhs, thresh, tsterr,
765 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
766 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
767 $ work, rwork, iwork, nout )
769 WRITE( nout, fmt = 9988 )path
772 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
778 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
781 CALL schksp( dotype, nn, nval, nns, nsval, thresh, tsterr,
782 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
783 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
786 WRITE( nout, fmt = 9989 )path
790 CALL sdrvsp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
791 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
792 $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
795 WRITE( nout, fmt = 9988 )path
798 ELSE IF(
lsamen( 2, c2,
'TR' ) )
THEN
803 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
806 CALL schktr( dotype, nn, nval, nnb2, nbval2, nns, nsval,
807 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
808 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), work, rwork,
811 WRITE( nout, fmt = 9989 )path
814 ELSE IF(
lsamen( 2, c2,
'TP' ) )
THEN
819 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
822 CALL schktp( dotype, nn, nval, nns, nsval, thresh, tsterr,
823 $ lda, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
824 $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
827 WRITE( nout, fmt = 9989 )path
830 ELSE IF(
lsamen( 2, c2,
'TB' ) )
THEN
835 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
838 CALL schktb( dotype, nn, nval, nns, nsval, thresh, tsterr,
839 $ lda, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
840 $ b( 1, 2 ), b( 1, 3 ), work, rwork, iwork,
843 WRITE( nout, fmt = 9989 )path
846 ELSE IF(
lsamen( 2, c2,
'QR' ) )
THEN
851 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
854 CALL schkqr( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
855 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
856 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
857 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
858 $ work, rwork, iwork, nout )
860 WRITE( nout, fmt = 9989 )path
863 ELSE IF(
lsamen( 2, c2,
'LQ' ) )
THEN
868 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
871 CALL schklq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
872 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
873 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
874 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
875 $ work, rwork, nout )
877 WRITE( nout, fmt = 9989 )path
880 ELSE IF(
lsamen( 2, c2,
'QL' ) )
THEN
885 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
888 CALL schkql( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
889 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
890 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
891 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
892 $ work, rwork, nout )
894 WRITE( nout, fmt = 9989 )path
897 ELSE IF(
lsamen( 2, c2,
'RQ' ) )
THEN
902 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
905 CALL schkrq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
906 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
907 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
908 $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
909 $ work, rwork, iwork, nout )
911 WRITE( nout, fmt = 9989 )path
914 ELSE IF(
lsamen( 2, c2,
'QP' ) )
THEN
919 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
922 CALL schkq3( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
923 $ thresh, a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
924 $ b( 1, 3 ), work, iwork, nout )
926 WRITE( nout, fmt = 9989 )path
929 ELSE IF(
lsamen( 2, c2,
'QK' ) )
THEN
934 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
937 CALL schkqp3rk( dotype, nm, mval, nn, nval, nns, nsval,
938 $ nnb, nbval, nxval, thresh, a( 1, 1 ),
939 $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
940 $ b( 1, 3 ), b( 1, 4 ),
941 $ work, iwork, nout )
943 WRITE( nout, fmt = 9989 )path
946 ELSE IF(
lsamen( 2, c2,
'TZ' ) )
THEN
951 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
954 CALL schktz( dotype, nm, mval, nn, nval, thresh, tsterr,
955 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ),
956 $ b( 1, 3 ), work, nout )
958 WRITE( nout, fmt = 9989 )path
961 ELSE IF(
lsamen( 2, c2,
'LS' ) )
THEN
966 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
969 CALL sdrvls( dotype, nm, mval, nn, nval, nns, nsval, nnb,
970 $ nbval, nxval, thresh, tsterr, a( 1, 1 ),
971 $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
972 $ rwork, rwork( nmax+1 ), nout )
974 WRITE( nout, fmt = 9988 )path
977 ELSE IF(
lsamen( 2, c2,
'EQ' ) )
THEN
983 CALL schkeq( threq, nout )
985 WRITE( nout, fmt = 9989 )path
988 ELSE IF(
lsamen( 2, c2,
'QT' ) )
THEN
993 CALL schkqrt( thresh, tsterr, nm, mval, nn, nval, nnb,
996 WRITE( nout, fmt = 9989 )path
999 ELSE IF(
lsamen( 2, c2,
'QX' ) )
THEN
1004 CALL schkqrtp( thresh, tsterr, nm, mval, nn, nval, nnb,
1007 WRITE( nout, fmt = 9989 )path
1010 ELSE IF(
lsamen( 2, c2,
'TQ' ) )
THEN
1015 CALL schklqt( thresh, tsterr, nm, mval, nn, nval, nnb,
1018 WRITE( nout, fmt = 9989 )path
1021 ELSE IF(
lsamen( 2, c2,
'XQ' ) )
THEN
1026 CALL schklqtp( thresh, tsterr, nm, mval, nn, nval, nnb,
1029 WRITE( nout, fmt = 9989 )path
1032 ELSE IF(
lsamen( 2, c2,
'TS' ) )
THEN
1037 CALL schktsqr( thresh, tsterr, nm, mval, nn, nval, nnb,
1040 WRITE( nout, fmt = 9989 )path
1043 ELSE IF(
lsamen( 2, c2,
'HH' ) )
THEN
1048 CALL schkorhr_col( thresh, tsterr, nm, mval, nn, nval, nnb,
1051 WRITE( nout, fmt = 9989 ) path
1056 WRITE( nout, fmt = 9990 )path
1068 WRITE( nout, fmt = 9998 )
1069 WRITE( nout, fmt = 9997 )s2 - s1
1071 DEALLOCATE (a, stat = allocatestatus)
1072 DEALLOCATE (b, stat = allocatestatus)
1073 DEALLOCATE (work, stat = allocatestatus)
1074 DEALLOCATE (rwork, stat = allocatestatus)
1076 9999
FORMAT( /
' Execution not attempted due to input errors' )
1077 9998
FORMAT( /
' End of tests' )
1078 9997
FORMAT(
' Total time used = ', f12.2,
' seconds', / )
1079 9996
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be >=',
1081 9995
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be <=',
1083 9994
FORMAT(
' Tests of the REAL LAPACK routines ',
1084 $ /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1,
1085 $ / /
' The following parameter values will be used:' )
1086 9993
FORMAT( 4x, a4,
': ', 10i6, / 11x, 10i6 )
1087 9992
FORMAT( /
' Routines pass computational tests if test ratio is ',
1088 $
'less than', f8.2, / )
1089 9991
FORMAT(
' Relative machine ', a,
' is taken to be', e16.6 )
1090 9990
FORMAT( / 1x, a3,
': Unrecognized path name' )
1091 9989
FORMAT( / 1x, a3,
' routines were not tested' )
1092 9988
FORMAT( / 1x, a3,
' driver routines were not tested' )
subroutine alareq(path, nmats, dotype, ntypes, nin, nout)
ALAREQ
subroutine ilaver(vers_major, vers_minor, vers_patch)
ILAVER returns the LAPACK version.
real function slamch(cmach)
SLAMCH
logical function lsame(ca, cb)
LSAME
logical function lsamen(n, ca, cb)
LSAMEN
real function second()
SECOND Using ETIME
subroutine schkeq(thresh, nout)
SCHKEQ
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
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
subroutine schkgt(dotype, nn, nval, nns, nsval, thresh, tsterr, a, af, b, x, xact, work, rwork, iwork, nout)
SCHKGT
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
subroutine schklqt(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
SCHKLQT
subroutine schklqtp(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
SCHKLQTP
subroutine schkorhr_col(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
SCHKORHR_COL
subroutine schkpb(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKPB
subroutine schkpo(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKPO
subroutine schkpp(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKPP
subroutine schkps(dotype, nn, nval, nnb, nbval, nrank, rankval, thresh, tsterr, nmax, a, afac, perm, piv, work, rwork, nout)
SCHKPS
subroutine schkpt(dotype, nn, nval, nns, nsval, thresh, tsterr, a, d, e, b, x, xact, work, rwork, nout)
SCHKPT
subroutine schkq3(dotype, nm, mval, nn, nval, nnb, nbval, nxval, thresh, a, copya, s, tau, work, iwork, nout)
SCHKQ3
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
subroutine schkqp3rk(dotype, nm, mval, nn, nval, nns, nsval, nnb, nbval, nxval, thresh, a, copya, b, copyb, s, tau, work, iwork, nout)
SCHKQP3RK
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
subroutine schkqrt(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
SCHKQRT
subroutine schkqrtp(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
SCHKQRTP
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
subroutine schksp(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKSP
subroutine schksy(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKSY
subroutine schksy_aa(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKSY_AA
subroutine schksy_aa_2stage(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKSY_AA_2STAGE
subroutine schksy_rk(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, e, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKSY_RK
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
subroutine schktb(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, ab, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKTB
subroutine schktp(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, ap, ainvp, b, x, xact, work, rwork, iwork, nout)
SCHKTP
subroutine schktr(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, ainv, b, x, xact, work, rwork, iwork, nout)
SCHKTR
subroutine schktsqr(thresh, tsterr, nm, mval, nn, nval, nnb, nbval, nout)
SCHKQRT
subroutine schktz(dotype, nm, mval, nn, nval, thresh, tsterr, a, copya, s, tau, work, nout)
SCHKTZ
subroutine sdrvgb(dotype, nn, nval, nrhs, thresh, tsterr, a, la, afb, lafb, asav, b, bsav, x, xact, s, work, rwork, iwork, nout)
SDRVGB
subroutine sdrvge(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, iwork, nout)
SDRVGE
subroutine sdrvgt(dotype, nn, nval, nrhs, thresh, tsterr, a, af, b, x, xact, work, rwork, iwork, nout)
SDRVGT
subroutine sdrvls(dotype, nm, mval, nn, nval, nns, nsval, nnb, nbval, nxval, thresh, tsterr, a, copya, b, copyb, c, s, copys, nout)
SDRVLS
subroutine sdrvpb(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, iwork, nout)
SDRVPB
subroutine sdrvpo(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, iwork, nout)
SDRVPO
subroutine sdrvpp(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, iwork, nout)
SDRVPP
subroutine sdrvpt(dotype, nn, nval, nrhs, thresh, tsterr, a, d, e, b, x, xact, work, rwork, nout)
SDRVPT
subroutine sdrvsp(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SDRVSP
subroutine sdrvsy(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SDRVSY
subroutine sdrvsy_aa(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SDRVSY_AA
subroutine sdrvsy_aa_2stage(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SDRVSY_AA_2STAGE
subroutine sdrvsy_rk(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, e, ainv, b, x, xact, work, rwork, iwork, nout)
SDRVSY_RK
subroutine sdrvsy_rook(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
SDRVSY_ROOK