451 SUBROUTINE sdrvst( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
452 $ nounit, a, lda, d1, d2, d3, d4, eveigs, wa1,
453 $ wa2, wa3, u, ldu, v, tau, z, work, lwork,
454 $ iwork, liwork, result, info )
462 INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
468 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
469 REAL A( lda, * ), D1( * ), D2( * ), D3( * ),
470 $ d4( * ), eveigs( * ), result( * ), tau( * ),
471 $ u( ldu, * ), v( ldu, * ), wa1( * ), wa2( * ),
472 $ wa3( * ), work( * ), z( ldu, * )
478 REAL ZERO, ONE, TWO, TEN
479 parameter ( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
482 parameter ( half = 0.5e0 )
484 parameter ( maxtyp = 18 )
489 INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW,
490 $ itemp, itype, iu, iuplo, j, j1, j2, jcol,
491 $ jsize, jtype, kd, lgn, liwedc, lwedc, m, m2,
492 $ m3, mtypes, n, nerrs, nmats, nmax, ntest,
494 REAL ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
495 $ rtunfl, temp1, temp2, temp3, ulp, ulpinv, unfl,
499 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
500 $ iseed3( 4 ), kmagn( maxtyp ), kmode( maxtyp ),
504 REAL SLAMCH, SLARND, SSXT1
505 EXTERNAL slamch, slarnd, ssxt1
518 COMMON / srnamc / srnamt
521 INTRINSIC abs, int, log, max, min,
REAL, SQRT
524 DATA ktype / 1, 2, 5*4, 5*5, 3*8, 3*9 /
525 DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
527 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
545 nmax = max( nmax, nn( j ) )
552 IF( nsizes.LT.0 )
THEN
554 ELSE IF( badnn )
THEN
556 ELSE IF( ntypes.LT.0 )
THEN
558 ELSE IF( lda.LT.nmax )
THEN
560 ELSE IF( ldu.LT.nmax )
THEN
562 ELSE IF( 2*max( 2, nmax )**2.GT.lwork )
THEN
567 CALL xerbla(
'SDRVST', -info )
573 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
578 unfl = slamch(
'Safe minimum' )
579 ovfl = slamch(
'Overflow' )
581 ulp = slamch(
'Epsilon' )*slamch(
'Base' )
583 rtunfl = sqrt( unfl )
584 rtovfl = sqrt( ovfl )
589 iseed2( i ) = iseed( i )
590 iseed3( i ) = iseed( i )
597 DO 1740 jsize = 1, nsizes
600 lgn = int( log(
REAL( N ) ) / log( TWO ) )
605 lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
613 aninv = one /
REAL( MAX( 1, N ) )
615 IF( nsizes.NE.1 )
THEN
616 mtypes = min( maxtyp, ntypes )
618 mtypes = min( maxtyp+1, ntypes )
621 DO 1730 jtype = 1, mtypes
623 IF( .NOT.dotype( jtype ) )
629 ioldsd( j ) = iseed( j )
647 IF( mtypes.GT.maxtyp )
650 itype = ktype( jtype )
651 imode = kmode( jtype )
655 GO TO ( 40, 50, 60 )kmagn( jtype )
662 anorm = ( rtovfl*ulp )*aninv
666 anorm = rtunfl*n*ulpinv
671 CALL slaset(
'Full', lda, n, zero, zero, a, lda )
679 IF( itype.EQ.1 )
THEN
682 ELSE IF( itype.EQ.2 )
THEN
687 a( jcol, jcol ) = anorm
690 ELSE IF( itype.EQ.4 )
THEN
694 CALL slatms( n, n,
'S', iseed,
'S', work, imode, cond,
695 $ anorm, 0, 0,
'N', a, lda, work( n+1 ),
698 ELSE IF( itype.EQ.5 )
THEN
702 CALL slatms( n, n,
'S', iseed,
'S', work, imode, cond,
703 $ anorm, n, n,
'N', a, lda, work( n+1 ),
706 ELSE IF( itype.EQ.7 )
THEN
711 CALL slatmr( n, n,
'S', iseed,
'S', work, 6, one, one,
712 $
'T',
'N', work( n+1 ), 1, one,
713 $ work( 2*n+1 ), 1, one,
'N', idumma, 0, 0,
714 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
716 ELSE IF( itype.EQ.8 )
THEN
721 CALL slatmr( n, n,
'S', iseed,
'S', work, 6, one, one,
722 $
'T',
'N', work( n+1 ), 1, one,
723 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
724 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
726 ELSE IF( itype.EQ.9 )
THEN
730 ihbw = int( ( n-1 )*slarnd( 1, iseed3 ) )
731 CALL slatms( n, n,
'S', iseed,
'S', work, imode, cond,
732 $ anorm, ihbw, ihbw,
'Z', u, ldu, work( n+1 ),
737 CALL slaset(
'Full', lda, n, zero, zero, a, lda )
738 DO 100 idiag = -ihbw, ihbw
739 irow = ihbw - idiag + 1
740 j1 = max( 1, idiag+1 )
741 j2 = min( n, n+idiag )
744 a( i, j ) = u( irow, j )
751 IF( iinfo.NE.0 )
THEN
752 WRITE( nounit, fmt = 9999 )
'Generator', iinfo, n, jtype,
765 il = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
766 iu = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
776 IF( jtype.LE.7 )
THEN
779 d1( i ) =
REAL( A( I, I ) )
782 d2( i ) =
REAL( A( I+1, I ) )
785 CALL sstev(
'V', n, d1, d2, z, ldu, work, iinfo )
786 IF( iinfo.NE.0 )
THEN
787 WRITE( nounit, fmt = 9999 )
'SSTEV(V)', iinfo, n,
790 IF( iinfo.LT.0 )
THEN
803 d3( i ) =
REAL( A( I, I ) )
806 d4( i ) =
REAL( A( I+1, I ) )
808 CALL sstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
813 d4( i ) =
REAL( A( I+1, I ) )
816 CALL sstev(
'N', n, d3, d4, z, ldu, work, iinfo )
817 IF( iinfo.NE.0 )
THEN
818 WRITE( nounit, fmt = 9999 )
'SSTEV(N)', iinfo, n,
821 IF( iinfo.LT.0 )
THEN
834 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
835 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
837 result( 3 ) = temp2 / max( unfl,
838 $ ulp*max( temp1, temp2 ) )
844 eveigs( i ) = d3( i )
845 d1( i ) =
REAL( A( I, I ) )
848 d2( i ) =
REAL( A( I+1, I ) )
851 CALL sstevx(
'V',
'A', n, d1, d2, vl, vu, il, iu, abstol,
852 $ m, wa1, z, ldu, work, iwork, iwork( 5*n+1 ),
854 IF( iinfo.NE.0 )
THEN
855 WRITE( nounit, fmt = 9999 )
'SSTEVX(V,A)', iinfo, n,
858 IF( iinfo.LT.0 )
THEN
868 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
876 d3( i ) =
REAL( A( I, I ) )
879 d4( i ) =
REAL( A( I+1, I ) )
881 CALL sstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
886 d4( i ) =
REAL( A( I+1, I ) )
889 CALL sstevx(
'N',
'A', n, d3, d4, vl, vu, il, iu, abstol,
890 $ m2, wa2, z, ldu, work, iwork,
891 $ iwork( 5*n+1 ), iinfo )
892 IF( iinfo.NE.0 )
THEN
893 WRITE( nounit, fmt = 9999 )
'SSTEVX(N,A)', iinfo, n,
896 IF( iinfo.LT.0 )
THEN
909 temp1 = max( temp1, abs( wa2( j ) ),
910 $ abs( eveigs( j ) ) )
911 temp2 = max( temp2, abs( wa2( j )-eveigs( j ) ) )
913 result( 6 ) = temp2 / max( unfl,
914 $ ulp*max( temp1, temp2 ) )
920 d1( i ) =
REAL( A( I, I ) )
923 d2( i ) =
REAL( A( I+1, I ) )
926 CALL sstevr(
'V',
'A', n, d1, d2, vl, vu, il, iu, abstol,
927 $ m, wa1, z, ldu, iwork, work, lwork,
928 $ iwork(2*n+1), liwork-2*n, iinfo )
929 IF( iinfo.NE.0 )
THEN
930 WRITE( nounit, fmt = 9999 )
'SSTEVR(V,A)', iinfo, n,
933 IF( iinfo.LT.0 )
THEN
942 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
950 d3( i ) =
REAL( A( I, I ) )
953 d4( i ) =
REAL( A( I+1, I ) )
955 CALL sstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
960 d4( i ) =
REAL( A( I+1, I ) )
963 CALL sstevr(
'N',
'A', n, d3, d4, vl, vu, il, iu, abstol,
964 $ m2, wa2, z, ldu, iwork, work, lwork,
965 $ iwork(2*n+1), liwork-2*n, iinfo )
966 IF( iinfo.NE.0 )
THEN
967 WRITE( nounit, fmt = 9999 )
'SSTEVR(N,A)', iinfo, n,
970 IF( iinfo.LT.0 )
THEN
983 temp1 = max( temp1, abs( wa2( j ) ),
984 $ abs( eveigs( j ) ) )
985 temp2 = max( temp2, abs( wa2( j )-eveigs( j ) ) )
987 result( 9 ) = temp2 / max( unfl,
988 $ ulp*max( temp1, temp2 ) )
995 d1( i ) =
REAL( A( I, I ) )
998 d2( i ) =
REAL( A( I+1, I ) )
1001 CALL sstevx(
'V',
'I', n, d1, d2, vl, vu, il, iu, abstol,
1002 $ m2, wa2, z, ldu, work, iwork,
1003 $ iwork( 5*n+1 ), iinfo )
1004 IF( iinfo.NE.0 )
THEN
1005 WRITE( nounit, fmt = 9999 )
'SSTEVX(V,I)', iinfo, n,
1008 IF( iinfo.LT.0 )
THEN
1011 result( 10 ) = ulpinv
1012 result( 11 ) = ulpinv
1013 result( 12 ) = ulpinv
1021 d3( i ) =
REAL( A( I, I ) )
1024 d4( i ) =
REAL( A( I+1, I ) )
1026 CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1027 $ max( 1, m2 ), result( 10 ) )
1032 d4( i ) =
REAL( A( I+1, I ) )
1035 CALL sstevx(
'N',
'I', n, d3, d4, vl, vu, il, iu, abstol,
1036 $ m3, wa3, z, ldu, work, iwork,
1037 $ iwork( 5*n+1 ), iinfo )
1038 IF( iinfo.NE.0 )
THEN
1039 WRITE( nounit, fmt = 9999 )
'SSTEVX(N,I)', iinfo, n,
1042 IF( iinfo.LT.0 )
THEN
1045 result( 12 ) = ulpinv
1052 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1053 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1054 result( 12 ) = ( temp1+temp2 ) / max( unfl, ulp*temp3 )
1061 vl = wa1( il ) - max( half*
1062 $ ( wa1( il )-wa1( il-1 ) ), ten*ulp*temp3,
1065 vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
1066 $ ten*ulp*temp3, ten*rtunfl )
1069 vu = wa1( iu ) + max( half*
1070 $ ( wa1( iu+1 )-wa1( iu ) ), ten*ulp*temp3,
1073 vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
1074 $ ten*ulp*temp3, ten*rtunfl )
1082 d1( i ) =
REAL( A( I, I ) )
1085 d2( i ) =
REAL( A( I+1, I ) )
1088 CALL sstevx(
'V',
'V', n, d1, d2, vl, vu, il, iu, abstol,
1089 $ m2, wa2, z, ldu, work, iwork,
1090 $ iwork( 5*n+1 ), iinfo )
1091 IF( iinfo.NE.0 )
THEN
1092 WRITE( nounit, fmt = 9999 )
'SSTEVX(V,V)', iinfo, n,
1095 IF( iinfo.LT.0 )
THEN
1098 result( 13 ) = ulpinv
1099 result( 14 ) = ulpinv
1100 result( 15 ) = ulpinv
1105 IF( m2.EQ.0 .AND. n.GT.0 )
THEN
1106 result( 13 ) = ulpinv
1107 result( 14 ) = ulpinv
1108 result( 15 ) = ulpinv
1115 d3( i ) =
REAL( A( I, I ) )
1118 d4( i ) =
REAL( A( I+1, I ) )
1120 CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1121 $ max( 1, m2 ), result( 13 ) )
1125 d4( i ) =
REAL( A( I+1, I ) )
1128 CALL sstevx(
'N',
'V', n, d3, d4, vl, vu, il, iu, abstol,
1129 $ m3, wa3, z, ldu, work, iwork,
1130 $ iwork( 5*n+1 ), iinfo )
1131 IF( iinfo.NE.0 )
THEN
1132 WRITE( nounit, fmt = 9999 )
'SSTEVX(N,V)', iinfo, n,
1135 IF( iinfo.LT.0 )
THEN
1138 result( 15 ) = ulpinv
1145 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1146 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1147 result( 15 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1153 d1( i ) =
REAL( A( I, I ) )
1156 d2( i ) =
REAL( A( I+1, I ) )
1159 CALL sstevd(
'V', n, d1, d2, z, ldu, work, lwedc, iwork,
1161 IF( iinfo.NE.0 )
THEN
1162 WRITE( nounit, fmt = 9999 )
'SSTEVD(V)', iinfo, n,
1165 IF( iinfo.LT.0 )
THEN
1168 result( 16 ) = ulpinv
1169 result( 17 ) = ulpinv
1170 result( 18 ) = ulpinv
1178 d3( i ) =
REAL( A( I, I ) )
1181 d4( i ) =
REAL( A( I+1, I ) )
1183 CALL sstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
1188 d4( i ) =
REAL( A( I+1, I ) )
1191 CALL sstevd(
'N', n, d3, d4, z, ldu, work, lwedc, iwork,
1193 IF( iinfo.NE.0 )
THEN
1194 WRITE( nounit, fmt = 9999 )
'SSTEVD(N)', iinfo, n,
1197 IF( iinfo.LT.0 )
THEN
1200 result( 18 ) = ulpinv
1210 temp1 = max( temp1, abs( eveigs( j ) ),
1212 temp2 = max( temp2, abs( eveigs( j )-d3( j ) ) )
1214 result( 18 ) = temp2 / max( unfl,
1215 $ ulp*max( temp1, temp2 ) )
1221 d1( i ) =
REAL( A( I, I ) )
1224 d2( i ) =
REAL( A( I+1, I ) )
1227 CALL sstevr(
'V',
'I', n, d1, d2, vl, vu, il, iu, abstol,
1228 $ m2, wa2, z, ldu, iwork, work, lwork,
1229 $ iwork(2*n+1), liwork-2*n, iinfo )
1230 IF( iinfo.NE.0 )
THEN
1231 WRITE( nounit, fmt = 9999 )
'SSTEVR(V,I)', iinfo, n,
1234 IF( iinfo.LT.0 )
THEN
1237 result( 19 ) = ulpinv
1238 result( 20 ) = ulpinv
1239 result( 21 ) = ulpinv
1247 d3( i ) =
REAL( A( I, I ) )
1250 d4( i ) =
REAL( A( I+1, I ) )
1252 CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1253 $ max( 1, m2 ), result( 19 ) )
1258 d4( i ) =
REAL( A( I+1, I ) )
1261 CALL sstevr(
'N',
'I', n, d3, d4, vl, vu, il, iu, abstol,
1262 $ m3, wa3, z, ldu, iwork, work, lwork,
1263 $ iwork(2*n+1), liwork-2*n, iinfo )
1264 IF( iinfo.NE.0 )
THEN
1265 WRITE( nounit, fmt = 9999 )
'SSTEVR(N,I)', iinfo, n,
1268 IF( iinfo.LT.0 )
THEN
1271 result( 21 ) = ulpinv
1278 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1279 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1280 result( 21 ) = ( temp1+temp2 ) / max( unfl, ulp*temp3 )
1287 vl = wa1( il ) - max( half*
1288 $ ( wa1( il )-wa1( il-1 ) ), ten*ulp*temp3,
1291 vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
1292 $ ten*ulp*temp3, ten*rtunfl )
1295 vu = wa1( iu ) + max( half*
1296 $ ( wa1( iu+1 )-wa1( iu ) ), ten*ulp*temp3,
1299 vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
1300 $ ten*ulp*temp3, ten*rtunfl )
1308 d1( i ) =
REAL( A( I, I ) )
1311 d2( i ) =
REAL( A( I+1, I ) )
1314 CALL sstevr(
'V',
'V', n, d1, d2, vl, vu, il, iu, abstol,
1315 $ m2, wa2, z, ldu, iwork, work, lwork,
1316 $ iwork(2*n+1), liwork-2*n, iinfo )
1317 IF( iinfo.NE.0 )
THEN
1318 WRITE( nounit, fmt = 9999 )
'SSTEVR(V,V)', iinfo, n,
1321 IF( iinfo.LT.0 )
THEN
1324 result( 22 ) = ulpinv
1325 result( 23 ) = ulpinv
1326 result( 24 ) = ulpinv
1331 IF( m2.EQ.0 .AND. n.GT.0 )
THEN
1332 result( 22 ) = ulpinv
1333 result( 23 ) = ulpinv
1334 result( 24 ) = ulpinv
1341 d3( i ) =
REAL( A( I, I ) )
1344 d4( i ) =
REAL( A( I+1, I ) )
1346 CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1347 $ max( 1, m2 ), result( 22 ) )
1351 d4( i ) =
REAL( A( I+1, I ) )
1354 CALL sstevr(
'N',
'V', n, d3, d4, vl, vu, il, iu, abstol,
1355 $ m3, wa3, z, ldu, iwork, work, lwork,
1356 $ iwork(2*n+1), liwork-2*n, iinfo )
1357 IF( iinfo.NE.0 )
THEN
1358 WRITE( nounit, fmt = 9999 )
'SSTEVR(N,V)', iinfo, n,
1361 IF( iinfo.LT.0 )
THEN
1364 result( 24 ) = ulpinv
1371 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1372 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1373 result( 24 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1390 DO 1720 iuplo = 0, 1
1391 IF( iuplo.EQ.0 )
THEN
1399 CALL slacpy(
' ', n, n, a, lda, v, ldu )
1403 CALL ssyev(
'V', uplo, n, a, ldu, d1, work, lwork,
1405 IF( iinfo.NE.0 )
THEN
1406 WRITE( nounit, fmt = 9999 )
'SSYEV(V,' // uplo //
')',
1407 $ iinfo, n, jtype, ioldsd
1409 IF( iinfo.LT.0 )
THEN
1412 result( ntest ) = ulpinv
1413 result( ntest+1 ) = ulpinv
1414 result( ntest+2 ) = ulpinv
1421 CALL ssyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
1422 $ ldu, tau, work, result( ntest ) )
1424 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1428 CALL ssyev(
'N', uplo, n, a, ldu, d3, work, lwork,
1430 IF( iinfo.NE.0 )
THEN
1431 WRITE( nounit, fmt = 9999 )
'SSYEV(N,' // uplo //
')',
1432 $ iinfo, n, jtype, ioldsd
1434 IF( iinfo.LT.0 )
THEN
1437 result( ntest ) = ulpinv
1447 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1448 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1450 result( ntest ) = temp2 / max( unfl,
1451 $ ulp*max( temp1, temp2 ) )
1454 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1459 temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
1461 vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
1462 $ ten*ulp*temp3, ten*rtunfl )
1463 ELSE IF( n.GT.0 )
THEN
1464 vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
1465 $ ten*ulp*temp3, ten*rtunfl )
1468 vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
1469 $ ten*ulp*temp3, ten*rtunfl )
1470 ELSE IF( n.GT.0 )
THEN
1471 vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
1472 $ ten*ulp*temp3, ten*rtunfl )
1481 CALL ssyevx(
'V',
'A', uplo, n, a, ldu, vl, vu, il, iu,
1482 $ abstol, m, wa1, z, ldu, work, lwork, iwork,
1483 $ iwork( 5*n+1 ), iinfo )
1484 IF( iinfo.NE.0 )
THEN
1485 WRITE( nounit, fmt = 9999 )
'SSYEVX(V,A,' // uplo //
1486 $
')', iinfo, n, jtype, ioldsd
1488 IF( iinfo.LT.0 )
THEN
1491 result( ntest ) = ulpinv
1492 result( ntest+1 ) = ulpinv
1493 result( ntest+2 ) = ulpinv
1500 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1502 CALL ssyt21( 1, uplo, n, 0, a, ldu, d1, d2, z, ldu, v,
1503 $ ldu, tau, work, result( ntest ) )
1507 CALL ssyevx(
'N',
'A', uplo, n, a, ldu, vl, vu, il, iu,
1508 $ abstol, m2, wa2, z, ldu, work, lwork, iwork,
1509 $ iwork( 5*n+1 ), iinfo )
1510 IF( iinfo.NE.0 )
THEN
1511 WRITE( nounit, fmt = 9999 )
'SSYEVX(N,A,' // uplo //
1512 $
')', iinfo, n, jtype, ioldsd
1514 IF( iinfo.LT.0 )
THEN
1517 result( ntest ) = ulpinv
1527 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
1528 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
1530 result( ntest ) = temp2 / max( unfl,
1531 $ ulp*max( temp1, temp2 ) )
1536 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1538 CALL ssyevx(
'V',
'I', uplo, n, a, ldu, vl, vu, il, iu,
1539 $ abstol, m2, wa2, z, ldu, work, lwork, iwork,
1540 $ iwork( 5*n+1 ), iinfo )
1541 IF( iinfo.NE.0 )
THEN
1542 WRITE( nounit, fmt = 9999 )
'SSYEVX(V,I,' // uplo //
1543 $
')', iinfo, n, jtype, ioldsd
1545 IF( iinfo.LT.0 )
THEN
1548 result( ntest ) = ulpinv
1549 result( ntest+1 ) = ulpinv
1550 result( ntest+2 ) = ulpinv
1557 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1559 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1560 $ v, ldu, tau, work, result( ntest ) )
1563 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1565 CALL ssyevx(
'N',
'I', uplo, n, a, ldu, vl, vu, il, iu,
1566 $ abstol, m3, wa3, z, ldu, work, lwork, iwork,
1567 $ iwork( 5*n+1 ), iinfo )
1568 IF( iinfo.NE.0 )
THEN
1569 WRITE( nounit, fmt = 9999 )
'SSYEVX(N,I,' // uplo //
1570 $
')', iinfo, n, jtype, ioldsd
1572 IF( iinfo.LT.0 )
THEN
1575 result( ntest ) = ulpinv
1582 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1583 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1584 result( ntest ) = ( temp1+temp2 ) /
1585 $ max( unfl, ulp*temp3 )
1589 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1591 CALL ssyevx(
'V',
'V', uplo, n, a, ldu, vl, vu, il, iu,
1592 $ abstol, m2, wa2, z, ldu, work, lwork, iwork,
1593 $ iwork( 5*n+1 ), iinfo )
1594 IF( iinfo.NE.0 )
THEN
1595 WRITE( nounit, fmt = 9999 )
'SSYEVX(V,V,' // uplo //
1596 $
')', iinfo, n, jtype, ioldsd
1598 IF( iinfo.LT.0 )
THEN
1601 result( ntest ) = ulpinv
1602 result( ntest+1 ) = ulpinv
1603 result( ntest+2 ) = ulpinv
1610 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1612 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1613 $ v, ldu, tau, work, result( ntest ) )
1616 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1618 CALL ssyevx(
'N',
'V', uplo, n, a, ldu, vl, vu, il, iu,
1619 $ abstol, m3, wa3, z, ldu, work, lwork, iwork,
1620 $ iwork( 5*n+1 ), iinfo )
1621 IF( iinfo.NE.0 )
THEN
1622 WRITE( nounit, fmt = 9999 )
'SSYEVX(N,V,' // uplo //
1623 $
')', iinfo, n, jtype, ioldsd
1625 IF( iinfo.LT.0 )
THEN
1628 result( ntest ) = ulpinv
1633 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
1634 result( ntest ) = ulpinv
1640 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1641 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1643 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1647 result( ntest ) = ( temp1+temp2 ) /
1648 $ max( unfl, temp3*ulp )
1654 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1659 IF( iuplo.EQ.1 )
THEN
1663 work( indx ) = a( i, j )
1671 work( indx ) = a( i, j )
1679 CALL sspev(
'V', uplo, n, work, d1, z, ldu, v, iinfo )
1680 IF( iinfo.NE.0 )
THEN
1681 WRITE( nounit, fmt = 9999 )
'SSPEV(V,' // uplo //
')',
1682 $ iinfo, n, jtype, ioldsd
1684 IF( iinfo.LT.0 )
THEN
1687 result( ntest ) = ulpinv
1688 result( ntest+1 ) = ulpinv
1689 result( ntest+2 ) = ulpinv
1696 CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
1697 $ ldu, tau, work, result( ntest ) )
1699 IF( iuplo.EQ.1 )
THEN
1703 work( indx ) = a( i, j )
1711 work( indx ) = a( i, j )
1719 CALL sspev(
'N', uplo, n, work, d3, z, ldu, v, iinfo )
1720 IF( iinfo.NE.0 )
THEN
1721 WRITE( nounit, fmt = 9999 )
'SSPEV(N,' // uplo //
')',
1722 $ iinfo, n, jtype, ioldsd
1724 IF( iinfo.LT.0 )
THEN
1727 result( ntest ) = ulpinv
1737 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1738 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1740 result( ntest ) = temp2 / max( unfl,
1741 $ ulp*max( temp1, temp2 ) )
1747 IF( iuplo.EQ.1 )
THEN
1751 work( indx ) = a( i, j )
1759 work( indx ) = a( i, j )
1768 temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
1770 vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
1771 $ ten*ulp*temp3, ten*rtunfl )
1772 ELSE IF( n.GT.0 )
THEN
1773 vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
1774 $ ten*ulp*temp3, ten*rtunfl )
1777 vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
1778 $ ten*ulp*temp3, ten*rtunfl )
1779 ELSE IF( n.GT.0 )
THEN
1780 vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
1781 $ ten*ulp*temp3, ten*rtunfl )
1790 CALL sspevx(
'V',
'A', uplo, n, work, vl, vu, il, iu,
1791 $ abstol, m, wa1, z, ldu, v, iwork,
1792 $ iwork( 5*n+1 ), iinfo )
1793 IF( iinfo.NE.0 )
THEN
1794 WRITE( nounit, fmt = 9999 )
'SSPEVX(V,A,' // uplo //
1795 $
')', iinfo, n, jtype, ioldsd
1797 IF( iinfo.LT.0 )
THEN
1800 result( ntest ) = ulpinv
1801 result( ntest+1 ) = ulpinv
1802 result( ntest+2 ) = ulpinv
1809 CALL ssyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
1810 $ ldu, tau, work, result( ntest ) )
1814 IF( iuplo.EQ.1 )
THEN
1818 work( indx ) = a( i, j )
1826 work( indx ) = a( i, j )
1833 CALL sspevx(
'N',
'A', uplo, n, work, vl, vu, il, iu,
1834 $ abstol, m2, wa2, z, ldu, v, iwork,
1835 $ iwork( 5*n+1 ), iinfo )
1836 IF( iinfo.NE.0 )
THEN
1837 WRITE( nounit, fmt = 9999 )
'SSPEVX(N,A,' // uplo //
1838 $
')', iinfo, n, jtype, ioldsd
1840 IF( iinfo.LT.0 )
THEN
1843 result( ntest ) = ulpinv
1853 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
1854 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
1856 result( ntest ) = temp2 / max( unfl,
1857 $ ulp*max( temp1, temp2 ) )
1860 IF( iuplo.EQ.1 )
THEN
1864 work( indx ) = a( i, j )
1872 work( indx ) = a( i, j )
1881 CALL sspevx(
'V',
'I', uplo, n, work, vl, vu, il, iu,
1882 $ abstol, m2, wa2, z, ldu, v, iwork,
1883 $ iwork( 5*n+1 ), iinfo )
1884 IF( iinfo.NE.0 )
THEN
1885 WRITE( nounit, fmt = 9999 )
'SSPEVX(V,I,' // uplo //
1886 $
')', iinfo, n, jtype, ioldsd
1888 IF( iinfo.LT.0 )
THEN
1891 result( ntest ) = ulpinv
1892 result( ntest+1 ) = ulpinv
1893 result( ntest+2 ) = ulpinv
1900 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1901 $ v, ldu, tau, work, result( ntest ) )
1905 IF( iuplo.EQ.1 )
THEN
1909 work( indx ) = a( i, j )
1917 work( indx ) = a( i, j )
1924 CALL sspevx(
'N',
'I', uplo, n, work, vl, vu, il, iu,
1925 $ abstol, m3, wa3, z, ldu, v, iwork,
1926 $ iwork( 5*n+1 ), iinfo )
1927 IF( iinfo.NE.0 )
THEN
1928 WRITE( nounit, fmt = 9999 )
'SSPEVX(N,I,' // uplo //
1929 $
')', iinfo, n, jtype, ioldsd
1931 IF( iinfo.LT.0 )
THEN
1934 result( ntest ) = ulpinv
1939 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
1940 result( ntest ) = ulpinv
1946 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1947 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1949 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1953 result( ntest ) = ( temp1+temp2 ) /
1954 $ max( unfl, temp3*ulp )
1957 IF( iuplo.EQ.1 )
THEN
1961 work( indx ) = a( i, j )
1969 work( indx ) = a( i, j )
1978 CALL sspevx(
'V',
'V', uplo, n, work, vl, vu, il, iu,
1979 $ abstol, m2, wa2, z, ldu, v, iwork,
1980 $ iwork( 5*n+1 ), iinfo )
1981 IF( iinfo.NE.0 )
THEN
1982 WRITE( nounit, fmt = 9999 )
'SSPEVX(V,V,' // uplo //
1983 $
')', iinfo, n, jtype, ioldsd
1985 IF( iinfo.LT.0 )
THEN
1988 result( ntest ) = ulpinv
1989 result( ntest+1 ) = ulpinv
1990 result( ntest+2 ) = ulpinv
1997 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1998 $ v, ldu, tau, work, result( ntest ) )
2002 IF( iuplo.EQ.1 )
THEN
2006 work( indx ) = a( i, j )
2014 work( indx ) = a( i, j )
2021 CALL sspevx(
'N',
'V', uplo, n, work, vl, vu, il, iu,
2022 $ abstol, m3, wa3, z, ldu, v, iwork,
2023 $ iwork( 5*n+1 ), iinfo )
2024 IF( iinfo.NE.0 )
THEN
2025 WRITE( nounit, fmt = 9999 )
'SSPEVX(N,V,' // uplo //
2026 $
')', iinfo, n, jtype, ioldsd
2028 IF( iinfo.LT.0 )
THEN
2031 result( ntest ) = ulpinv
2036 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
2037 result( ntest ) = ulpinv
2043 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2044 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2046 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2050 result( ntest ) = ( temp1+temp2 ) /
2051 $ max( unfl, temp3*ulp )
2057 IF( jtype.LE.7 )
THEN
2059 ELSE IF( jtype.GE.8 .AND. jtype.LE.15 )
THEN
2068 IF( iuplo.EQ.1 )
THEN
2070 DO 1090 i = max( 1, j-kd ), j
2071 v( kd+1+i-j, j ) = a( i, j )
2076 DO 1110 i = j, min( n, j+kd )
2077 v( 1+i-j, j ) = a( i, j )
2084 CALL ssbev(
'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
2086 IF( iinfo.NE.0 )
THEN
2087 WRITE( nounit, fmt = 9999 )
'SSBEV(V,' // uplo //
')',
2088 $ iinfo, n, jtype, ioldsd
2090 IF( iinfo.LT.0 )
THEN
2093 result( ntest ) = ulpinv
2094 result( ntest+1 ) = ulpinv
2095 result( ntest+2 ) = ulpinv
2102 CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
2103 $ ldu, tau, work, result( ntest ) )
2105 IF( iuplo.EQ.1 )
THEN
2107 DO 1130 i = max( 1, j-kd ), j
2108 v( kd+1+i-j, j ) = a( i, j )
2113 DO 1150 i = j, min( n, j+kd )
2114 v( 1+i-j, j ) = a( i, j )
2121 CALL ssbev(
'N', uplo, n, kd, v, ldu, d3, z, ldu, work,
2123 IF( iinfo.NE.0 )
THEN
2124 WRITE( nounit, fmt = 9999 )
'SSBEV(N,' // uplo //
')',
2125 $ iinfo, n, jtype, ioldsd
2127 IF( iinfo.LT.0 )
THEN
2130 result( ntest ) = ulpinv
2140 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2141 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2143 result( ntest ) = temp2 / max( unfl,
2144 $ ulp*max( temp1, temp2 ) )
2150 IF( iuplo.EQ.1 )
THEN
2152 DO 1190 i = max( 1, j-kd ), j
2153 v( kd+1+i-j, j ) = a( i, j )
2158 DO 1210 i = j, min( n, j+kd )
2159 v( 1+i-j, j ) = a( i, j )
2166 CALL ssbevx(
'V',
'A', uplo, n, kd, v, ldu, u, ldu, vl,
2167 $ vu, il, iu, abstol, m, wa2, z, ldu, work,
2168 $ iwork, iwork( 5*n+1 ), iinfo )
2169 IF( iinfo.NE.0 )
THEN
2170 WRITE( nounit, fmt = 9999 )
'SSBEVX(V,A,' // uplo //
2171 $
')', iinfo, n, jtype, ioldsd
2173 IF( iinfo.LT.0 )
THEN
2176 result( ntest ) = ulpinv
2177 result( ntest+1 ) = ulpinv
2178 result( ntest+2 ) = ulpinv
2185 CALL ssyt21( 1, uplo, n, 0, a, ldu, wa2, d2, z, ldu, v,
2186 $ ldu, tau, work, result( ntest ) )
2190 IF( iuplo.EQ.1 )
THEN
2192 DO 1230 i = max( 1, j-kd ), j
2193 v( kd+1+i-j, j ) = a( i, j )
2198 DO 1250 i = j, min( n, j+kd )
2199 v( 1+i-j, j ) = a( i, j )
2205 CALL ssbevx(
'N',
'A', uplo, n, kd, v, ldu, u, ldu, vl,
2206 $ vu, il, iu, abstol, m3, wa3, z, ldu, work,
2207 $ iwork, iwork( 5*n+1 ), iinfo )
2208 IF( iinfo.NE.0 )
THEN
2209 WRITE( nounit, fmt = 9999 )
'SSBEVX(N,A,' // uplo //
2210 $
')', iinfo, n, jtype, ioldsd
2212 IF( iinfo.LT.0 )
THEN
2215 result( ntest ) = ulpinv
2225 temp1 = max( temp1, abs( wa2( j ) ), abs( wa3( j ) ) )
2226 temp2 = max( temp2, abs( wa2( j )-wa3( j ) ) )
2228 result( ntest ) = temp2 / max( unfl,
2229 $ ulp*max( temp1, temp2 ) )
2233 IF( iuplo.EQ.1 )
THEN
2235 DO 1290 i = max( 1, j-kd ), j
2236 v( kd+1+i-j, j ) = a( i, j )
2241 DO 1310 i = j, min( n, j+kd )
2242 v( 1+i-j, j ) = a( i, j )
2248 CALL ssbevx(
'V',
'I', uplo, n, kd, v, ldu, u, ldu, vl,
2249 $ vu, il, iu, abstol, m2, wa2, z, ldu, work,
2250 $ iwork, iwork( 5*n+1 ), iinfo )
2251 IF( iinfo.NE.0 )
THEN
2252 WRITE( nounit, fmt = 9999 )
'SSBEVX(V,I,' // uplo //
2253 $
')', iinfo, n, jtype, ioldsd
2255 IF( iinfo.LT.0 )
THEN
2258 result( ntest ) = ulpinv
2259 result( ntest+1 ) = ulpinv
2260 result( ntest+2 ) = ulpinv
2267 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2268 $ v, ldu, tau, work, result( ntest ) )
2272 IF( iuplo.EQ.1 )
THEN
2274 DO 1330 i = max( 1, j-kd ), j
2275 v( kd+1+i-j, j ) = a( i, j )
2280 DO 1350 i = j, min( n, j+kd )
2281 v( 1+i-j, j ) = a( i, j )
2287 CALL ssbevx(
'N',
'I', uplo, n, kd, v, ldu, u, ldu, vl,
2288 $ vu, il, iu, abstol, m3, wa3, z, ldu, work,
2289 $ iwork, iwork( 5*n+1 ), iinfo )
2290 IF( iinfo.NE.0 )
THEN
2291 WRITE( nounit, fmt = 9999 )
'SSBEVX(N,I,' // uplo //
2292 $
')', iinfo, n, jtype, ioldsd
2294 IF( iinfo.LT.0 )
THEN
2297 result( ntest ) = ulpinv
2304 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2305 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2307 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2311 result( ntest ) = ( temp1+temp2 ) /
2312 $ max( unfl, temp3*ulp )
2316 IF( iuplo.EQ.1 )
THEN
2318 DO 1380 i = max( 1, j-kd ), j
2319 v( kd+1+i-j, j ) = a( i, j )
2324 DO 1400 i = j, min( n, j+kd )
2325 v( 1+i-j, j ) = a( i, j )
2331 CALL ssbevx(
'V',
'V', uplo, n, kd, v, ldu, u, ldu, vl,
2332 $ vu, il, iu, abstol, m2, wa2, z, ldu, work,
2333 $ iwork, iwork( 5*n+1 ), iinfo )
2334 IF( iinfo.NE.0 )
THEN
2335 WRITE( nounit, fmt = 9999 )
'SSBEVX(V,V,' // uplo //
2336 $
')', iinfo, n, jtype, ioldsd
2338 IF( iinfo.LT.0 )
THEN
2341 result( ntest ) = ulpinv
2342 result( ntest+1 ) = ulpinv
2343 result( ntest+2 ) = ulpinv
2350 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2351 $ v, ldu, tau, work, result( ntest ) )
2355 IF( iuplo.EQ.1 )
THEN
2357 DO 1420 i = max( 1, j-kd ), j
2358 v( kd+1+i-j, j ) = a( i, j )
2363 DO 1440 i = j, min( n, j+kd )
2364 v( 1+i-j, j ) = a( i, j )
2370 CALL ssbevx(
'N',
'V', uplo, n, kd, v, ldu, u, ldu, vl,
2371 $ vu, il, iu, abstol, m3, wa3, z, ldu, work,
2372 $ iwork, iwork( 5*n+1 ), iinfo )
2373 IF( iinfo.NE.0 )
THEN
2374 WRITE( nounit, fmt = 9999 )
'SSBEVX(N,V,' // uplo //
2375 $
')', iinfo, n, jtype, ioldsd
2377 IF( iinfo.LT.0 )
THEN
2380 result( ntest ) = ulpinv
2385 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
2386 result( ntest ) = ulpinv
2392 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2393 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2395 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2399 result( ntest ) = ( temp1+temp2 ) /
2400 $ max( unfl, temp3*ulp )
2406 CALL slacpy(
' ', n, n, a, lda, v, ldu )
2410 CALL ssyevd(
'V', uplo, n, a, ldu, d1, work, lwedc,
2411 $ iwork, liwedc, iinfo )
2412 IF( iinfo.NE.0 )
THEN
2413 WRITE( nounit, fmt = 9999 )
'SSYEVD(V,' // uplo //
2414 $
')', iinfo, n, jtype, ioldsd
2416 IF( iinfo.LT.0 )
THEN
2419 result( ntest ) = ulpinv
2420 result( ntest+1 ) = ulpinv
2421 result( ntest+2 ) = ulpinv
2428 CALL ssyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
2429 $ ldu, tau, work, result( ntest ) )
2431 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2435 CALL ssyevd(
'N', uplo, n, a, ldu, d3, work, lwedc,
2436 $ iwork, liwedc, iinfo )
2437 IF( iinfo.NE.0 )
THEN
2438 WRITE( nounit, fmt = 9999 )
'SSYEVD(N,' // uplo //
2439 $
')', iinfo, n, jtype, ioldsd
2441 IF( iinfo.LT.0 )
THEN
2444 result( ntest ) = ulpinv
2454 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2455 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2457 result( ntest ) = temp2 / max( unfl,
2458 $ ulp*max( temp1, temp2 ) )
2464 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2469 IF( iuplo.EQ.1 )
THEN
2473 work( indx ) = a( i, j )
2481 work( indx ) = a( i, j )
2489 CALL sspevd(
'V', uplo, n, work, d1, z, ldu,
2490 $ work( indx ), lwedc-indx+1, iwork, liwedc,
2492 IF( iinfo.NE.0 )
THEN
2493 WRITE( nounit, fmt = 9999 )
'SSPEVD(V,' // uplo //
2494 $
')', iinfo, n, jtype, ioldsd
2496 IF( iinfo.LT.0 )
THEN
2499 result( ntest ) = ulpinv
2500 result( ntest+1 ) = ulpinv
2501 result( ntest+2 ) = ulpinv
2508 CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
2509 $ ldu, tau, work, result( ntest ) )
2511 IF( iuplo.EQ.1 )
THEN
2516 work( indx ) = a( i, j )
2524 work( indx ) = a( i, j )
2532 CALL sspevd(
'N', uplo, n, work, d3, z, ldu,
2533 $ work( indx ), lwedc-indx+1, iwork, liwedc,
2535 IF( iinfo.NE.0 )
THEN
2536 WRITE( nounit, fmt = 9999 )
'SSPEVD(N,' // uplo //
2537 $
')', iinfo, n, jtype, ioldsd
2539 IF( iinfo.LT.0 )
THEN
2542 result( ntest ) = ulpinv
2552 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2553 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2555 result( ntest ) = temp2 / max( unfl,
2556 $ ulp*max( temp1, temp2 ) )
2561 IF( jtype.LE.7 )
THEN
2563 ELSE IF( jtype.GE.8 .AND. jtype.LE.15 )
THEN
2572 IF( iuplo.EQ.1 )
THEN
2574 DO 1590 i = max( 1, j-kd ), j
2575 v( kd+1+i-j, j ) = a( i, j )
2580 DO 1610 i = j, min( n, j+kd )
2581 v( 1+i-j, j ) = a( i, j )
2588 CALL ssbevd(
'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
2589 $ lwedc, iwork, liwedc, iinfo )
2590 IF( iinfo.NE.0 )
THEN
2591 WRITE( nounit, fmt = 9999 )
'SSBEVD(V,' // uplo //
2592 $
')', iinfo, n, jtype, ioldsd
2594 IF( iinfo.LT.0 )
THEN
2597 result( ntest ) = ulpinv
2598 result( ntest+1 ) = ulpinv
2599 result( ntest+2 ) = ulpinv
2606 CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
2607 $ ldu, tau, work, result( ntest ) )
2609 IF( iuplo.EQ.1 )
THEN
2611 DO 1630 i = max( 1, j-kd ), j
2612 v( kd+1+i-j, j ) = a( i, j )
2617 DO 1650 i = j, min( n, j+kd )
2618 v( 1+i-j, j ) = a( i, j )
2625 CALL ssbevd(
'N', uplo, n, kd, v, ldu, d3, z, ldu, work,
2626 $ lwedc, iwork, liwedc, iinfo )
2627 IF( iinfo.NE.0 )
THEN
2628 WRITE( nounit, fmt = 9999 )
'SSBEVD(N,' // uplo //
2629 $
')', iinfo, n, jtype, ioldsd
2631 IF( iinfo.LT.0 )
THEN
2634 result( ntest ) = ulpinv
2644 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2645 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2647 result( ntest ) = temp2 / max( unfl,
2648 $ ulp*max( temp1, temp2 ) )
2653 CALL slacpy(
' ', n, n, a, lda, v, ldu )
2656 CALL ssyevr(
'V',
'A', uplo, n, a, ldu, vl, vu, il, iu,
2657 $ abstol, m, wa1, z, ldu, iwork, work, lwork,
2658 $ iwork(2*n+1), liwork-2*n, iinfo )
2659 IF( iinfo.NE.0 )
THEN
2660 WRITE( nounit, fmt = 9999 )
'SSYEVR(V,A,' // uplo //
2661 $
')', iinfo, n, jtype, ioldsd
2663 IF( iinfo.LT.0 )
THEN
2666 result( ntest ) = ulpinv
2667 result( ntest+1 ) = ulpinv
2668 result( ntest+2 ) = ulpinv
2675 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2677 CALL ssyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
2678 $ ldu, tau, work, result( ntest ) )
2682 CALL ssyevr(
'N',
'A', uplo, n, a, ldu, vl, vu, il, iu,
2683 $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
2684 $ iwork(2*n+1), liwork-2*n, iinfo )
2685 IF( iinfo.NE.0 )
THEN
2686 WRITE( nounit, fmt = 9999 )
'SSYEVR(N,A,' // uplo //
2687 $
')', iinfo, n, jtype, ioldsd
2689 IF( iinfo.LT.0 )
THEN
2692 result( ntest ) = ulpinv
2702 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
2703 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
2705 result( ntest ) = temp2 / max( unfl,
2706 $ ulp*max( temp1, temp2 ) )
2711 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2713 CALL ssyevr(
'V',
'I', uplo, n, a, ldu, vl, vu, il, iu,
2714 $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
2715 $ iwork(2*n+1), liwork-2*n, iinfo )
2716 IF( iinfo.NE.0 )
THEN
2717 WRITE( nounit, fmt = 9999 )
'SSYEVR(V,I,' // uplo //
2718 $
')', iinfo, n, jtype, ioldsd
2720 IF( iinfo.LT.0 )
THEN
2723 result( ntest ) = ulpinv
2724 result( ntest+1 ) = ulpinv
2725 result( ntest+2 ) = ulpinv
2732 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2734 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2735 $ v, ldu, tau, work, result( ntest ) )
2738 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2740 CALL ssyevr(
'N',
'I', uplo, n, a, ldu, vl, vu, il, iu,
2741 $ abstol, m3, wa3, z, ldu, iwork, work, lwork,
2742 $ iwork(2*n+1), liwork-2*n, iinfo )
2743 IF( iinfo.NE.0 )
THEN
2744 WRITE( nounit, fmt = 9999 )
'SSYEVR(N,I,' // uplo //
2745 $
')', iinfo, n, jtype, ioldsd
2747 IF( iinfo.LT.0 )
THEN
2750 result( ntest ) = ulpinv
2757 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2758 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2759 result( ntest ) = ( temp1+temp2 ) /
2760 $ max( unfl, ulp*temp3 )
2764 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2766 CALL ssyevr(
'V',
'V', uplo, n, a, ldu, vl, vu, il, iu,
2767 $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
2768 $ iwork(2*n+1), liwork-2*n, iinfo )
2769 IF( iinfo.NE.0 )
THEN
2770 WRITE( nounit, fmt = 9999 )
'SSYEVR(V,V,' // uplo //
2771 $
')', iinfo, n, jtype, ioldsd
2773 IF( iinfo.LT.0 )
THEN
2776 result( ntest ) = ulpinv
2777 result( ntest+1 ) = ulpinv
2778 result( ntest+2 ) = ulpinv
2785 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2787 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2788 $ v, ldu, tau, work, result( ntest ) )
2791 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2793 CALL ssyevr(
'N',
'V', uplo, n, a, ldu, vl, vu, il, iu,
2794 $ abstol, m3, wa3, z, ldu, iwork, work, lwork,
2795 $ iwork(2*n+1), liwork-2*n, iinfo )
2796 IF( iinfo.NE.0 )
THEN
2797 WRITE( nounit, fmt = 9999 )
'SSYEVR(N,V,' // uplo //
2798 $
')', iinfo, n, jtype, ioldsd
2800 IF( iinfo.LT.0 )
THEN
2803 result( ntest ) = ulpinv
2808 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
2809 result( ntest ) = ulpinv
2815 temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2816 temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2818 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2822 result( ntest ) = ( temp1+temp2 ) /
2823 $ max( unfl, temp3*ulp )
2825 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2831 ntestt = ntestt + ntest
2833 CALL slafts(
'SST', n, n, jtype, ntest, result, ioldsd,
2834 $ thresh, nounit, nerrs )
2841 CALL alasvm(
'SST', nounit, nerrs, ntestt, 0 )
2843 9999
FORMAT(
' SDRVST: ', a,
' returned INFO=', i6,
'.', / 9x,
'N=',
2844 $ i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine ssyevr(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine sspevd(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine sspev(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO)
SSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
subroutine sstt22(N, M, KBAND, AD, AE, SD, SE, U, LDU, WORK, LDWORK, RESULT)
SSTT22
subroutine sstevr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine ssyevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
SSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine ssbevd(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine sstevx(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine slatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
SLATMR
subroutine slafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
SLAFTS
subroutine sstev(JOBZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine sspevx(JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine ssyevd(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, INFO)
SSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine ssyt21(ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
SSYT21
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine ssbevx(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine ssyev(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO)
SSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine sstevd(JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine ssyt22(ITYPE, UPLO, N, M, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
SSYT22
subroutine sdrvst(NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1, WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK, IWORK, LIWORK, RESULT, INFO)
SDRVST
subroutine ssbev(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, INFO)
SSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
subroutine sstt21(N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RESULT)
SSTT21