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.5e+0 )
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 ),
521 COMMON / srnamc / srnamt
524 INTRINSIC abs,
REAL, int, log, max, min, sqrt
527 DATA ktype / 1, 2, 5*4, 5*5, 3*8, 3*9 /
528 DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
530 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
548 nmax = max( nmax, nn( j ) )
555 IF( nsizes.LT.0 )
THEN
557 ELSE IF( badnn )
THEN
559 ELSE IF( ntypes.LT.0 )
THEN
561 ELSE IF( lda.LT.nmax )
THEN
563 ELSE IF( ldu.LT.nmax )
THEN
565 ELSE IF( 2*max( 2, nmax )**2.GT.lwork )
THEN
570 CALL xerbla(
'SDRVST2STG', -info )
576 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
581 unfl =
slamch(
'Safe minimum' )
582 ovfl =
slamch(
'Overflow' )
586 rtunfl = sqrt( unfl )
587 rtovfl = sqrt( ovfl )
592 iseed2( i ) = iseed( i )
593 iseed3( i ) = iseed( i )
600 DO 1740 jsize = 1, nsizes
603 lgn = int( log(
REAL( N ) ) / log( two ) )
608 lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
616 aninv = one /
REAL( MAX( 1, N ) )
618 IF( nsizes.NE.1 )
THEN
619 mtypes = min( maxtyp, ntypes )
621 mtypes = min( maxtyp+1, ntypes )
624 DO 1730 jtype = 1, mtypes
626 IF( .NOT.dotype( jtype ) )
632 ioldsd( j ) = iseed( j )
650 IF( mtypes.GT.maxtyp )
653 itype = ktype( jtype )
654 imode = kmode( jtype )
658 GO TO ( 40, 50, 60 )kmagn( jtype )
665 anorm = ( rtovfl*ulp )*aninv
669 anorm = rtunfl*n*ulpinv
674 CALL slaset(
'Full', lda, n, zero, zero, a, lda )
682 IF( itype.EQ.1 )
THEN
685 ELSE IF( itype.EQ.2 )
THEN
690 a( jcol, jcol ) = anorm
693 ELSE IF( itype.EQ.4 )
THEN
697 CALL slatms( n, n,
'S', iseed,
'S', work, imode, cond,
698 $ anorm, 0, 0,
'N', a, lda, work( n+1 ),
701 ELSE IF( itype.EQ.5 )
THEN
705 CALL slatms( n, n,
'S', iseed,
'S', work, imode, cond,
706 $ anorm, n, n,
'N', a, lda, work( n+1 ),
709 ELSE IF( itype.EQ.7 )
THEN
714 CALL slatmr( n, n,
'S', iseed,
'S', work, 6, one, one,
715 $
'T',
'N', work( n+1 ), 1, one,
716 $ work( 2*n+1 ), 1, one,
'N', idumma, 0, 0,
717 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
719 ELSE IF( itype.EQ.8 )
THEN
724 CALL slatmr( n, n,
'S', iseed,
'S', work, 6, one, one,
725 $
'T',
'N', work( n+1 ), 1, one,
726 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
727 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
729 ELSE IF( itype.EQ.9 )
THEN
733 ihbw = int( ( n-1 )*
slarnd( 1, iseed3 ) )
734 CALL slatms( n, n,
'S', iseed,
'S', work, imode, cond,
735 $ anorm, ihbw, ihbw,
'Z', u, ldu, work( n+1 ),
740 CALL slaset(
'Full', lda, n, zero, zero, a, lda )
741 DO 100 idiag = -ihbw, ihbw
742 irow = ihbw - idiag + 1
743 j1 = max( 1, idiag+1 )
744 j2 = min( n, n+idiag )
747 a( i, j ) = u( irow, j )
754 IF( iinfo.NE.0 )
THEN
755 WRITE( nounit, fmt = 9999 )
'Generator', iinfo, n, jtype,
768 il = 1 + int( ( n-1 )*
slarnd( 1, iseed2 ) )
769 iu = 1 + int( ( n-1 )*
slarnd( 1, iseed2 ) )
779 IF( jtype.LE.7 )
THEN
782 d1( i ) =
REAL( A( I, I ) )
785 d2( i ) =
REAL( A( I+1, I ) )
788 CALL sstev(
'V', n, d1, d2, z, ldu, work, iinfo )
789 IF( iinfo.NE.0 )
THEN
790 WRITE( nounit, fmt = 9999 )
'SSTEV(V)', iinfo, n,
793 IF( iinfo.LT.0 )
THEN
806 d3( i ) =
REAL( A( I, I ) )
809 d4( i ) =
REAL( A( I+1, I ) )
811 CALL sstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
816 d4( i ) =
REAL( A( I+1, I ) )
819 CALL sstev(
'N', n, d3, d4, z, ldu, work, iinfo )
820 IF( iinfo.NE.0 )
THEN
821 WRITE( nounit, fmt = 9999 )
'SSTEV(N)', iinfo, n,
824 IF( iinfo.LT.0 )
THEN
837 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
838 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
840 result( 3 ) = temp2 / max( unfl,
841 $ ulp*max( temp1, temp2 ) )
847 eveigs( i ) = d3( i )
848 d1( i ) =
REAL( A( I, I ) )
851 d2( i ) =
REAL( A( I+1, I ) )
854 CALL sstevx(
'V',
'A', n, d1, d2, vl, vu, il, iu, abstol,
855 $ m, wa1, z, ldu, work, iwork, iwork( 5*n+1 ),
857 IF( iinfo.NE.0 )
THEN
858 WRITE( nounit, fmt = 9999 )
'SSTEVX(V,A)', iinfo, n,
861 IF( iinfo.LT.0 )
THEN
871 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
879 d3( i ) =
REAL( A( I, I ) )
882 d4( i ) =
REAL( A( I+1, I ) )
884 CALL sstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
889 d4( i ) =
REAL( A( I+1, I ) )
892 CALL sstevx(
'N',
'A', n, d3, d4, vl, vu, il, iu, abstol,
893 $ m2, wa2, z, ldu, work, iwork,
894 $ iwork( 5*n+1 ), iinfo )
895 IF( iinfo.NE.0 )
THEN
896 WRITE( nounit, fmt = 9999 )
'SSTEVX(N,A)', iinfo, n,
899 IF( iinfo.LT.0 )
THEN
912 temp1 = max( temp1, abs( wa2( j ) ),
913 $ abs( eveigs( j ) ) )
914 temp2 = max( temp2, abs( wa2( j )-eveigs( j ) ) )
916 result( 6 ) = temp2 / max( unfl,
917 $ ulp*max( temp1, temp2 ) )
923 d1( i ) =
REAL( A( I, I ) )
926 d2( i ) =
REAL( A( I+1, I ) )
929 CALL sstevr(
'V',
'A', n, d1, d2, vl, vu, il, iu, abstol,
930 $ m, wa1, z, ldu, iwork, work, lwork,
931 $ iwork(2*n+1), liwork-2*n, iinfo )
932 IF( iinfo.NE.0 )
THEN
933 WRITE( nounit, fmt = 9999 )
'SSTEVR(V,A)', iinfo, n,
936 IF( iinfo.LT.0 )
THEN
945 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
953 d3( i ) =
REAL( A( I, I ) )
956 d4( i ) =
REAL( A( I+1, I ) )
958 CALL sstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
963 d4( i ) =
REAL( A( I+1, I ) )
966 CALL sstevr(
'N',
'A', n, d3, d4, vl, vu, il, iu, abstol,
967 $ m2, wa2, z, ldu, iwork, work, lwork,
968 $ iwork(2*n+1), liwork-2*n, iinfo )
969 IF( iinfo.NE.0 )
THEN
970 WRITE( nounit, fmt = 9999 )
'SSTEVR(N,A)', iinfo, n,
973 IF( iinfo.LT.0 )
THEN
986 temp1 = max( temp1, abs( wa2( j ) ),
987 $ abs( eveigs( j ) ) )
988 temp2 = max( temp2, abs( wa2( j )-eveigs( j ) ) )
990 result( 9 ) = temp2 / max( unfl,
991 $ ulp*max( temp1, temp2 ) )
998 d1( i ) =
REAL( A( I, I ) )
1001 d2( i ) =
REAL( A( I+1, I ) )
1004 CALL sstevx(
'V',
'I', n, d1, d2, vl, vu, il, iu, abstol,
1005 $ m2, wa2, z, ldu, work, iwork,
1006 $ iwork( 5*n+1 ), iinfo )
1007 IF( iinfo.NE.0 )
THEN
1008 WRITE( nounit, fmt = 9999 )
'SSTEVX(V,I)', iinfo, n,
1011 IF( iinfo.LT.0 )
THEN
1014 result( 10 ) = ulpinv
1015 result( 11 ) = ulpinv
1016 result( 12 ) = ulpinv
1024 d3( i ) =
REAL( A( I, I ) )
1027 d4( i ) =
REAL( A( I+1, I ) )
1029 CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1030 $ max( 1, m2 ), result( 10 ) )
1035 d4( i ) =
REAL( A( I+1, I ) )
1038 CALL sstevx(
'N',
'I', n, d3, d4, vl, vu, il, iu, abstol,
1039 $ m3, wa3, z, ldu, work, iwork,
1040 $ iwork( 5*n+1 ), iinfo )
1041 IF( iinfo.NE.0 )
THEN
1042 WRITE( nounit, fmt = 9999 )
'SSTEVX(N,I)', iinfo, n,
1045 IF( iinfo.LT.0 )
THEN
1048 result( 12 ) = ulpinv
1055 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1056 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1057 result( 12 ) = ( temp1+temp2 ) / max( unfl, ulp*temp3 )
1064 vl = wa1( il ) - max( half*
1065 $ ( wa1( il )-wa1( il-1 ) ), ten*ulp*temp3,
1068 vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
1069 $ ten*ulp*temp3, ten*rtunfl )
1072 vu = wa1( iu ) + max( half*
1073 $ ( wa1( iu+1 )-wa1( iu ) ), ten*ulp*temp3,
1076 vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
1077 $ ten*ulp*temp3, ten*rtunfl )
1085 d1( i ) =
REAL( A( I, I ) )
1088 d2( i ) =
REAL( A( I+1, I ) )
1091 CALL sstevx(
'V',
'V', n, d1, d2, vl, vu, il, iu, abstol,
1092 $ m2, wa2, z, ldu, work, iwork,
1093 $ iwork( 5*n+1 ), iinfo )
1094 IF( iinfo.NE.0 )
THEN
1095 WRITE( nounit, fmt = 9999 )
'SSTEVX(V,V)', iinfo, n,
1098 IF( iinfo.LT.0 )
THEN
1101 result( 13 ) = ulpinv
1102 result( 14 ) = ulpinv
1103 result( 15 ) = ulpinv
1108 IF( m2.EQ.0 .AND. n.GT.0 )
THEN
1109 result( 13 ) = ulpinv
1110 result( 14 ) = ulpinv
1111 result( 15 ) = ulpinv
1118 d3( i ) =
REAL( A( I, I ) )
1121 d4( i ) =
REAL( A( I+1, I ) )
1123 CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1124 $ max( 1, m2 ), result( 13 ) )
1128 d4( i ) =
REAL( A( I+1, I ) )
1131 CALL sstevx(
'N',
'V', n, d3, d4, vl, vu, il, iu, abstol,
1132 $ m3, wa3, z, ldu, work, iwork,
1133 $ iwork( 5*n+1 ), iinfo )
1134 IF( iinfo.NE.0 )
THEN
1135 WRITE( nounit, fmt = 9999 )
'SSTEVX(N,V)', iinfo, n,
1138 IF( iinfo.LT.0 )
THEN
1141 result( 15 ) = ulpinv
1148 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1149 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1150 result( 15 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1156 d1( i ) =
REAL( A( I, I ) )
1159 d2( i ) =
REAL( A( I+1, I ) )
1162 CALL sstevd(
'V', n, d1, d2, z, ldu, work, lwedc, iwork,
1164 IF( iinfo.NE.0 )
THEN
1165 WRITE( nounit, fmt = 9999 )
'SSTEVD(V)', iinfo, n,
1168 IF( iinfo.LT.0 )
THEN
1171 result( 16 ) = ulpinv
1172 result( 17 ) = ulpinv
1173 result( 18 ) = ulpinv
1181 d3( i ) =
REAL( A( I, I ) )
1184 d4( i ) =
REAL( A( I+1, I ) )
1186 CALL sstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
1191 d4( i ) =
REAL( A( I+1, I ) )
1194 CALL sstevd(
'N', n, d3, d4, z, ldu, work, lwedc, iwork,
1196 IF( iinfo.NE.0 )
THEN
1197 WRITE( nounit, fmt = 9999 )
'SSTEVD(N)', iinfo, n,
1200 IF( iinfo.LT.0 )
THEN
1203 result( 18 ) = ulpinv
1213 temp1 = max( temp1, abs( eveigs( j ) ),
1215 temp2 = max( temp2, abs( eveigs( j )-d3( j ) ) )
1217 result( 18 ) = temp2 / max( unfl,
1218 $ ulp*max( temp1, temp2 ) )
1224 d1( i ) =
REAL( A( I, I ) )
1227 d2( i ) =
REAL( A( I+1, I ) )
1230 CALL sstevr(
'V',
'I', n, d1, d2, vl, vu, il, iu, abstol,
1231 $ m2, wa2, z, ldu, iwork, work, lwork,
1232 $ iwork(2*n+1), liwork-2*n, iinfo )
1233 IF( iinfo.NE.0 )
THEN
1234 WRITE( nounit, fmt = 9999 )
'SSTEVR(V,I)', iinfo, n,
1237 IF( iinfo.LT.0 )
THEN
1240 result( 19 ) = ulpinv
1241 result( 20 ) = ulpinv
1242 result( 21 ) = ulpinv
1250 d3( i ) =
REAL( A( I, I ) )
1253 d4( i ) =
REAL( A( I+1, I ) )
1255 CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1256 $ max( 1, m2 ), result( 19 ) )
1261 d4( i ) =
REAL( A( I+1, I ) )
1264 CALL sstevr(
'N',
'I', n, d3, d4, vl, vu, il, iu, abstol,
1265 $ m3, wa3, z, ldu, iwork, work, lwork,
1266 $ iwork(2*n+1), liwork-2*n, iinfo )
1267 IF( iinfo.NE.0 )
THEN
1268 WRITE( nounit, fmt = 9999 )
'SSTEVR(N,I)', iinfo, n,
1271 IF( iinfo.LT.0 )
THEN
1274 result( 21 ) = ulpinv
1281 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1282 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1283 result( 21 ) = ( temp1+temp2 ) / max( unfl, ulp*temp3 )
1290 vl = wa1( il ) - max( half*
1291 $ ( wa1( il )-wa1( il-1 ) ), ten*ulp*temp3,
1294 vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
1295 $ ten*ulp*temp3, ten*rtunfl )
1298 vu = wa1( iu ) + max( half*
1299 $ ( wa1( iu+1 )-wa1( iu ) ), ten*ulp*temp3,
1302 vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
1303 $ ten*ulp*temp3, ten*rtunfl )
1311 d1( i ) =
REAL( A( I, I ) )
1314 d2( i ) =
REAL( A( I+1, I ) )
1317 CALL sstevr(
'V',
'V', n, d1, d2, vl, vu, il, iu, abstol,
1318 $ m2, wa2, z, ldu, iwork, work, lwork,
1319 $ iwork(2*n+1), liwork-2*n, iinfo )
1320 IF( iinfo.NE.0 )
THEN
1321 WRITE( nounit, fmt = 9999 )
'SSTEVR(V,V)', iinfo, n,
1324 IF( iinfo.LT.0 )
THEN
1327 result( 22 ) = ulpinv
1328 result( 23 ) = ulpinv
1329 result( 24 ) = ulpinv
1334 IF( m2.EQ.0 .AND. n.GT.0 )
THEN
1335 result( 22 ) = ulpinv
1336 result( 23 ) = ulpinv
1337 result( 24 ) = ulpinv
1344 d3( i ) =
REAL( A( I, I ) )
1347 d4( i ) =
REAL( A( I+1, I ) )
1349 CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1350 $ max( 1, m2 ), result( 22 ) )
1354 d4( i ) =
REAL( A( I+1, I ) )
1357 CALL sstevr(
'N',
'V', n, d3, d4, vl, vu, il, iu, abstol,
1358 $ m3, wa3, z, ldu, iwork, work, lwork,
1359 $ iwork(2*n+1), liwork-2*n, iinfo )
1360 IF( iinfo.NE.0 )
THEN
1361 WRITE( nounit, fmt = 9999 )
'SSTEVR(N,V)', iinfo, n,
1364 IF( iinfo.LT.0 )
THEN
1367 result( 24 ) = ulpinv
1374 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1375 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1376 result( 24 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1393 DO 1720 iuplo = 0, 1
1394 IF( iuplo.EQ.0 )
THEN
1402 CALL slacpy(
' ', n, n, a, lda, v, ldu )
1406 CALL ssyev(
'V', uplo, n, a, ldu, d1, work, lwork,
1408 IF( iinfo.NE.0 )
THEN
1409 WRITE( nounit, fmt = 9999 )
'SSYEV(V,' // uplo //
')',
1410 $ iinfo, n, jtype, ioldsd
1412 IF( iinfo.LT.0 )
THEN
1415 result( ntest ) = ulpinv
1416 result( ntest+1 ) = ulpinv
1417 result( ntest+2 ) = ulpinv
1424 CALL ssyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
1425 $ ldu, tau, work, result( ntest ) )
1427 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1430 srnamt =
'SSYEV_2STAGE'
1431 CALL ssyev_2stage(
'N', uplo, n, a, ldu, d3, work, lwork,
1433 IF( iinfo.NE.0 )
THEN
1434 WRITE( nounit, fmt = 9999 )
1435 $
'SSYEV_2STAGE(N,' // uplo //
')',
1436 $ iinfo, n, jtype, ioldsd
1438 IF( iinfo.LT.0 )
THEN
1441 result( ntest ) = ulpinv
1451 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1452 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1454 result( ntest ) = temp2 / max( unfl,
1455 $ ulp*max( temp1, temp2 ) )
1458 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1463 temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
1465 vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
1466 $ ten*ulp*temp3, ten*rtunfl )
1467 ELSE IF( n.GT.0 )
THEN
1468 vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
1469 $ ten*ulp*temp3, ten*rtunfl )
1472 vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
1473 $ ten*ulp*temp3, ten*rtunfl )
1474 ELSE IF( n.GT.0 )
THEN
1475 vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
1476 $ ten*ulp*temp3, ten*rtunfl )
1485 CALL ssyevx(
'V',
'A', uplo, n, a, ldu, vl, vu, il, iu,
1486 $ abstol, m, wa1, z, ldu, work, lwork, iwork,
1487 $ iwork( 5*n+1 ), iinfo )
1488 IF( iinfo.NE.0 )
THEN
1489 WRITE( nounit, fmt = 9999 )
'SSYEVX(V,A,' // uplo //
1490 $
')', iinfo, n, jtype, ioldsd
1492 IF( iinfo.LT.0 )
THEN
1495 result( ntest ) = ulpinv
1496 result( ntest+1 ) = ulpinv
1497 result( ntest+2 ) = ulpinv
1504 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1506 CALL ssyt21( 1, uplo, n, 0, a, ldu, d1, d2, z, ldu, v,
1507 $ ldu, tau, work, result( ntest ) )
1510 srnamt =
'SSYEVX_2STAGE'
1512 $ il, iu, abstol, m2, wa2, z, ldu, work,
1513 $ lwork, iwork, iwork( 5*n+1 ), iinfo )
1514 IF( iinfo.NE.0 )
THEN
1515 WRITE( nounit, fmt = 9999 )
1516 $
'SSYEVX_2STAGE(N,A,' // uplo //
1517 $
')', iinfo, n, jtype, ioldsd
1519 IF( iinfo.LT.0 )
THEN
1522 result( ntest ) = ulpinv
1532 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
1533 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
1535 result( ntest ) = temp2 / max( unfl,
1536 $ ulp*max( temp1, temp2 ) )
1541 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1543 CALL ssyevx(
'V',
'I', uplo, n, a, ldu, vl, vu, il, iu,
1544 $ abstol, m2, wa2, z, ldu, work, lwork, iwork,
1545 $ iwork( 5*n+1 ), iinfo )
1546 IF( iinfo.NE.0 )
THEN
1547 WRITE( nounit, fmt = 9999 )
'SSYEVX(V,I,' // uplo //
1548 $
')', iinfo, n, jtype, ioldsd
1550 IF( iinfo.LT.0 )
THEN
1553 result( ntest ) = ulpinv
1554 result( ntest+1 ) = ulpinv
1555 result( ntest+2 ) = ulpinv
1562 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1564 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1565 $ v, ldu, tau, work, result( ntest ) )
1568 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1569 srnamt =
'SSYEVX_2STAGE'
1571 $ il, iu, abstol, m3, wa3, z, ldu, work,
1572 $ lwork, iwork, iwork( 5*n+1 ), iinfo )
1573 IF( iinfo.NE.0 )
THEN
1574 WRITE( nounit, fmt = 9999 )
1575 $
'SSYEVX_2STAGE(N,I,' // uplo //
1576 $
')', iinfo, n, jtype, ioldsd
1578 IF( iinfo.LT.0 )
THEN
1581 result( ntest ) = ulpinv
1588 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1589 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1590 result( ntest ) = ( temp1+temp2 ) /
1591 $ max( unfl, ulp*temp3 )
1595 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1597 CALL ssyevx(
'V',
'V', uplo, n, a, ldu, vl, vu, il, iu,
1598 $ abstol, m2, wa2, z, ldu, work, lwork, iwork,
1599 $ iwork( 5*n+1 ), iinfo )
1600 IF( iinfo.NE.0 )
THEN
1601 WRITE( nounit, fmt = 9999 )
'SSYEVX(V,V,' // uplo //
1602 $
')', iinfo, n, jtype, ioldsd
1604 IF( iinfo.LT.0 )
THEN
1607 result( ntest ) = ulpinv
1608 result( ntest+1 ) = ulpinv
1609 result( ntest+2 ) = ulpinv
1616 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1618 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1619 $ v, ldu, tau, work, result( ntest ) )
1622 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1623 srnamt =
'SSYEVX_2STAGE'
1625 $ il, iu, abstol, m3, wa3, z, ldu, work,
1626 $ lwork, iwork, iwork( 5*n+1 ), iinfo )
1627 IF( iinfo.NE.0 )
THEN
1628 WRITE( nounit, fmt = 9999 )
1629 $
'SSYEVX_2STAGE(N,V,' // uplo //
1630 $
')', iinfo, n, jtype, ioldsd
1632 IF( iinfo.LT.0 )
THEN
1635 result( ntest ) = ulpinv
1640 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
1641 result( ntest ) = ulpinv
1647 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1648 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1650 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1654 result( ntest ) = ( temp1+temp2 ) /
1655 $ max( unfl, temp3*ulp )
1661 CALL slacpy(
' ', n, n, v, ldu, a, lda )
1666 IF( iuplo.EQ.1 )
THEN
1670 work( indx ) = a( i, j )
1678 work( indx ) = a( i, j )
1686 CALL sspev(
'V', uplo, n, work, d1, z, ldu, v, iinfo )
1687 IF( iinfo.NE.0 )
THEN
1688 WRITE( nounit, fmt = 9999 )
'SSPEV(V,' // uplo //
')',
1689 $ iinfo, n, jtype, ioldsd
1691 IF( iinfo.LT.0 )
THEN
1694 result( ntest ) = ulpinv
1695 result( ntest+1 ) = ulpinv
1696 result( ntest+2 ) = ulpinv
1703 CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
1704 $ ldu, tau, work, result( ntest ) )
1706 IF( iuplo.EQ.1 )
THEN
1710 work( indx ) = a( i, j )
1718 work( indx ) = a( i, j )
1726 CALL sspev(
'N', uplo, n, work, d3, z, ldu, v, iinfo )
1727 IF( iinfo.NE.0 )
THEN
1728 WRITE( nounit, fmt = 9999 )
'SSPEV(N,' // uplo //
')',
1729 $ iinfo, n, jtype, ioldsd
1731 IF( iinfo.LT.0 )
THEN
1734 result( ntest ) = ulpinv
1744 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1745 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1747 result( ntest ) = temp2 / max( unfl,
1748 $ ulp*max( temp1, temp2 ) )
1754 IF( iuplo.EQ.1 )
THEN
1758 work( indx ) = a( i, j )
1766 work( indx ) = a( i, j )
1775 temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
1777 vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
1778 $ ten*ulp*temp3, ten*rtunfl )
1779 ELSE IF( n.GT.0 )
THEN
1780 vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
1781 $ ten*ulp*temp3, ten*rtunfl )
1784 vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
1785 $ ten*ulp*temp3, ten*rtunfl )
1786 ELSE IF( n.GT.0 )
THEN
1787 vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
1788 $ ten*ulp*temp3, ten*rtunfl )
1797 CALL sspevx(
'V',
'A', uplo, n, work, vl, vu, il, iu,
1798 $ abstol, m, wa1, z, ldu, v, iwork,
1799 $ iwork( 5*n+1 ), iinfo )
1800 IF( iinfo.NE.0 )
THEN
1801 WRITE( nounit, fmt = 9999 )
'SSPEVX(V,A,' // uplo //
1802 $
')', iinfo, n, jtype, ioldsd
1804 IF( iinfo.LT.0 )
THEN
1807 result( ntest ) = ulpinv
1808 result( ntest+1 ) = ulpinv
1809 result( ntest+2 ) = ulpinv
1816 CALL ssyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
1817 $ ldu, tau, work, result( ntest ) )
1821 IF( iuplo.EQ.1 )
THEN
1825 work( indx ) = a( i, j )
1833 work( indx ) = a( i, j )
1840 CALL sspevx(
'N',
'A', uplo, n, work, vl, vu, il, iu,
1841 $ abstol, m2, wa2, z, ldu, v, iwork,
1842 $ iwork( 5*n+1 ), iinfo )
1843 IF( iinfo.NE.0 )
THEN
1844 WRITE( nounit, fmt = 9999 )
'SSPEVX(N,A,' // uplo //
1845 $
')', iinfo, n, jtype, ioldsd
1847 IF( iinfo.LT.0 )
THEN
1850 result( ntest ) = ulpinv
1860 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
1861 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
1863 result( ntest ) = temp2 / max( unfl,
1864 $ ulp*max( temp1, temp2 ) )
1867 IF( iuplo.EQ.1 )
THEN
1871 work( indx ) = a( i, j )
1879 work( indx ) = a( i, j )
1888 CALL sspevx(
'V',
'I', uplo, n, work, vl, vu, il, iu,
1889 $ abstol, m2, wa2, z, ldu, v, iwork,
1890 $ iwork( 5*n+1 ), iinfo )
1891 IF( iinfo.NE.0 )
THEN
1892 WRITE( nounit, fmt = 9999 )
'SSPEVX(V,I,' // uplo //
1893 $
')', iinfo, n, jtype, ioldsd
1895 IF( iinfo.LT.0 )
THEN
1898 result( ntest ) = ulpinv
1899 result( ntest+1 ) = ulpinv
1900 result( ntest+2 ) = ulpinv
1907 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1908 $ v, ldu, tau, work, result( ntest ) )
1912 IF( iuplo.EQ.1 )
THEN
1916 work( indx ) = a( i, j )
1924 work( indx ) = a( i, j )
1931 CALL sspevx(
'N',
'I', uplo, n, work, vl, vu, il, iu,
1932 $ abstol, m3, wa3, z, ldu, v, iwork,
1933 $ iwork( 5*n+1 ), iinfo )
1934 IF( iinfo.NE.0 )
THEN
1935 WRITE( nounit, fmt = 9999 )
'SSPEVX(N,I,' // uplo //
1936 $
')', iinfo, n, jtype, ioldsd
1938 IF( iinfo.LT.0 )
THEN
1941 result( ntest ) = ulpinv
1946 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
1947 result( ntest ) = ulpinv
1953 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1954 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1956 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1960 result( ntest ) = ( temp1+temp2 ) /
1961 $ max( unfl, temp3*ulp )
1964 IF( iuplo.EQ.1 )
THEN
1968 work( indx ) = a( i, j )
1976 work( indx ) = a( i, j )
1985 CALL sspevx(
'V',
'V', uplo, n, work, vl, vu, il, iu,
1986 $ abstol, m2, wa2, z, ldu, v, iwork,
1987 $ iwork( 5*n+1 ), iinfo )
1988 IF( iinfo.NE.0 )
THEN
1989 WRITE( nounit, fmt = 9999 )
'SSPEVX(V,V,' // uplo //
1990 $
')', iinfo, n, jtype, ioldsd
1992 IF( iinfo.LT.0 )
THEN
1995 result( ntest ) = ulpinv
1996 result( ntest+1 ) = ulpinv
1997 result( ntest+2 ) = ulpinv
2004 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2005 $ v, ldu, tau, work, result( ntest ) )
2009 IF( iuplo.EQ.1 )
THEN
2013 work( indx ) = a( i, j )
2021 work( indx ) = a( i, j )
2028 CALL sspevx(
'N',
'V', uplo, n, work, vl, vu, il, iu,
2029 $ abstol, m3, wa3, z, ldu, v, iwork,
2030 $ iwork( 5*n+1 ), iinfo )
2031 IF( iinfo.NE.0 )
THEN
2032 WRITE( nounit, fmt = 9999 )
'SSPEVX(N,V,' // uplo //
2033 $
')', iinfo, n, jtype, ioldsd
2035 IF( iinfo.LT.0 )
THEN
2038 result( ntest ) = ulpinv
2043 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
2044 result( ntest ) = ulpinv
2050 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2051 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2053 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2057 result( ntest ) = ( temp1+temp2 ) /
2058 $ max( unfl, temp3*ulp )
2064 IF( jtype.LE.7 )
THEN
2066 ELSE IF( jtype.GE.8 .AND. jtype.LE.15 )
THEN
2075 IF( iuplo.EQ.1 )
THEN
2077 DO 1090 i = max( 1, j-kd ), j
2078 v( kd+1+i-j, j ) = a( i, j )
2083 DO 1110 i = j, min( n, j+kd )
2084 v( 1+i-j, j ) = a( i, j )
2091 CALL ssbev(
'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
2093 IF( iinfo.NE.0 )
THEN
2094 WRITE( nounit, fmt = 9999 )
'SSBEV(V,' // uplo //
')',
2095 $ iinfo, n, jtype, ioldsd
2097 IF( iinfo.LT.0 )
THEN
2100 result( ntest ) = ulpinv
2101 result( ntest+1 ) = ulpinv
2102 result( ntest+2 ) = ulpinv
2109 CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
2110 $ ldu, tau, work, result( ntest ) )
2112 IF( iuplo.EQ.1 )
THEN
2114 DO 1130 i = max( 1, j-kd ), j
2115 v( kd+1+i-j, j ) = a( i, j )
2120 DO 1150 i = j, min( n, j+kd )
2121 v( 1+i-j, j ) = a( i, j )
2127 srnamt =
'SSBEV_2STAGE'
2128 CALL ssbev_2stage(
'N', uplo, n, kd, v, ldu, d3, z, ldu,
2129 $ work, lwork, iinfo )
2130 IF( iinfo.NE.0 )
THEN
2131 WRITE( nounit, fmt = 9999 )
2132 $
'SSBEV_2STAGE(N,' // uplo //
')',
2133 $ iinfo, n, jtype, ioldsd
2135 IF( iinfo.LT.0 )
THEN
2138 result( ntest ) = ulpinv
2148 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2149 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2151 result( ntest ) = temp2 / max( unfl,
2152 $ ulp*max( temp1, temp2 ) )
2158 IF( iuplo.EQ.1 )
THEN
2160 DO 1190 i = max( 1, j-kd ), j
2161 v( kd+1+i-j, j ) = a( i, j )
2166 DO 1210 i = j, min( n, j+kd )
2167 v( 1+i-j, j ) = a( i, j )
2174 CALL ssbevx(
'V',
'A', uplo, n, kd, v, ldu, u, ldu, vl,
2175 $ vu, il, iu, abstol, m, wa2, z, ldu, work,
2176 $ iwork, iwork( 5*n+1 ), iinfo )
2177 IF( iinfo.NE.0 )
THEN
2178 WRITE( nounit, fmt = 9999 )
'SSBEVX(V,A,' // uplo //
2179 $
')', iinfo, n, jtype, ioldsd
2181 IF( iinfo.LT.0 )
THEN
2184 result( ntest ) = ulpinv
2185 result( ntest+1 ) = ulpinv
2186 result( ntest+2 ) = ulpinv
2193 CALL ssyt21( 1, uplo, n, 0, a, ldu, wa2, d2, z, ldu, v,
2194 $ ldu, tau, work, result( ntest ) )
2198 IF( iuplo.EQ.1 )
THEN
2200 DO 1230 i = max( 1, j-kd ), j
2201 v( kd+1+i-j, j ) = a( i, j )
2206 DO 1250 i = j, min( n, j+kd )
2207 v( 1+i-j, j ) = a( i, j )
2212 srnamt =
'SSBEVX_2STAGE'
2214 $ u, ldu, vl, vu, il, iu, abstol, m3, wa3,
2215 $ z, ldu, work, lwork, iwork, iwork( 5*n+1 ),
2217 IF( iinfo.NE.0 )
THEN
2218 WRITE( nounit, fmt = 9999 )
2219 $
'SSBEVX_2STAGE(N,A,' // uplo //
2220 $
')', iinfo, n, jtype, ioldsd
2222 IF( iinfo.LT.0 )
THEN
2225 result( ntest ) = ulpinv
2235 temp1 = max( temp1, abs( wa2( j ) ), abs( wa3( j ) ) )
2236 temp2 = max( temp2, abs( wa2( j )-wa3( j ) ) )
2238 result( ntest ) = temp2 / max( unfl,
2239 $ ulp*max( temp1, temp2 ) )
2243 IF( iuplo.EQ.1 )
THEN
2245 DO 1290 i = max( 1, j-kd ), j
2246 v( kd+1+i-j, j ) = a( i, j )
2251 DO 1310 i = j, min( n, j+kd )
2252 v( 1+i-j, j ) = a( i, j )
2258 CALL ssbevx(
'V',
'I', uplo, n, kd, v, ldu, u, ldu, vl,
2259 $ vu, il, iu, abstol, m2, wa2, z, ldu, work,
2260 $ iwork, iwork( 5*n+1 ), iinfo )
2261 IF( iinfo.NE.0 )
THEN
2262 WRITE( nounit, fmt = 9999 )
'SSBEVX(V,I,' // uplo //
2263 $
')', iinfo, n, jtype, ioldsd
2265 IF( iinfo.LT.0 )
THEN
2268 result( ntest ) = ulpinv
2269 result( ntest+1 ) = ulpinv
2270 result( ntest+2 ) = ulpinv
2277 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2278 $ v, ldu, tau, work, result( ntest ) )
2282 IF( iuplo.EQ.1 )
THEN
2284 DO 1330 i = max( 1, j-kd ), j
2285 v( kd+1+i-j, j ) = a( i, j )
2290 DO 1350 i = j, min( n, j+kd )
2291 v( 1+i-j, j ) = a( i, j )
2296 srnamt =
'SSBEVX_2STAGE'
2298 $ u, ldu, vl, vu, il, iu, abstol, m3, wa3,
2299 $ z, ldu, work, lwork, iwork, iwork( 5*n+1 ),
2301 IF( iinfo.NE.0 )
THEN
2302 WRITE( nounit, fmt = 9999 )
2303 $
'SSBEVX_2STAGE(N,I,' // uplo //
2304 $
')', iinfo, n, jtype, ioldsd
2306 IF( iinfo.LT.0 )
THEN
2309 result( ntest ) = ulpinv
2316 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2317 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2319 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2323 result( ntest ) = ( temp1+temp2 ) /
2324 $ max( unfl, temp3*ulp )
2328 IF( iuplo.EQ.1 )
THEN
2330 DO 1380 i = max( 1, j-kd ), j
2331 v( kd+1+i-j, j ) = a( i, j )
2336 DO 1400 i = j, min( n, j+kd )
2337 v( 1+i-j, j ) = a( i, j )
2343 CALL ssbevx(
'V',
'V', uplo, n, kd, v, ldu, u, ldu, vl,
2344 $ vu, il, iu, abstol, m2, wa2, z, ldu, work,
2345 $ iwork, iwork( 5*n+1 ), iinfo )
2346 IF( iinfo.NE.0 )
THEN
2347 WRITE( nounit, fmt = 9999 )
'SSBEVX(V,V,' // uplo //
2348 $
')', iinfo, n, jtype, ioldsd
2350 IF( iinfo.LT.0 )
THEN
2353 result( ntest ) = ulpinv
2354 result( ntest+1 ) = ulpinv
2355 result( ntest+2 ) = ulpinv
2362 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2363 $ v, ldu, tau, work, result( ntest ) )
2367 IF( iuplo.EQ.1 )
THEN
2369 DO 1420 i = max( 1, j-kd ), j
2370 v( kd+1+i-j, j ) = a( i, j )
2375 DO 1440 i = j, min( n, j+kd )
2376 v( 1+i-j, j ) = a( i, j )
2381 srnamt =
'SSBEVX_2STAGE'
2383 $ u, ldu, vl, vu, il, iu, abstol, m3, wa3,
2384 $ z, ldu, work, lwork, iwork, iwork( 5*n+1 ),
2386 IF( iinfo.NE.0 )
THEN
2387 WRITE( nounit, fmt = 9999 )
2388 $
'SSBEVX_2STAGE(N,V,' // uplo //
2389 $
')', iinfo, n, jtype, ioldsd
2391 IF( iinfo.LT.0 )
THEN
2394 result( ntest ) = ulpinv
2399 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
2400 result( ntest ) = ulpinv
2406 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2407 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2409 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2413 result( ntest ) = ( temp1+temp2 ) /
2414 $ max( unfl, temp3*ulp )
2420 CALL slacpy(
' ', n, n, a, lda, v, ldu )
2424 CALL ssyevd(
'V', uplo, n, a, ldu, d1, work, lwedc,
2425 $ iwork, liwedc, iinfo )
2426 IF( iinfo.NE.0 )
THEN
2427 WRITE( nounit, fmt = 9999 )
'SSYEVD(V,' // uplo //
2428 $
')', iinfo, n, jtype, ioldsd
2430 IF( iinfo.LT.0 )
THEN
2433 result( ntest ) = ulpinv
2434 result( ntest+1 ) = ulpinv
2435 result( ntest+2 ) = ulpinv
2442 CALL ssyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
2443 $ ldu, tau, work, result( ntest ) )
2445 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2448 srnamt =
'SSYEVD_2STAGE'
2450 $ lwork, iwork, liwedc, iinfo )
2451 IF( iinfo.NE.0 )
THEN
2452 WRITE( nounit, fmt = 9999 )
2453 $
'SSYEVD_2STAGE(N,' // uplo //
2454 $
')', iinfo, n, jtype, ioldsd
2456 IF( iinfo.LT.0 )
THEN
2459 result( ntest ) = ulpinv
2469 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2470 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2472 result( ntest ) = temp2 / max( unfl,
2473 $ ulp*max( temp1, temp2 ) )
2479 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2484 IF( iuplo.EQ.1 )
THEN
2488 work( indx ) = a( i, j )
2496 work( indx ) = a( i, j )
2504 CALL sspevd(
'V', uplo, n, work, d1, z, ldu,
2505 $ work( indx ), lwedc-indx+1, iwork, liwedc,
2507 IF( iinfo.NE.0 )
THEN
2508 WRITE( nounit, fmt = 9999 )
'SSPEVD(V,' // uplo //
2509 $
')', iinfo, n, jtype, ioldsd
2511 IF( iinfo.LT.0 )
THEN
2514 result( ntest ) = ulpinv
2515 result( ntest+1 ) = ulpinv
2516 result( ntest+2 ) = ulpinv
2523 CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
2524 $ ldu, tau, work, result( ntest ) )
2526 IF( iuplo.EQ.1 )
THEN
2531 work( indx ) = a( i, j )
2539 work( indx ) = a( i, j )
2547 CALL sspevd(
'N', uplo, n, work, d3, z, ldu,
2548 $ work( indx ), lwedc-indx+1, iwork, liwedc,
2550 IF( iinfo.NE.0 )
THEN
2551 WRITE( nounit, fmt = 9999 )
'SSPEVD(N,' // uplo //
2552 $
')', iinfo, n, jtype, ioldsd
2554 IF( iinfo.LT.0 )
THEN
2557 result( ntest ) = ulpinv
2567 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2568 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2570 result( ntest ) = temp2 / max( unfl,
2571 $ ulp*max( temp1, temp2 ) )
2576 IF( jtype.LE.7 )
THEN
2578 ELSE IF( jtype.GE.8 .AND. jtype.LE.15 )
THEN
2587 IF( iuplo.EQ.1 )
THEN
2589 DO 1590 i = max( 1, j-kd ), j
2590 v( kd+1+i-j, j ) = a( i, j )
2595 DO 1610 i = j, min( n, j+kd )
2596 v( 1+i-j, j ) = a( i, j )
2603 CALL ssbevd(
'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
2604 $ lwedc, iwork, liwedc, iinfo )
2605 IF( iinfo.NE.0 )
THEN
2606 WRITE( nounit, fmt = 9999 )
'SSBEVD(V,' // uplo //
2607 $
')', iinfo, n, jtype, ioldsd
2609 IF( iinfo.LT.0 )
THEN
2612 result( ntest ) = ulpinv
2613 result( ntest+1 ) = ulpinv
2614 result( ntest+2 ) = ulpinv
2621 CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
2622 $ ldu, tau, work, result( ntest ) )
2624 IF( iuplo.EQ.1 )
THEN
2626 DO 1630 i = max( 1, j-kd ), j
2627 v( kd+1+i-j, j ) = a( i, j )
2632 DO 1650 i = j, min( n, j+kd )
2633 v( 1+i-j, j ) = a( i, j )
2639 srnamt =
'SSBEVD_2STAGE'
2641 $ work, lwork, iwork, liwedc, iinfo )
2642 IF( iinfo.NE.0 )
THEN
2643 WRITE( nounit, fmt = 9999 )
2644 $
'SSBEVD_2STAGE(N,' // uplo //
2645 $
')', iinfo, n, jtype, ioldsd
2647 IF( iinfo.LT.0 )
THEN
2650 result( ntest ) = ulpinv
2660 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
2661 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
2663 result( ntest ) = temp2 / max( unfl,
2664 $ ulp*max( temp1, temp2 ) )
2669 CALL slacpy(
' ', n, n, a, lda, v, ldu )
2672 CALL ssyevr(
'V',
'A', uplo, n, a, ldu, vl, vu, il, iu,
2673 $ abstol, m, wa1, z, ldu, iwork, work, lwork,
2674 $ iwork(2*n+1), liwork-2*n, iinfo )
2675 IF( iinfo.NE.0 )
THEN
2676 WRITE( nounit, fmt = 9999 )
'SSYEVR(V,A,' // uplo //
2677 $
')', iinfo, n, jtype, ioldsd
2679 IF( iinfo.LT.0 )
THEN
2682 result( ntest ) = ulpinv
2683 result( ntest+1 ) = ulpinv
2684 result( ntest+2 ) = ulpinv
2691 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2693 CALL ssyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
2694 $ ldu, tau, work, result( ntest ) )
2697 srnamt =
'SSYEVR_2STAGE'
2699 $ il, iu, abstol, m2, wa2, z, ldu, iwork,
2700 $ work, lwork, iwork(2*n+1), liwork-2*n,
2702 IF( iinfo.NE.0 )
THEN
2703 WRITE( nounit, fmt = 9999 )
2704 $
'SSYEVR_2STAGE(N,A,' // uplo //
2705 $
')', iinfo, n, jtype, ioldsd
2707 IF( iinfo.LT.0 )
THEN
2710 result( ntest ) = ulpinv
2720 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
2721 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
2723 result( ntest ) = temp2 / max( unfl,
2724 $ ulp*max( temp1, temp2 ) )
2729 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2731 CALL ssyevr(
'V',
'I', uplo, n, a, ldu, vl, vu, il, iu,
2732 $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
2733 $ iwork(2*n+1), liwork-2*n, iinfo )
2734 IF( iinfo.NE.0 )
THEN
2735 WRITE( nounit, fmt = 9999 )
'SSYEVR(V,I,' // uplo //
2736 $
')', iinfo, n, jtype, ioldsd
2738 IF( iinfo.LT.0 )
THEN
2741 result( ntest ) = ulpinv
2742 result( ntest+1 ) = ulpinv
2743 result( ntest+2 ) = ulpinv
2750 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2752 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2753 $ v, ldu, tau, work, result( ntest ) )
2756 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2757 srnamt =
'SSYEVR_2STAGE'
2759 $ il, iu, abstol, m3, wa3, z, ldu, iwork,
2760 $ work, lwork, iwork(2*n+1), liwork-2*n,
2762 IF( iinfo.NE.0 )
THEN
2763 WRITE( nounit, fmt = 9999 )
2764 $
'SSYEVR_2STAGE(N,I,' // uplo //
2765 $
')', iinfo, n, jtype, ioldsd
2767 IF( iinfo.LT.0 )
THEN
2770 result( ntest ) = ulpinv
2777 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2778 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2779 result( ntest ) = ( temp1+temp2 ) /
2780 $ max( unfl, ulp*temp3 )
2784 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2786 CALL ssyevr(
'V',
'V', uplo, n, a, ldu, vl, vu, il, iu,
2787 $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
2788 $ iwork(2*n+1), liwork-2*n, iinfo )
2789 IF( iinfo.NE.0 )
THEN
2790 WRITE( nounit, fmt = 9999 )
'SSYEVR(V,V,' // uplo //
2791 $
')', iinfo, n, jtype, ioldsd
2793 IF( iinfo.LT.0 )
THEN
2796 result( ntest ) = ulpinv
2797 result( ntest+1 ) = ulpinv
2798 result( ntest+2 ) = ulpinv
2805 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2807 CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2808 $ v, ldu, tau, work, result( ntest ) )
2811 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2812 srnamt =
'SSYEVR_2STAGE'
2814 $ il, iu, abstol, m3, wa3, z, ldu, iwork,
2815 $ work, lwork, iwork(2*n+1), liwork-2*n,
2817 IF( iinfo.NE.0 )
THEN
2818 WRITE( nounit, fmt = 9999 )
2819 $
'SSYEVR_2STAGE(N,V,' // uplo //
2820 $
')', iinfo, n, jtype, ioldsd
2822 IF( iinfo.LT.0 )
THEN
2825 result( ntest ) = ulpinv
2830 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
2831 result( ntest ) = ulpinv
2837 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2838 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2840 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2844 result( ntest ) = ( temp1+temp2 ) /
2845 $ max( unfl, temp3*ulp )
2847 CALL slacpy(
' ', n, n, v, ldu, a, lda )
2853 ntestt = ntestt + ntest
2855 CALL slafts(
'SST', n, n, jtype, ntest, result, ioldsd,
2856 $ thresh, nounit, nerrs )
2863 CALL alasvm(
'SST', nounit, nerrs, ntestt, 0 )
2865 9999
FORMAT(
' SDRVST2STG: ', a,
' returned INFO=', i6,
'.', / 9x,
2866 $
'N=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine ssyevd_2stage(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, INFO)
SSYEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY ma...
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 ssyev_2stage(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO)
SSYEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY mat...
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 ssyevr_2stage(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSYEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY ma...
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 ssytrd_sy2sb(UPLO, N, KD, A, LDA, AB, LDAB, TAU, WORK, LWORK, INFO)
SSYTRD_SY2SB
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
real function slarnd(IDIST, ISEED)
SLARND
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...
real function ssxt1(IJOB, D1, N1, D2, N2, ABSTOL, ULP, UNFL)
SSXT1
subroutine ssyevx_2stage(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
SSYEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY ma...
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 ...
real function slamch(CMACH)
SLAMCH
subroutine ssyt21(ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
SSYT21
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine ssytrd_2stage(VECT, UPLO, N, A, LDA, D, E, TAU, HOUS2, LHOUS2, WORK, LWORK, INFO)
SSYTRD_2STAGE
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 ssbevd_2stage(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER...
subroutine ssyt22(ITYPE, UPLO, N, M, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
SSYT22
subroutine ssbevx_2stage(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
SSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER...
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 ssbev_2stage(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, INFO)
SSBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER ...
subroutine sstt21(N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RESULT)
SSTT21