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 ),
504 DOUBLE PRECISION DLAMCH, DLARND, DSXT1
521 COMMON / srnamc / srnamt
524 INTRINSIC abs, dble, 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(
'DDRVST2STG', -info )
576 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
581 unfl =
dlamch(
'Safe minimum' )
582 ovfl =
dlamch(
'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( dble( n ) ) / log( two ) )
608 lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
616 aninv = one / dble( 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 dlaset(
'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 dlatms( 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 dlatms( 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 dlatmr( 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 dlatmr( 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 )*
dlarnd( 1, iseed3 ) )
734 CALL dlatms( n, n,
'S', iseed,
'S', work, imode, cond,
735 $ anorm, ihbw, ihbw,
'Z', u, ldu, work( n+1 ),
740 CALL dlaset(
'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 )*
dlarnd( 1, iseed2 ) )
769 iu = 1 + int( ( n-1 )*
dlarnd( 1, iseed2 ) )
779 IF( jtype.LE.7 )
THEN
782 d1( i ) = dble( a( i, i ) )
785 d2( i ) = dble( a( i+1, i ) )
788 CALL dstev(
'V', n, d1, d2, z, ldu, work, iinfo )
789 IF( iinfo.NE.0 )
THEN
790 WRITE( nounit, fmt = 9999 )
'DSTEV(V)', iinfo, n,
793 IF( iinfo.LT.0 )
THEN
806 d3( i ) = dble( a( i, i ) )
809 d4( i ) = dble( a( i+1, i ) )
811 CALL dstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
816 d4( i ) = dble( a( i+1, i ) )
819 CALL dstev(
'N', n, d3, d4, z, ldu, work, iinfo )
820 IF( iinfo.NE.0 )
THEN
821 WRITE( nounit, fmt = 9999 )
'DSTEV(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 ) = dble( a( i, i ) )
851 d2( i ) = dble( a( i+1, i ) )
854 CALL dstevx(
'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 )
'DSTEVX(V,A)', iinfo, n,
861 IF( iinfo.LT.0 )
THEN
871 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
879 d3( i ) = dble( a( i, i ) )
882 d4( i ) = dble( a( i+1, i ) )
884 CALL dstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
889 d4( i ) = dble( a( i+1, i ) )
892 CALL dstevx(
'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 )
'DSTEVX(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 ) = dble( a( i, i ) )
926 d2( i ) = dble( a( i+1, i ) )
929 CALL dstevr(
'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 )
'DSTEVR(V,A)', iinfo, n,
936 IF( iinfo.LT.0 )
THEN
945 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
953 d3( i ) = dble( a( i, i ) )
956 d4( i ) = dble( a( i+1, i ) )
958 CALL dstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
963 d4( i ) = dble( a( i+1, i ) )
966 CALL dstevr(
'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 )
'DSTEVR(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 ) = dble( a( i, i ) )
1001 d2( i ) = dble( a( i+1, i ) )
1004 CALL dstevx(
'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 )
'DSTEVX(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 ) = dble( a( i, i ) )
1027 d4( i ) = dble( a( i+1, i ) )
1029 CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1030 $ max( 1, m2 ), result( 10 ) )
1035 d4( i ) = dble( a( i+1, i ) )
1038 CALL dstevx(
'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 )
'DSTEVX(N,I)', iinfo, n,
1045 IF( iinfo.LT.0 )
THEN
1048 result( 12 ) = ulpinv
1055 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1056 temp2 =
dsxt1( 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 ) = dble( a( i, i ) )
1088 d2( i ) = dble( a( i+1, i ) )
1091 CALL dstevx(
'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 )
'DSTEVX(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 ) = dble( a( i, i ) )
1121 d4( i ) = dble( a( i+1, i ) )
1123 CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1124 $ max( 1, m2 ), result( 13 ) )
1128 d4( i ) = dble( a( i+1, i ) )
1131 CALL dstevx(
'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 )
'DSTEVX(N,V)', iinfo, n,
1138 IF( iinfo.LT.0 )
THEN
1141 result( 15 ) = ulpinv
1148 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1149 temp2 =
dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1150 result( 15 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1156 d1( i ) = dble( a( i, i ) )
1159 d2( i ) = dble( a( i+1, i ) )
1162 CALL dstevd(
'V', n, d1, d2, z, ldu, work, lwedc, iwork,
1164 IF( iinfo.NE.0 )
THEN
1165 WRITE( nounit, fmt = 9999 )
'DSTEVD(V)', iinfo, n,
1168 IF( iinfo.LT.0 )
THEN
1171 result( 16 ) = ulpinv
1172 result( 17 ) = ulpinv
1173 result( 18 ) = ulpinv
1181 d3( i ) = dble( a( i, i ) )
1184 d4( i ) = dble( a( i+1, i ) )
1186 CALL dstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
1191 d4( i ) = dble( a( i+1, i ) )
1194 CALL dstevd(
'N', n, d3, d4, z, ldu, work, lwedc, iwork,
1196 IF( iinfo.NE.0 )
THEN
1197 WRITE( nounit, fmt = 9999 )
'DSTEVD(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 ) = dble( a( i, i ) )
1227 d2( i ) = dble( a( i+1, i ) )
1230 CALL dstevr(
'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 )
'DSTEVR(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 ) = dble( a( i, i ) )
1253 d4( i ) = dble( a( i+1, i ) )
1255 CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1256 $ max( 1, m2 ), result( 19 ) )
1261 d4( i ) = dble( a( i+1, i ) )
1264 CALL dstevr(
'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 )
'DSTEVR(N,I)', iinfo, n,
1271 IF( iinfo.LT.0 )
THEN
1274 result( 21 ) = ulpinv
1281 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1282 temp2 =
dsxt1( 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 ) = dble( a( i, i ) )
1314 d2( i ) = dble( a( i+1, i ) )
1317 CALL dstevr(
'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 )
'DSTEVR(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 ) = dble( a( i, i ) )
1347 d4( i ) = dble( a( i+1, i ) )
1349 CALL dstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
1350 $ max( 1, m2 ), result( 22 ) )
1354 d4( i ) = dble( a( i+1, i ) )
1357 CALL dstevr(
'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 )
'DSTEVR(N,V)', iinfo, n,
1364 IF( iinfo.LT.0 )
THEN
1367 result( 24 ) = ulpinv
1374 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1375 temp2 =
dsxt1( 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 dlacpy(
' ', n, n, a, lda, v, ldu )
1406 CALL dsyev(
'V', uplo, n, a, ldu, d1, work, lwork,
1408 IF( iinfo.NE.0 )
THEN
1409 WRITE( nounit, fmt = 9999 )
'DSYEV(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 dsyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
1425 $ ldu, tau, work, result( ntest ) )
1427 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
1430 srnamt =
'DSYEV_2STAGE'
1431 CALL dsyev_2stage(
'N', uplo, n, a, ldu, d3, work, lwork,
1433 IF( iinfo.NE.0 )
THEN
1434 WRITE( nounit, fmt = 9999 )
1435 $
'DSYEV_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 dlacpy(
' ', 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 dsyevx(
'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 )
'DSYEVX(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 dlacpy(
' ', n, n, v, ldu, a, lda )
1506 CALL dsyt21( 1, uplo, n, 0, a, ldu, d1, d2, z, ldu, v,
1507 $ ldu, tau, work, result( ntest ) )
1510 srnamt =
'DSYEVX_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 $
'DSYEVX_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 dlacpy(
' ', n, n, v, ldu, a, lda )
1543 CALL dsyevx(
'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 )
'DSYEVX(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 dlacpy(
' ', n, n, v, ldu, a, lda )
1564 CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1565 $ v, ldu, tau, work, result( ntest ) )
1568 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
1569 srnamt =
'DSYEVX_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 $
'DSYEVX_2STAGE(N,I,' // uplo //
1576 $
')', iinfo, n, jtype, ioldsd
1578 IF( iinfo.LT.0 )
THEN
1581 result( ntest ) = ulpinv
1588 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1589 temp2 =
dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1590 result( ntest ) = ( temp1+temp2 ) /
1591 $ max( unfl, ulp*temp3 )
1595 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
1597 CALL dsyevx(
'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 )
'DSYEVX(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 dlacpy(
' ', n, n, v, ldu, a, lda )
1618 CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1619 $ v, ldu, tau, work, result( ntest ) )
1622 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
1623 srnamt =
'DSYEVX_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 $
'DSYEVX_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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1648 temp2 =
dsxt1( 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 dlacpy(
' ', 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 dspev(
'V', uplo, n, work, d1, z, ldu, v, iinfo )
1687 IF( iinfo.NE.0 )
THEN
1688 WRITE( nounit, fmt = 9999 )
'DSPEV(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 dsyt21( 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 dspev(
'N', uplo, n, work, d3, z, ldu, v, iinfo )
1727 IF( iinfo.NE.0 )
THEN
1728 WRITE( nounit, fmt = 9999 )
'DSPEV(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 dspevx(
'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 )
'DSPEVX(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 dsyt21( 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 dspevx(
'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 )
'DSPEVX(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 dspevx(
'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 )
'DSPEVX(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 dsyt22( 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 dspevx(
'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 )
'DSPEVX(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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1954 temp2 =
dsxt1( 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 dspevx(
'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 )
'DSPEVX(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 dsyt22( 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 dspevx(
'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 )
'DSPEVX(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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2051 temp2 =
dsxt1( 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 dsbev(
'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
2093 IF( iinfo.NE.0 )
THEN
2094 WRITE( nounit, fmt = 9999 )
'DSBEV(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 dsyt21( 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 =
'DSBEV_2STAGE'
2128 CALL dsbev_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 $
'DSBEV_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 dsbevx(
'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 )
'DSBEVX(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 dsyt21( 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 =
'DSBEVX_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 $
'DSBEVX_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 dsbevx(
'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 )
'DSBEVX(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 dsyt22( 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 =
'DSBEVX_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 $
'DSBEVX_2STAGE(N,I,' // uplo //
2304 $
')', iinfo, n, jtype, ioldsd
2306 IF( iinfo.LT.0 )
THEN
2309 result( ntest ) = ulpinv
2316 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2317 temp2 =
dsxt1( 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 dsbevx(
'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 )
'DSBEVX(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 dsyt22( 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 =
'DSBEVX_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 $
'DSBEVX_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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2407 temp2 =
dsxt1( 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 dlacpy(
' ', n, n, a, lda, v, ldu )
2424 CALL dsyevd(
'V', uplo, n, a, ldu, d1, work, lwedc,
2425 $ iwork, liwedc, iinfo )
2426 IF( iinfo.NE.0 )
THEN
2427 WRITE( nounit, fmt = 9999 )
'DSYEVD(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 dsyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
2443 $ ldu, tau, work, result( ntest ) )
2445 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
2448 srnamt =
'DSYEVD_2STAGE'
2450 $ lwork, iwork, liwedc, iinfo )
2451 IF( iinfo.NE.0 )
THEN
2452 WRITE( nounit, fmt = 9999 )
2453 $
'DSYEVD_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 dlacpy(
' ', 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 dspevd(
'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 )
'DSPEVD(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 dsyt21( 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 dspevd(
'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 )
'DSPEVD(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 dsbevd(
'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 )
'DSBEVD(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 dsyt21( 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 =
'DSBEVD_2STAGE'
2641 $ work, lwork, iwork, liwedc, iinfo )
2642 IF( iinfo.NE.0 )
THEN
2643 WRITE( nounit, fmt = 9999 )
2644 $
'DSBEVD_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 dlacpy(
' ', n, n, a, lda, v, ldu )
2672 CALL dsyevr(
'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 )
'DSYEVR(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 dlacpy(
' ', n, n, v, ldu, a, lda )
2693 CALL dsyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
2694 $ ldu, tau, work, result( ntest ) )
2697 srnamt =
'DSYEVR_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 $
'DSYEVR_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 dlacpy(
' ', n, n, v, ldu, a, lda )
2731 CALL dsyevr(
'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 )
'DSYEVR(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 dlacpy(
' ', n, n, v, ldu, a, lda )
2752 CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2753 $ v, ldu, tau, work, result( ntest ) )
2756 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
2757 srnamt =
'DSYEVR_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 $
'DSYEVR_2STAGE(N,I,' // uplo //
2765 $
')', iinfo, n, jtype, ioldsd
2767 IF( iinfo.LT.0 )
THEN
2770 result( ntest ) = ulpinv
2777 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2778 temp2 =
dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2779 result( ntest ) = ( temp1+temp2 ) /
2780 $ max( unfl, ulp*temp3 )
2784 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
2786 CALL dsyevr(
'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 )
'DSYEVR(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 dlacpy(
' ', n, n, v, ldu, a, lda )
2807 CALL dsyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2808 $ v, ldu, tau, work, result( ntest ) )
2811 CALL dlacpy(
' ', n, n, v, ldu, a, lda )
2812 srnamt =
'DSYEVR_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 $
'DSYEVR_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 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2838 temp2 =
dsxt1( 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 dlacpy(
' ', n, n, v, ldu, a, lda )
2853 ntestt = ntestt + ntest
2855 CALL dlafts(
'DST', n, n, jtype, ntest, result, ioldsd,
2856 $ thresh, nounit, nerrs )
2863 CALL alasvm(
'DST', nounit, nerrs, ntestt, 0 )
2865 9999
FORMAT(
' DDRVST2STG: ', a,
' returned INFO=', i6,
'.', / 9x,
2866 $
'N=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )