462 INTEGER info, lda, ldu, liwork, lwork, nounit, nsizes,
464 DOUBLE PRECISION thresh
468 INTEGER iseed( 4 ), iwork( * ), nn( * )
469 DOUBLE PRECISION a( lda, * ), d1( * ), d2( * ), d3( * ),
470 $ d4( * ), eveigs( * ), result( * ), tau( * ),
471 $ u( ldu, * ), v( ldu, * ), wa1( * ), wa2( * ),
472 $ wa3( * ), work( * ), z( ldu, * )
478 DOUBLE PRECISION zero, one, two, ten
479 parameter ( zero = 0.0d0, one = 1.0d0, two = 2.0d0,
481 DOUBLE PRECISION half
482 parameter ( half = 0.5d0 )
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 DOUBLE PRECISION 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 ),
518 COMMON / srnamc / srnamt
521 INTRINSIC abs, dble, int, log, max, min, 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(
'DDRVST', -info )
573 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
578 unfl =
dlamch(
'Safe minimum' )
579 ovfl =
dlamch(
'Overflow' )
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( dble( n ) ) / log( two ) )
605 lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
613 aninv = one / dble( 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 dlaset(
'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 dlatms( 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 dlatms( 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 dlatmr( 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 dlatmr( 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 )*
dlarnd( 1, iseed3 ) )
731 CALL dlatms( n, n,
'S', iseed,
'S', work, imode, cond,
732 $ anorm, ihbw, ihbw,
'Z', u, ldu, work( n+1 ),
737 CALL dlaset(
'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 + ( n-1 )*int(
dlarnd( 1, iseed2 ) )
766 iu = 1 + ( n-1 )*int(
dlarnd( 1, iseed2 ) )
776 IF( jtype.LE.7 )
THEN
779 d1( i ) = dble( a( i, i ) )
782 d2( i ) = dble( a( i+1, i ) )
785 CALL dstev(
'V', n, d1, d2, z, ldu, work, iinfo )
786 IF( iinfo.NE.0 )
THEN
787 WRITE( nounit, fmt = 9999 )
'DSTEV(V)', iinfo, n,
790 IF( iinfo.LT.0 )
THEN
803 d3( i ) = dble( a( i, i ) )
806 d4( i ) = dble( a( i+1, i ) )
808 CALL dstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
813 d4( i ) = dble( a( i+1, i ) )
816 CALL dstev(
'N', n, d3, d4, z, ldu, work, iinfo )
817 IF( iinfo.NE.0 )
THEN
818 WRITE( nounit, fmt = 9999 )
'DSTEV(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 ) = dble( a( i, i ) )
848 d2( i ) = dble( a( i+1, i ) )
851 CALL dstevx(
'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 )
'DSTEVX(V,A)', iinfo, n,
858 IF( iinfo.LT.0 )
THEN
868 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
876 d3( i ) = dble( a( i, i ) )
879 d4( i ) = dble( a( i+1, i ) )
881 CALL dstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
886 d4( i ) = dble( a( i+1, i ) )
889 CALL dstevx(
'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 )
'DSTEVX(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 ) = dble( a( i, i ) )
923 d2( i ) = dble( a( i+1, i ) )
926 CALL dstevr(
'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 )
'DSTEVR(V,A)', iinfo, n,
933 IF( iinfo.LT.0 )
THEN
942 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
950 d3( i ) = dble( a( i, i ) )
953 d4( i ) = dble( a( i+1, i ) )
955 CALL dstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
960 d4( i ) = dble( a( i+1, i ) )
963 CALL dstevr(
'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 )
'DSTEVR(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 ) = dble( a( i, i ) )
998 d2( i ) = dble( a( i+1, i ) )
1001 CALL dstevx(
'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 )
'DSTEVX(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 ) = dble( a( i, i ) )
1024 d4( i ) = dble( a( i+1, i ) )
1026 CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1027 $ max( 1, m2 ), result( 10 ) )
1032 d4( i ) = dble( a( i+1, i ) )
1035 CALL dstevx(
'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 )
'DSTEVX(N,I)', iinfo, n,
1042 IF( iinfo.LT.0 )
THEN
1045 result( 12 ) = ulpinv
1052 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1053 temp2 =
dsxt1( 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 ) = dble( a( i, i ) )
1085 d2( i ) = dble( a( i+1, i ) )
1088 CALL dstevx(
'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 )
'DSTEVX(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 ) = dble( a( i, i ) )
1118 d4( i ) = dble( a( i+1, i ) )
1120 CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1121 $ max( 1, m2 ), result( 13 ) )
1125 d4( i ) = dble( a( i+1, i ) )
1128 CALL dstevx(
'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 )
'DSTEVX(N,V)', iinfo, n,
1135 IF( iinfo.LT.0 )
THEN
1138 result( 15 ) = ulpinv
1145 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1146 temp2 =
dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1147 result( 15 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1153 d1( i ) = dble( a( i, i ) )
1156 d2( i ) = dble( a( i+1, i ) )
1159 CALL dstevd(
'V', n, d1, d2, z, ldu, work, lwedc, iwork,
1161 IF( iinfo.NE.0 )
THEN
1162 WRITE( nounit, fmt = 9999 )
'DSTEVD(V)', iinfo, n,
1165 IF( iinfo.LT.0 )
THEN
1168 result( 16 ) = ulpinv
1169 result( 17 ) = ulpinv
1170 result( 18 ) = ulpinv
1178 d3( i ) = dble( a( i, i ) )
1181 d4( i ) = dble( a( i+1, i ) )
1183 CALL dstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
1188 d4( i ) = dble( a( i+1, i ) )
1191 CALL dstevd(
'N', n, d3, d4, z, ldu, work, lwedc, iwork,
1193 IF( iinfo.NE.0 )
THEN
1194 WRITE( nounit, fmt = 9999 )
'DSTEVD(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 ) = dble( a( i, i ) )
1224 d2( i ) = dble( a( i+1, i ) )
1227 CALL dstevr(
'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 )
'DSTEVR(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 ) = dble( a( i, i ) )
1250 d4( i ) = dble( a( i+1, i ) )
1252 CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1253 $ max( 1, m2 ), result( 19 ) )
1258 d4( i ) = dble( a( i+1, i ) )
1261 CALL dstevr(
'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 )
'DSTEVR(N,I)', iinfo, n,
1268 IF( iinfo.LT.0 )
THEN
1271 result( 21 ) = ulpinv
1278 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1279 temp2 =
dsxt1( 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 ) = dble( a( i, i ) )
1311 d2( i ) = dble( a( i+1, i ) )
1314 CALL dstevr(
'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 )
'DSTEVR(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 ) = dble( a( i, i ) )
1344 d4( i ) = dble( a( i+1, i ) )
1346 CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1347 $ max( 1, m2 ), result( 22 ) )
1351 d4( i ) = dble( a( i+1, i ) )
1354 CALL dstevr(
'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 )
'DSTEVR(N,V)', iinfo, n,
1361 IF( iinfo.LT.0 )
THEN
1364 result( 24 ) = ulpinv
1371 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1372 temp2 =
dsxt1( 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 dlacpy(
' ', n, n, a, lda, v, ldu )
1403 CALL dsyev(
'V', uplo, n, a, ldu, d1, work, lwork,
1405 IF( iinfo.NE.0 )
THEN
1406 WRITE( nounit, fmt = 9999 )
'DSYEV(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 dsyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
1422 $ ldu, tau, work, result( ntest ) )
1424 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
1428 CALL dsyev(
'N', uplo, n, a, ldu, d3, work, lwork,
1430 IF( iinfo.NE.0 )
THEN
1431 WRITE( nounit, fmt = 9999 )
'DSYEV(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 dlacpy(
' ', 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 dsyevx(
'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 )
'DSYEVX(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 dlacpy(
' ', n, n, v, ldu, a, lda )
1502 CALL dsyt21( 1, uplo, n, 0, a, ldu, d1, d2, z, ldu, v,
1503 $ ldu, tau, work, result( ntest ) )
1507 CALL dsyevx(
'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 )
'DSYEVX(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 dlacpy(
' ', n, n, v, ldu, a, lda )
1538 CALL dsyevx(
'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 )
'DSYEVX(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 dlacpy(
' ', n, n, v, ldu, a, lda )
1559 CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1560 $ v, ldu, tau, work, result( ntest ) )
1563 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
1565 CALL dsyevx(
'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 )
'DSYEVX(N,I,' // uplo //
1570 $
')', iinfo, n, jtype, ioldsd
1572 IF( iinfo.LT.0 )
THEN
1575 result( ntest ) = ulpinv
1582 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1583 temp2 =
dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1584 result( ntest ) = ( temp1+temp2 ) /
1585 $ max( unfl, ulp*temp3 )
1589 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
1591 CALL dsyevx(
'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 )
'DSYEVX(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 dlacpy(
' ', n, n, v, ldu, a, lda )
1612 CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1613 $ v, ldu, tau, work, result( ntest ) )
1616 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
1618 CALL dsyevx(
'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 )
'DSYEVX(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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1641 temp2 =
dsxt1( 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 dlacpy(
' ', 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 dspev(
'V', uplo, n, work, d1, z, ldu, v, iinfo )
1680 IF( iinfo.NE.0 )
THEN
1681 WRITE( nounit, fmt = 9999 )
'DSPEV(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 dsyt21( 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 dspev(
'N', uplo, n, work, d3, z, ldu, v, iinfo )
1720 IF( iinfo.NE.0 )
THEN
1721 WRITE( nounit, fmt = 9999 )
'DSPEV(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 dspevx(
'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 )
'DSPEVX(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 dsyt21( 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 dspevx(
'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 )
'DSPEVX(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 dspevx(
'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 )
'DSPEVX(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 dsyt22( 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 dspevx(
'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 )
'DSPEVX(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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1947 temp2 =
dsxt1( 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 dspevx(
'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 )
'DSPEVX(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 dsyt22( 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 dspevx(
'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 )
'DSPEVX(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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2044 temp2 =
dsxt1( 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 dsbev(
'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
2086 IF( iinfo.NE.0 )
THEN
2087 WRITE( nounit, fmt = 9999 )
'DSBEV(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 dsyt21( 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 dsbev(
'N', uplo, n, kd, v, ldu, d3, z, ldu, work,
2123 IF( iinfo.NE.0 )
THEN
2124 WRITE( nounit, fmt = 9999 )
'DSBEV(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 dsbevx(
'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 )
'DSBEVX(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 dsyt21( 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 dsbevx(
'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 )
'DSBEVX(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 dsbevx(
'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 )
'DSBEVX(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 dsyt22( 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 dsbevx(
'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 )
'DSBEVX(N,I,' // uplo //
2292 $
')', iinfo, n, jtype, ioldsd
2294 IF( iinfo.LT.0 )
THEN
2297 result( ntest ) = ulpinv
2304 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2305 temp2 =
dsxt1( 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 dsbevx(
'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 )
'DSBEVX(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 dsyt22( 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 dsbevx(
'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 )
'DSBEVX(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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2393 temp2 =
dsxt1( 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 dlacpy(
' ', n, n, a, lda, v, ldu )
2410 CALL dsyevd(
'V', uplo, n, a, ldu, d1, work, lwedc,
2411 $ iwork, liwedc, iinfo )
2412 IF( iinfo.NE.0 )
THEN
2413 WRITE( nounit, fmt = 9999 )
'DSYEVD(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 dsyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
2429 $ ldu, tau, work, result( ntest ) )
2431 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
2435 CALL dsyevd(
'N', uplo, n, a, ldu, d3, work, lwedc,
2436 $ iwork, liwedc, iinfo )
2437 IF( iinfo.NE.0 )
THEN
2438 WRITE( nounit, fmt = 9999 )
'DSYEVD(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 dlacpy(
' ', 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 dspevd(
'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 )
'DSPEVD(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 dsyt21( 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 dspevd(
'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 )
'DSPEVD(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 dsbevd(
'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 )
'DSBEVD(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 dsyt21( 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 dsbevd(
'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 )
'DSBEVD(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 dlacpy(
' ', n, n, a, lda, v, ldu )
2656 CALL dsyevr(
'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 )
'DSYEVR(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 dlacpy(
' ', n, n, v, ldu, a, lda )
2677 CALL dsyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
2678 $ ldu, tau, work, result( ntest ) )
2682 CALL dsyevr(
'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 )
'DSYEVR(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 dlacpy(
' ', n, n, v, ldu, a, lda )
2713 CALL dsyevr(
'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 )
'DSYEVR(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 dlacpy(
' ', n, n, v, ldu, a, lda )
2734 CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2735 $ v, ldu, tau, work, result( ntest ) )
2738 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
2740 CALL dsyevr(
'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 )
'DSYEVR(N,I,' // uplo //
2745 $
')', iinfo, n, jtype, ioldsd
2747 IF( iinfo.LT.0 )
THEN
2750 result( ntest ) = ulpinv
2757 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2758 temp2 =
dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2759 result( ntest ) = ( temp1+temp2 ) /
2760 $ max( unfl, ulp*temp3 )
2764 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
2766 CALL dsyevr(
'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 )
'DSYEVR(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 dlacpy(
' ', n, n, v, ldu, a, lda )
2787 CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2788 $ v, ldu, tau, work, result( ntest ) )
2791 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
2793 CALL dsyevr(
'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 )
'DSYEVR(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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2816 temp2 =
dsxt1( 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 dlacpy(
' ', n, n, v, ldu, a, lda )
2831 ntestt = ntestt + ntest
2833 CALL dlafts(
'DST', n, n, jtype, ntest, result, ioldsd,
2834 $ thresh, nounit, nerrs )
2841 CALL alasvm(
'DST', nounit, nerrs, ntestt, 0 )
2843 9999
FORMAT(
' DDRVST: ', a,
' returned INFO=', i6,
'.', / 9x,
'N=',
2844 $ i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dstevr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dstev(JOBZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
double precision function dlamch(CMACH)
DLAMCH
subroutine dsyev(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO)
DSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
double precision function dsxt1(IJOB, D1, N1, D2, N2, ABSTOL, ULP, UNFL)
DSXT1
subroutine dlatmr(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)
DLATMR
subroutine dsbevx(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dspevd(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dsbev(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, INFO)
DSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
subroutine dspev(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO)
DSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
subroutine dsbevd(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dsyevr(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine dsyevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
DSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine dsyevd(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, INFO)
DSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine dspevx(JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
double precision function dlarnd(IDIST, ISEED)
DLARND
subroutine dlafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
DLAFTS
subroutine dstt22(N, M, KBAND, AD, AE, SD, SE, U, LDU, WORK, LDWORK, RESULT)
DSTT22
subroutine dstevd(JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dsyt22(ITYPE, UPLO, N, M, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
DSYT22
subroutine dsyt21(ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
DSYT21
subroutine dstt21(N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RESULT)
DSTT21
subroutine dstevx(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS