118 parameter( nmax = 132 )
120 parameter( maxin = 12 )
122 parameter( maxrhs = 16 )
124 parameter( matmax = 30 )
126 parameter( nin = 5, nout = 6 )
128 parameter( kdmax = nmax+( nmax+1 ) / 4 )
131 LOGICAL fatal, tstchk, tstdrv, tsterr
137 INTEGER i, ic,
j, k, la, lafac, lda, nb, nm, nmats, nn,
138 $ nnb, nnb2, nns, nrhs, ntypes, nrank,
139 $ vers_major, vers_minor, vers_patch
140 REAL eps, s1, s2, threq, thresh
143 LOGICAL dotype( matmax )
144 INTEGER iwork( 25*nmax ), mval( maxin ),
145 $ nbval( maxin ), nbval2( maxin ),
146 $ nsval( maxin ), nval( maxin ), nxval( maxin ),
147 $ rankval( maxin ), piv( nmax )
148 REAL a( ( kdmax+1 )*nmax, 7 ),
b( nmax*maxrhs, 4 ),
149 $ rwork( 5*nmax+2*maxrhs ), s( 2*nmax ),
150 $ work( nmax, nmax+maxrhs+30 )
172 INTEGER iparms( 100 )
175 COMMON / claenv / iparms
176 COMMON / infoc / infot, nunit, ok, lerr
177 COMMON / srnamc / srnamt
180 DATA threq / 2.0e0 / , intstr /
'0123456789' /
194 CALL
ilaver( vers_major, vers_minor, vers_patch )
195 WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
199 READ( nin, fmt = * )nm
201 WRITE( nout, fmt = 9996 )
' NM ', nm, 1
204 ELSE IF( nm.GT.maxin )
THEN
205 WRITE( nout, fmt = 9995 )
' NM ', nm, maxin
209 READ( nin, fmt = * )( mval( i ), i = 1, nm )
211 IF( mval( i ).LT.0 )
THEN
212 WRITE( nout, fmt = 9996 )
' M ', mval( i ), 0
214 ELSE IF( mval( i ).GT.nmax )
THEN
215 WRITE( nout, fmt = 9995 )
' M ', mval( i ), nmax
220 $
WRITE( nout, fmt = 9993 )
'M ', ( mval( i ), i = 1, nm )
224 READ( nin, fmt = * )nn
226 WRITE( nout, fmt = 9996 )
' NN ', nn, 1
229 ELSE IF( nn.GT.maxin )
THEN
230 WRITE( nout, fmt = 9995 )
' NN ', nn, maxin
234 READ( nin, fmt = * )( nval( i ), i = 1, nn )
236 IF( nval( i ).LT.0 )
THEN
237 WRITE( nout, fmt = 9996 )
' N ', nval( i ), 0
239 ELSE IF( nval( i ).GT.nmax )
THEN
240 WRITE( nout, fmt = 9995 )
' N ', nval( i ), nmax
245 $
WRITE( nout, fmt = 9993 )
'N ', ( nval( i ), i = 1, nn )
249 READ( nin, fmt = * )nns
251 WRITE( nout, fmt = 9996 )
' NNS', nns, 1
254 ELSE IF( nns.GT.maxin )
THEN
255 WRITE( nout, fmt = 9995 )
' NNS', nns, maxin
259 READ( nin, fmt = * )( nsval( i ), i = 1, nns )
261 IF( nsval( i ).LT.0 )
THEN
262 WRITE( nout, fmt = 9996 )
'NRHS', nsval( i ), 0
264 ELSE IF( nsval( i ).GT.maxrhs )
THEN
265 WRITE( nout, fmt = 9995 )
'NRHS', nsval( i ), maxrhs
270 $
WRITE( nout, fmt = 9993 )
'NRHS', ( nsval( i ), i = 1, nns )
274 READ( nin, fmt = * )nnb
276 WRITE( nout, fmt = 9996 )
'NNB ', nnb, 1
279 ELSE IF( nnb.GT.maxin )
THEN
280 WRITE( nout, fmt = 9995 )
'NNB ', nnb, maxin
284 READ( nin, fmt = * )( nbval( i ), i = 1, nnb )
286 IF( nbval( i ).LT.0 )
THEN
287 WRITE( nout, fmt = 9996 )
' NB ', nbval( i ), 0
292 $
WRITE( nout, fmt = 9993 )
'NB ', ( nbval( i ), i = 1, nnb )
300 IF( nb.EQ.nbval2(
j ) )
309 READ( nin, fmt = * )( nxval( i ), i = 1, nnb )
311 IF( nxval( i ).LT.0 )
THEN
312 WRITE( nout, fmt = 9996 )
' NX ', nxval( i ), 0
317 $
WRITE( nout, fmt = 9993 )
'NX ', ( nxval( i ), i = 1, nnb )
321 READ( nin, fmt = * )nrank
323 WRITE( nout, fmt = 9996 )
' NRANK ', nrank, 1
326 ELSE IF( nn.GT.maxin )
THEN
327 WRITE( nout, fmt = 9995 )
' NRANK ', nrank, maxin
331 READ( nin, fmt = * )( rankval( i ), i = 1, nrank )
333 IF( rankval( i ).LT.0 )
THEN
334 WRITE( nout, fmt = 9996 )
' RANK ', rankval( i ), 0
336 ELSE IF( rankval( i ).GT.100 )
THEN
337 WRITE( nout, fmt = 9995 )
' RANK ', rankval( i ), 100
342 $
WRITE( nout, fmt = 9993 )
'RANK % OF N',
343 $ ( rankval( i ), i = 1, nrank )
347 READ( nin, fmt = * )thresh
348 WRITE( nout, fmt = 9992 )thresh
352 READ( nin, fmt = * )tstchk
356 READ( nin, fmt = * )tstdrv
360 READ( nin, fmt = * )tsterr
363 WRITE( nout, fmt = 9999 )
369 eps =
slamch(
'Underflow threshold' )
370 WRITE( nout, fmt = 9991 )
'underflow', eps
371 eps =
slamch(
'Overflow threshold' )
372 WRITE( nout, fmt = 9991 )
'overflow ', eps
374 WRITE( nout, fmt = 9991 )
'precision', eps
375 WRITE( nout, fmt = * )
381 READ( nin, fmt =
'(A72)',
END = 140 )aline
391 IF( aline( i: i ).EQ.
' ' )
397 IF( c1.EQ.intstr( k: k ) )
THEN
404 nmats = nmats*10 + ic
416 IF( .NOT.
lsame( c1,
'Single precision' ) )
THEN
417 WRITE( nout, fmt = 9990 )path
419 ELSE IF( nmats.LE.0 )
THEN
423 WRITE( nout, fmt = 9989 )path
425 ELSE IF(
lsamen( 2, c2,
'GE' ) )
THEN
430 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
433 CALL
schkge( dotype, nm, mval, nn, nval, nnb2, nbval2, nns,
434 $ nsval, thresh, tsterr, lda, a( 1, 1 ),
435 $ a( 1, 2 ), a( 1, 3 ),
b( 1, 1 ),
b( 1, 2 ),
436 $
b( 1, 3 ), work, rwork, iwork, nout )
438 WRITE( nout, fmt = 9989 )path
442 CALL
sdrvge( dotype, nn, nval, nrhs, thresh, tsterr, lda,
443 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
b( 1, 1 ),
444 $
b( 1, 2 ),
b( 1, 3 ),
b( 1, 4 ), s, work,
445 $ rwork, iwork, nout )
447 WRITE( nout, fmt = 9988 )path
450 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
454 la = ( 2*kdmax+1 )*nmax
455 lafac = ( 3*kdmax+1 )*nmax
457 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
460 CALL
schkgb( dotype, nm, mval, nn, nval, nnb2, nbval2, nns,
461 $ nsval, thresh, tsterr, a( 1, 1 ), la,
462 $ a( 1, 3 ), lafac,
b( 1, 1 ),
b( 1, 2 ),
463 $
b( 1, 3 ), work, rwork, iwork, nout )
465 WRITE( nout, fmt = 9989 )path
469 CALL
sdrvgb( dotype, nn, nval, nrhs, thresh, tsterr,
470 $ a( 1, 1 ), la, a( 1, 3 ), lafac, a( 1, 6 ),
471 $
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
b( 1, 4 ), s,
472 $ work, rwork, iwork, nout )
474 WRITE( nout, fmt = 9988 )path
477 ELSE IF(
lsamen( 2, c2,
'GT' ) )
THEN
482 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
485 CALL
schkgt( dotype, nn, nval, nns, nsval, thresh, tsterr,
486 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
b( 1, 2 ),
487 $
b( 1, 3 ), work, rwork, iwork, nout )
489 WRITE( nout, fmt = 9989 )path
493 CALL
sdrvgt( dotype, nn, nval, nrhs, thresh, tsterr,
494 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
b( 1, 2 ),
495 $
b( 1, 3 ), work, rwork, iwork, nout )
497 WRITE( nout, fmt = 9988 )path
500 ELSE IF(
lsamen( 2, c2,
'PO' ) )
THEN
505 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
508 CALL
schkpo( dotype, nn, nval, nnb2, nbval2, nns, nsval,
509 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
510 $ a( 1, 3 ),
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
511 $ work, rwork, iwork, nout )
513 WRITE( nout, fmt = 9989 )path
517 CALL
sdrvpo( dotype, nn, nval, nrhs, thresh, tsterr, lda,
518 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
b( 1, 1 ),
519 $
b( 1, 2 ),
b( 1, 3 ),
b( 1, 4 ), s, work,
520 $ rwork, iwork, nout )
522 WRITE( nout, fmt = 9988 )path
525 ELSE IF(
lsamen( 2, c2,
'PS' ) )
THEN
531 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
534 CALL
schkps( dotype, nn, nval, nnb2, nbval2, nrank,
535 $ rankval, thresh, tsterr, lda, a( 1, 1 ),
536 $ a( 1, 2 ), a( 1, 3 ), piv, work, rwork,
539 WRITE( nout, fmt = 9989 )path
542 ELSE IF(
lsamen( 2, c2,
'PP' ) )
THEN
547 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
550 CALL
schkpp( dotype, nn, nval, nns, nsval, thresh, tsterr,
551 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
552 $
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ), work, rwork,
555 WRITE( nout, fmt = 9989 )path
559 CALL
sdrvpp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
560 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
b( 1, 1 ),
561 $
b( 1, 2 ),
b( 1, 3 ),
b( 1, 4 ), s, work,
562 $ rwork, iwork, nout )
564 WRITE( nout, fmt = 9988 )path
567 ELSE IF(
lsamen( 2, c2,
'PB' ) )
THEN
572 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
575 CALL
schkpb( dotype, nn, nval, nnb2, nbval2, nns, nsval,
576 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
577 $ a( 1, 3 ),
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
578 $ work, rwork, iwork, nout )
580 WRITE( nout, fmt = 9989 )path
584 CALL
sdrvpb( dotype, nn, nval, nrhs, thresh, tsterr, lda,
585 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
b( 1, 1 ),
586 $
b( 1, 2 ),
b( 1, 3 ),
b( 1, 4 ), s, work,
587 $ rwork, iwork, nout )
589 WRITE( nout, fmt = 9988 )path
592 ELSE IF(
lsamen( 2, c2,
'PT' ) )
THEN
597 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
600 CALL
schkpt( dotype, nn, nval, nns, nsval, thresh, tsterr,
601 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
b( 1, 1 ),
602 $
b( 1, 2 ),
b( 1, 3 ), work, rwork, nout )
604 WRITE( nout, fmt = 9989 )path
608 CALL
sdrvpt( dotype, nn, nval, nrhs, thresh, tsterr,
609 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
b( 1, 1 ),
610 $
b( 1, 2 ),
b( 1, 3 ), work, rwork, nout )
612 WRITE( nout, fmt = 9988 )path
615 ELSE IF(
lsamen( 2, c2,
'SY' ) )
THEN
621 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
624 CALL
schksy( dotype, nn, nval, nnb2, nbval2, nns, nsval,
625 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
626 $ a( 1, 3 ),
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
627 $ work, rwork, iwork, nout )
629 WRITE( nout, fmt = 9989 )path
633 CALL
sdrvsy( dotype, nn, nval, nrhs, thresh, tsterr, lda,
634 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
b( 1, 1 ),
635 $
b( 1, 2 ),
b( 1, 3 ), work, rwork, iwork,
638 WRITE( nout, fmt = 9988 )path
641 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
647 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
650 CALL
schksy_rook(dotype, nn, nval, nnb2, nbval2, nns, nsval,
651 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
652 $ a( 1, 3 ),
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
653 $ work, rwork, iwork, nout )
655 WRITE( nout, fmt = 9989 )path
659 CALL
sdrvsy_rook( dotype, nn, nval, nrhs, thresh, tsterr,
660 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
661 $
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
662 $ work, rwork, iwork, nout )
664 WRITE( nout, fmt = 9988 )path
667 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
673 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
676 CALL
schksp( dotype, nn, nval, nns, nsval, thresh, tsterr,
677 $ lda, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
678 $
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ), work, rwork,
681 WRITE( nout, fmt = 9989 )path
685 CALL
sdrvsp( dotype, nn, nval, nrhs, thresh, tsterr, lda,
686 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
b( 1, 1 ),
687 $
b( 1, 2 ),
b( 1, 3 ), work, rwork, iwork,
690 WRITE( nout, fmt = 9988 )path
693 ELSE IF(
lsamen( 2, c2,
'TR' ) )
THEN
698 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
701 CALL
schktr( dotype, nn, nval, nnb2, nbval2, nns, nsval,
702 $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
703 $
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ), work, rwork,
706 WRITE( nout, fmt = 9989 )path
709 ELSE IF(
lsamen( 2, c2,
'TP' ) )
THEN
714 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
717 CALL
schktp( dotype, nn, nval, nns, nsval, thresh, tsterr,
718 $ lda, a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
719 $
b( 1, 2 ),
b( 1, 3 ), work, rwork, iwork,
722 WRITE( nout, fmt = 9989 )path
725 ELSE IF(
lsamen( 2, c2,
'TB' ) )
THEN
730 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
733 CALL
schktb( dotype, nn, nval, nns, nsval, thresh, tsterr,
734 $ lda, a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
735 $
b( 1, 2 ),
b( 1, 3 ), work, rwork, iwork,
738 WRITE( nout, fmt = 9989 )path
741 ELSE IF(
lsamen( 2, c2,
'QR' ) )
THEN
746 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
749 CALL
schkqr( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
750 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
751 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
752 $
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
b( 1, 4 ),
753 $ work, rwork, iwork, nout )
755 WRITE( nout, fmt = 9989 )path
758 ELSE IF(
lsamen( 2, c2,
'LQ' ) )
THEN
763 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
766 CALL
schklq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
767 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
768 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
769 $
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
b( 1, 4 ),
770 $ work, rwork, nout )
772 WRITE( nout, fmt = 9989 )path
775 ELSE IF(
lsamen( 2, c2,
'QL' ) )
THEN
780 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
783 CALL
schkql( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
784 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
785 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
786 $
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
b( 1, 4 ),
787 $ work, rwork, nout )
789 WRITE( nout, fmt = 9989 )path
792 ELSE IF(
lsamen( 2, c2,
'RQ' ) )
THEN
797 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
800 CALL
schkrq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
801 $ nrhs, thresh, tsterr, nmax, a( 1, 1 ),
802 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
803 $
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
b( 1, 4 ),
804 $ work, rwork, iwork, nout )
806 WRITE( nout, fmt = 9989 )path
809 ELSE IF(
lsamen( 2, c2,
'QP' ) )
THEN
814 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
817 CALL
schkqp( dotype, nm, mval, nn, nval, thresh, tsterr,
818 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
819 $
b( 1, 3 ), work, iwork, nout )
820 CALL
schkq3( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
821 $ thresh, a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
822 $
b( 1, 3 ), work, iwork, nout )
824 WRITE( nout, fmt = 9989 )path
827 ELSE IF(
lsamen( 2, c2,
'TZ' ) )
THEN
832 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
835 CALL
schktz( dotype, nm, mval, nn, nval, thresh, tsterr,
836 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
837 $
b( 1, 3 ), work, nout )
839 WRITE( nout, fmt = 9989 )path
842 ELSE IF(
lsamen( 2, c2,
'LS' ) )
THEN
847 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
850 CALL
sdrvls( dotype, nm, mval, nn, nval, nns, nsval, nnb,
851 $ nbval, nxval, thresh, tsterr, a( 1, 1 ),
852 $ a( 1, 2 ),
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
853 $ rwork, rwork( nmax+1 ), work, iwork, nout )
855 WRITE( nout, fmt = 9988 )path
858 ELSE IF(
lsamen( 2, c2,
'EQ' ) )
THEN
864 CALL
schkeq( threq, nout )
866 WRITE( nout, fmt = 9989 )path
869 ELSE IF(
lsamen( 2, c2,
'QT' ) )
THEN
874 CALL
schkqrt( thresh, tsterr, nm, mval, nn, nval, nnb,
877 WRITE( nout, fmt = 9989 )path
880 ELSE IF(
lsamen( 2, c2,
'QX' ) )
THEN
885 CALL
schkqrtp( thresh, tsterr, nm, mval, nn, nval, nnb,
888 WRITE( nout, fmt = 9989 )path
893 WRITE( nout, fmt = 9990 )path
905 WRITE( nout, fmt = 9998 )
906 WRITE( nout, fmt = 9997 )s2 - s1
908 9999
FORMAT( /
' Execution not attempted due to input errors' )
909 9998
FORMAT( /
' End of tests' )
910 9997
FORMAT(
' Total time used = ', f12.2,
' seconds', / )
911 9996
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be >=',
913 9995
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be <=',
915 9994
FORMAT(
' Tests of the REAL LAPACK routines ',
916 $ /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1,
917 $ / /
' The following parameter values will be used:' )
918 9993
FORMAT( 4x, a4,
': ', 10i6, / 11x, 10i6 )
919 9992
FORMAT( /
' Routines pass computational tests if test ratio is ',
920 $
'less than', f8.2, / )
921 9991
FORMAT(
' Relative machine ', a,
' is taken to be', e16.6 )
922 9990
FORMAT( / 1x, a3,
': Unrecognized path name' )
923 9989
FORMAT( / 1x, a3,
' routines were not tested' )
924 9988
FORMAT( / 1x, a3,
' driver routines were not tested' )