347 INTEGER info, lda, ldu, liwork, lrwork, lwork, nounit,
353 INTEGER iseed( 4 ), iwork( * ), nn( * )
354 REAL d1( * ), d2( * ), d3( * ), result( * ),
355 $ rwork( * ), wa1( * ), wa2( * ), wa3( * )
356 COMPLEX a( lda, * ), tau( * ), u( ldu, * ),
357 $ v( ldu, * ), work( * ), z( ldu, * )
364 REAL zero, one, two, ten
365 parameter ( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0,
368 parameter ( half = one / two )
370 parameter ( czero = ( 0.0e+0, 0.0e+0 ),
371 $ cone = ( 1.0e+0, 0.0e+0 ) )
373 parameter ( maxtyp = 18 )
378 INTEGER i, idiag, ihbw, iinfo, il, imode, indwrk, indx,
379 $ irow, itemp, itype, iu, iuplo, j, j1, j2, jcol,
380 $ jsize, jtype, kd, lgn, liwedc, lrwedc, lwedc,
381 $ m, m2, m3, mtypes, n, nerrs, nmats, nmax,
383 REAL abstol, aninv, anorm, cond, ovfl, rtovfl,
384 $ rtunfl, temp1, temp2, temp3, ulp, ulpinv, unfl,
388 INTEGER idumma( 1 ), ioldsd( 4 ), iseed2( 4 ),
389 $ iseed3( 4 ), kmagn( maxtyp ), kmode( maxtyp ),
403 INTRINSIC abs, int, log, max, min,
REAL, sqrt
406 DATA ktype / 1, 2, 5*4, 5*5, 3*8, 3*9 /
407 DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
409 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
422 nmax = max( nmax, nn( j ) )
429 IF( nsizes.LT.0 )
THEN
431 ELSE IF( badnn )
THEN
433 ELSE IF( ntypes.LT.0 )
THEN
435 ELSE IF( lda.LT.nmax )
THEN
437 ELSE IF( ldu.LT.nmax )
THEN
439 ELSE IF( 2*max( 2, nmax )**2.GT.lwork )
THEN
444 CALL xerbla(
'CDRVST', -info )
450 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
455 unfl =
slamch(
'Safe minimum' )
456 ovfl =
slamch(
'Overflow' )
460 rtunfl = sqrt( unfl )
461 rtovfl = sqrt( ovfl )
466 iseed2( i ) = iseed( i )
467 iseed3( i ) = iseed( i )
473 DO 1220 jsize = 1, nsizes
476 lgn = int( log(
REAL( N ) ) / log( two ) )
481 lwedc = max( 2*n+n*n, 2*n*n )
482 lrwedc = 1 + 4*n + 2*n*lgn + 3*n**2
489 aninv = one /
REAL( MAX( 1, N ) )
491 IF( nsizes.NE.1 )
THEN
492 mtypes = min( maxtyp, ntypes )
494 mtypes = min( maxtyp+1, ntypes )
497 DO 1210 jtype = 1, mtypes
498 IF( .NOT.dotype( jtype ) )
504 ioldsd( j ) = iseed( j )
522 IF( mtypes.GT.maxtyp )
525 itype = ktype( jtype )
526 imode = kmode( jtype )
530 GO TO ( 40, 50, 60 )kmagn( jtype )
537 anorm = ( rtovfl*ulp )*aninv
541 anorm = rtunfl*n*ulpinv
546 CALL claset(
'Full', lda, n, czero, czero, a, lda )
554 IF( itype.EQ.1 )
THEN
557 ELSE IF( itype.EQ.2 )
THEN
562 a( jcol, jcol ) = anorm
565 ELSE IF( itype.EQ.4 )
THEN
569 CALL clatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
570 $ anorm, 0, 0,
'N', a, lda, work, iinfo )
572 ELSE IF( itype.EQ.5 )
THEN
576 CALL clatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
577 $ anorm, n, n,
'N', a, lda, work, iinfo )
579 ELSE IF( itype.EQ.7 )
THEN
583 CALL clatmr( n, n,
'S', iseed,
'H', work, 6, one, cone,
584 $
'T',
'N', work( n+1 ), 1, one,
585 $ work( 2*n+1 ), 1, one,
'N', idumma, 0, 0,
586 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
588 ELSE IF( itype.EQ.8 )
THEN
592 CALL clatmr( n, n,
'S', iseed,
'H', work, 6, one, cone,
593 $
'T',
'N', work( n+1 ), 1, one,
594 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
595 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
597 ELSE IF( itype.EQ.9 )
THEN
601 ihbw = int( ( n-1 )*
slarnd( 1, iseed3 ) )
602 CALL clatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
603 $ anorm, ihbw, ihbw,
'Z', u, ldu, work,
608 CALL claset(
'Full', lda, n, czero, czero, a, lda )
609 DO 100 idiag = -ihbw, ihbw
610 irow = ihbw - idiag + 1
611 j1 = max( 1, idiag+1 )
612 j2 = min( n, n+idiag )
615 a( i, j ) = u( irow, j )
622 IF( iinfo.NE.0 )
THEN
623 WRITE( nounit, fmt = 9999 )
'Generator', iinfo, n, jtype,
636 il = 1 + int( ( n-1 )*
slarnd( 1, iseed2 ) )
637 iu = 1 + int( ( n-1 )*
slarnd( 1, iseed2 ) )
649 IF( iuplo.EQ.0 )
THEN
657 CALL clacpy(
' ', n, n, a, lda, v, ldu )
660 CALL cheevd(
'V', uplo, n, a, ldu, d1, work, lwedc,
661 $ rwork, lrwedc, iwork, liwedc, iinfo )
662 IF( iinfo.NE.0 )
THEN
663 WRITE( nounit, fmt = 9999 )
'CHEEVD(V,' // uplo //
664 $
')', iinfo, n, jtype, ioldsd
666 IF( iinfo.LT.0 )
THEN
669 result( ntest ) = ulpinv
670 result( ntest+1 ) = ulpinv
671 result( ntest+2 ) = ulpinv
678 CALL chet21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
679 $ ldu, tau, work, rwork, result( ntest ) )
681 CALL clacpy(
' ', n, n, v, ldu, a, lda )
684 CALL cheevd(
'N', uplo, n, a, ldu, d3, work, lwedc,
685 $ rwork, lrwedc, iwork, liwedc, iinfo )
686 IF( iinfo.NE.0 )
THEN
687 WRITE( nounit, fmt = 9999 )
'CHEEVD(N,' // uplo //
688 $
')', iinfo, n, jtype, ioldsd
690 IF( iinfo.LT.0 )
THEN
693 result( ntest ) = ulpinv
703 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
704 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
706 result( ntest ) = temp2 / max( unfl,
707 $ ulp*max( temp1, temp2 ) )
710 CALL clacpy(
' ', n, n, v, ldu, a, lda )
715 temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
717 vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
718 $ ten*ulp*temp3, ten*rtunfl )
719 ELSE IF( n.GT.0 )
THEN
720 vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
721 $ ten*ulp*temp3, ten*rtunfl )
724 vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
725 $ ten*ulp*temp3, ten*rtunfl )
726 ELSE IF( n.GT.0 )
THEN
727 vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
728 $ ten*ulp*temp3, ten*rtunfl )
736 CALL cheevx(
'V',
'A', uplo, n, a, ldu, vl, vu, il, iu,
737 $ abstol, m, wa1, z, ldu, work, lwork, rwork,
738 $ iwork, iwork( 5*n+1 ), iinfo )
739 IF( iinfo.NE.0 )
THEN
740 WRITE( nounit, fmt = 9999 )
'CHEEVX(V,A,' // uplo //
741 $
')', iinfo, n, jtype, ioldsd
743 IF( iinfo.LT.0 )
THEN
746 result( ntest ) = ulpinv
747 result( ntest+1 ) = ulpinv
748 result( ntest+2 ) = ulpinv
755 CALL clacpy(
' ', n, n, v, ldu, a, lda )
757 CALL chet21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
758 $ ldu, tau, work, rwork, result( ntest ) )
761 CALL cheevx(
'N',
'A', uplo, n, a, ldu, vl, vu, il, iu,
762 $ abstol, m2, wa2, z, ldu, work, lwork, rwork,
763 $ iwork, iwork( 5*n+1 ), iinfo )
764 IF( iinfo.NE.0 )
THEN
765 WRITE( nounit, fmt = 9999 )
'CHEEVX(N,A,' // uplo //
766 $
')', iinfo, n, jtype, ioldsd
768 IF( iinfo.LT.0 )
THEN
771 result( ntest ) = ulpinv
781 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
782 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
784 result( ntest ) = temp2 / max( unfl,
785 $ ulp*max( temp1, temp2 ) )
788 CALL clacpy(
' ', n, n, v, ldu, a, lda )
792 CALL cheevx(
'V',
'I', uplo, n, a, ldu, vl, vu, il, iu,
793 $ abstol, m2, wa2, z, ldu, work, lwork, rwork,
794 $ iwork, iwork( 5*n+1 ), iinfo )
795 IF( iinfo.NE.0 )
THEN
796 WRITE( nounit, fmt = 9999 )
'CHEEVX(V,I,' // uplo //
797 $
')', iinfo, n, jtype, ioldsd
799 IF( iinfo.LT.0 )
THEN
802 result( ntest ) = ulpinv
809 CALL clacpy(
' ', n, n, v, ldu, a, lda )
811 CALL chet22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
812 $ v, ldu, tau, work, rwork, result( ntest ) )
816 CALL cheevx(
'N',
'I', uplo, n, a, ldu, vl, vu, il, iu,
817 $ abstol, m3, wa3, z, ldu, work, lwork, rwork,
818 $ iwork, iwork( 5*n+1 ), iinfo )
819 IF( iinfo.NE.0 )
THEN
820 WRITE( nounit, fmt = 9999 )
'CHEEVX(N,I,' // uplo //
821 $
')', iinfo, n, jtype, ioldsd
823 IF( iinfo.LT.0 )
THEN
826 result( ntest ) = ulpinv
833 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
834 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
836 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
840 result( ntest ) = ( temp1+temp2 ) /
841 $ max( unfl, temp3*ulp )
844 CALL clacpy(
' ', n, n, v, ldu, a, lda )
848 CALL cheevx(
'V',
'V', uplo, n, a, ldu, vl, vu, il, iu,
849 $ abstol, m2, wa2, z, ldu, work, lwork, rwork,
850 $ iwork, iwork( 5*n+1 ), iinfo )
851 IF( iinfo.NE.0 )
THEN
852 WRITE( nounit, fmt = 9999 )
'CHEEVX(V,V,' // uplo //
853 $
')', iinfo, n, jtype, ioldsd
855 IF( iinfo.LT.0 )
THEN
858 result( ntest ) = ulpinv
865 CALL clacpy(
' ', n, n, v, ldu, a, lda )
867 CALL chet22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
868 $ v, ldu, tau, work, rwork, result( ntest ) )
872 CALL cheevx(
'N',
'V', uplo, n, a, ldu, vl, vu, il, iu,
873 $ abstol, m3, wa3, z, ldu, work, lwork, rwork,
874 $ iwork, iwork( 5*n+1 ), iinfo )
875 IF( iinfo.NE.0 )
THEN
876 WRITE( nounit, fmt = 9999 )
'CHEEVX(N,V,' // uplo //
877 $
')', iinfo, n, jtype, ioldsd
879 IF( iinfo.LT.0 )
THEN
882 result( ntest ) = ulpinv
887 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
888 result( ntest ) = ulpinv
894 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
895 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
897 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
901 result( ntest ) = ( temp1+temp2 ) /
902 $ max( unfl, temp3*ulp )
908 CALL clacpy(
' ', n, n, v, ldu, a, lda )
913 IF( iuplo.EQ.1 )
THEN
917 work( indx ) = a( i, j )
925 work( indx ) = a( i, j )
932 indwrk = n*( n+1 ) / 2 + 1
933 CALL chpevd(
'V', uplo, n, work, d1, z, ldu,
934 $ work( indwrk ), lwedc, rwork, lrwedc, iwork,
936 IF( iinfo.NE.0 )
THEN
937 WRITE( nounit, fmt = 9999 )
'CHPEVD(V,' // uplo //
938 $
')', iinfo, n, jtype, ioldsd
940 IF( iinfo.LT.0 )
THEN
943 result( ntest ) = ulpinv
944 result( ntest+1 ) = ulpinv
945 result( ntest+2 ) = ulpinv
952 CALL chet21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
953 $ ldu, tau, work, rwork, result( ntest ) )
955 IF( iuplo.EQ.1 )
THEN
959 work( indx ) = a( i, j )
967 work( indx ) = a( i, j )
974 indwrk = n*( n+1 ) / 2 + 1
975 CALL chpevd(
'N', uplo, n, work, d3, z, ldu,
976 $ work( indwrk ), lwedc, rwork, lrwedc, iwork,
978 IF( iinfo.NE.0 )
THEN
979 WRITE( nounit, fmt = 9999 )
'CHPEVD(N,' // uplo //
980 $
')', iinfo, n, jtype, ioldsd
982 IF( iinfo.LT.0 )
THEN
985 result( ntest ) = ulpinv
995 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
996 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
998 result( ntest ) = temp2 / max( unfl,
999 $ ulp*max( temp1, temp2 ) )
1005 IF( iuplo.EQ.1 )
THEN
1009 work( indx ) = a( i, j )
1017 work( indx ) = a( i, j )
1026 temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
1028 vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
1029 $ ten*ulp*temp3, ten*rtunfl )
1030 ELSE IF( n.GT.0 )
THEN
1031 vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
1032 $ ten*ulp*temp3, ten*rtunfl )
1035 vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
1036 $ ten*ulp*temp3, ten*rtunfl )
1037 ELSE IF( n.GT.0 )
THEN
1038 vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
1039 $ ten*ulp*temp3, ten*rtunfl )
1047 CALL chpevx(
'V',
'A', uplo, n, work, vl, vu, il, iu,
1048 $ abstol, m, wa1, z, ldu, v, rwork, iwork,
1049 $ iwork( 5*n+1 ), iinfo )
1050 IF( iinfo.NE.0 )
THEN
1051 WRITE( nounit, fmt = 9999 )
'CHPEVX(V,A,' // uplo //
1052 $
')', iinfo, n, jtype, ioldsd
1054 IF( iinfo.LT.0 )
THEN
1057 result( ntest ) = ulpinv
1058 result( ntest+1 ) = ulpinv
1059 result( ntest+2 ) = ulpinv
1066 CALL chet21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
1067 $ ldu, tau, work, rwork, result( ntest ) )
1071 IF( iuplo.EQ.1 )
THEN
1075 work( indx ) = a( i, j )
1083 work( indx ) = a( i, j )
1089 CALL chpevx(
'N',
'A', uplo, n, work, vl, vu, il, iu,
1090 $ abstol, m2, wa2, z, ldu, v, rwork, iwork,
1091 $ iwork( 5*n+1 ), iinfo )
1092 IF( iinfo.NE.0 )
THEN
1093 WRITE( nounit, fmt = 9999 )
'CHPEVX(N,A,' // uplo //
1094 $
')', iinfo, n, jtype, ioldsd
1096 IF( iinfo.LT.0 )
THEN
1099 result( ntest ) = ulpinv
1109 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
1110 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
1112 result( ntest ) = temp2 / max( unfl,
1113 $ ulp*max( temp1, temp2 ) )
1117 IF( iuplo.EQ.1 )
THEN
1121 work( indx ) = a( i, j )
1129 work( indx ) = a( i, j )
1135 CALL chpevx(
'V',
'I', uplo, n, work, vl, vu, il, iu,
1136 $ abstol, m2, wa2, z, ldu, v, rwork, iwork,
1137 $ iwork( 5*n+1 ), iinfo )
1138 IF( iinfo.NE.0 )
THEN
1139 WRITE( nounit, fmt = 9999 )
'CHPEVX(V,I,' // uplo //
1140 $
')', iinfo, n, jtype, ioldsd
1142 IF( iinfo.LT.0 )
THEN
1145 result( ntest ) = ulpinv
1146 result( ntest+1 ) = ulpinv
1147 result( ntest+2 ) = ulpinv
1154 CALL chet22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1155 $ v, ldu, tau, work, rwork, result( ntest ) )
1159 IF( iuplo.EQ.1 )
THEN
1163 work( indx ) = a( i, j )
1171 work( indx ) = a( i, j )
1177 CALL chpevx(
'N',
'I', uplo, n, work, vl, vu, il, iu,
1178 $ abstol, m3, wa3, z, ldu, v, rwork, iwork,
1179 $ iwork( 5*n+1 ), iinfo )
1180 IF( iinfo.NE.0 )
THEN
1181 WRITE( nounit, fmt = 9999 )
'CHPEVX(N,I,' // uplo //
1182 $
')', iinfo, n, jtype, ioldsd
1184 IF( iinfo.LT.0 )
THEN
1187 result( ntest ) = ulpinv
1194 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1195 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1197 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1201 result( ntest ) = ( temp1+temp2 ) /
1202 $ max( unfl, temp3*ulp )
1206 IF( iuplo.EQ.1 )
THEN
1210 work( indx ) = a( i, j )
1218 work( indx ) = a( i, j )
1224 CALL chpevx(
'V',
'V', uplo, n, work, vl, vu, il, iu,
1225 $ abstol, m2, wa2, z, ldu, v, rwork, iwork,
1226 $ iwork( 5*n+1 ), iinfo )
1227 IF( iinfo.NE.0 )
THEN
1228 WRITE( nounit, fmt = 9999 )
'CHPEVX(V,V,' // uplo //
1229 $
')', iinfo, n, jtype, ioldsd
1231 IF( iinfo.LT.0 )
THEN
1234 result( ntest ) = ulpinv
1235 result( ntest+1 ) = ulpinv
1236 result( ntest+2 ) = ulpinv
1243 CALL chet22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1244 $ v, ldu, tau, work, rwork, result( ntest ) )
1248 IF( iuplo.EQ.1 )
THEN
1252 work( indx ) = a( i, j )
1260 work( indx ) = a( i, j )
1266 CALL chpevx(
'N',
'V', uplo, n, work, vl, vu, il, iu,
1267 $ abstol, m3, wa3, z, ldu, v, rwork, iwork,
1268 $ iwork( 5*n+1 ), iinfo )
1269 IF( iinfo.NE.0 )
THEN
1270 WRITE( nounit, fmt = 9999 )
'CHPEVX(N,V,' // uplo //
1271 $
')', iinfo, n, jtype, ioldsd
1273 IF( iinfo.LT.0 )
THEN
1276 result( ntest ) = ulpinv
1281 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
1282 result( ntest ) = ulpinv
1288 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1289 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1291 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1295 result( ntest ) = ( temp1+temp2 ) /
1296 $ max( unfl, temp3*ulp )
1302 IF( jtype.LE.7 )
THEN
1304 ELSE IF( jtype.GE.8 .AND. jtype.LE.15 )
THEN
1313 IF( iuplo.EQ.1 )
THEN
1315 DO 560 i = max( 1, j-kd ), j
1316 v( kd+1+i-j, j ) = a( i, j )
1321 DO 580 i = j, min( n, j+kd )
1322 v( 1+i-j, j ) = a( i, j )
1328 CALL chbevd(
'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
1329 $ lwedc, rwork, lrwedc, iwork, liwedc, iinfo )
1330 IF( iinfo.NE.0 )
THEN
1331 WRITE( nounit, fmt = 9998 )
'CHBEVD(V,' // uplo //
1332 $
')', iinfo, n, kd, jtype, ioldsd
1334 IF( iinfo.LT.0 )
THEN
1337 result( ntest ) = ulpinv
1338 result( ntest+1 ) = ulpinv
1339 result( ntest+2 ) = ulpinv
1346 CALL chet21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
1347 $ ldu, tau, work, rwork, result( ntest ) )
1349 IF( iuplo.EQ.1 )
THEN
1351 DO 600 i = max( 1, j-kd ), j
1352 v( kd+1+i-j, j ) = a( i, j )
1357 DO 620 i = j, min( n, j+kd )
1358 v( 1+i-j, j ) = a( i, j )
1364 CALL chbevd(
'N', uplo, n, kd, v, ldu, d3, z, ldu, work,
1365 $ lwedc, rwork, lrwedc, iwork, liwedc, iinfo )
1366 IF( iinfo.NE.0 )
THEN
1367 WRITE( nounit, fmt = 9998 )
'CHBEVD(N,' // uplo //
1368 $
')', iinfo, n, kd, jtype, ioldsd
1370 IF( iinfo.LT.0 )
THEN
1373 result( ntest ) = ulpinv
1383 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1384 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1386 result( ntest ) = temp2 / max( unfl,
1387 $ ulp*max( temp1, temp2 ) )
1393 IF( iuplo.EQ.1 )
THEN
1395 DO 660 i = max( 1, j-kd ), j
1396 v( kd+1+i-j, j ) = a( i, j )
1401 DO 680 i = j, min( n, j+kd )
1402 v( 1+i-j, j ) = a( i, j )
1408 CALL chbevx(
'V',
'A', uplo, n, kd, v, ldu, u, ldu, vl,
1409 $ vu, il, iu, abstol, m, wa1, z, ldu, work,
1410 $ rwork, iwork, iwork( 5*n+1 ), iinfo )
1411 IF( iinfo.NE.0 )
THEN
1412 WRITE( nounit, fmt = 9999 )
'CHBEVX(V,A,' // uplo //
1413 $
')', iinfo, n, kd, jtype, ioldsd
1415 IF( iinfo.LT.0 )
THEN
1418 result( ntest ) = ulpinv
1419 result( ntest+1 ) = ulpinv
1420 result( ntest+2 ) = ulpinv
1427 CALL chet21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
1428 $ ldu, tau, work, rwork, result( ntest ) )
1432 IF( iuplo.EQ.1 )
THEN
1434 DO 700 i = max( 1, j-kd ), j
1435 v( kd+1+i-j, j ) = a( i, j )
1440 DO 720 i = j, min( n, j+kd )
1441 v( 1+i-j, j ) = a( i, j )
1446 CALL chbevx(
'N',
'A', uplo, n, kd, v, ldu, u, ldu, vl,
1447 $ vu, il, iu, abstol, m2, wa2, z, ldu, work,
1448 $ rwork, iwork, iwork( 5*n+1 ), iinfo )
1449 IF( iinfo.NE.0 )
THEN
1450 WRITE( nounit, fmt = 9998 )
'CHBEVX(N,A,' // uplo //
1451 $
')', iinfo, n, kd, jtype, ioldsd
1453 IF( iinfo.LT.0 )
THEN
1456 result( ntest ) = ulpinv
1466 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
1467 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
1469 result( ntest ) = temp2 / max( unfl,
1470 $ ulp*max( temp1, temp2 ) )
1477 IF( iuplo.EQ.1 )
THEN
1479 DO 760 i = max( 1, j-kd ), j
1480 v( kd+1+i-j, j ) = a( i, j )
1485 DO 780 i = j, min( n, j+kd )
1486 v( 1+i-j, j ) = a( i, j )
1491 CALL chbevx(
'V',
'I', uplo, n, kd, v, ldu, u, ldu, vl,
1492 $ vu, il, iu, abstol, m2, wa2, z, ldu, work,
1493 $ rwork, iwork, iwork( 5*n+1 ), iinfo )
1494 IF( iinfo.NE.0 )
THEN
1495 WRITE( nounit, fmt = 9998 )
'CHBEVX(V,I,' // uplo //
1496 $
')', iinfo, n, kd, jtype, ioldsd
1498 IF( iinfo.LT.0 )
THEN
1501 result( ntest ) = ulpinv
1502 result( ntest+1 ) = ulpinv
1503 result( ntest+2 ) = ulpinv
1510 CALL chet22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1511 $ v, ldu, tau, work, rwork, result( ntest ) )
1515 IF( iuplo.EQ.1 )
THEN
1517 DO 800 i = max( 1, j-kd ), j
1518 v( kd+1+i-j, j ) = a( i, j )
1523 DO 820 i = j, min( n, j+kd )
1524 v( 1+i-j, j ) = a( i, j )
1528 CALL chbevx(
'N',
'I', uplo, n, kd, v, ldu, u, ldu, vl,
1529 $ vu, il, iu, abstol, m3, wa3, z, ldu, work,
1530 $ rwork, iwork, iwork( 5*n+1 ), iinfo )
1531 IF( iinfo.NE.0 )
THEN
1532 WRITE( nounit, fmt = 9998 )
'CHBEVX(N,I,' // uplo //
1533 $
')', iinfo, n, kd, jtype, ioldsd
1535 IF( iinfo.LT.0 )
THEN
1538 result( ntest ) = ulpinv
1545 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1546 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1548 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1552 result( ntest ) = ( temp1+temp2 ) /
1553 $ max( unfl, temp3*ulp )
1560 IF( iuplo.EQ.1 )
THEN
1562 DO 850 i = max( 1, j-kd ), j
1563 v( kd+1+i-j, j ) = a( i, j )
1568 DO 870 i = j, min( n, j+kd )
1569 v( 1+i-j, j ) = a( i, j )
1573 CALL chbevx(
'V',
'V', uplo, n, kd, v, ldu, u, ldu, vl,
1574 $ vu, il, iu, abstol, m2, wa2, z, ldu, work,
1575 $ rwork, iwork, iwork( 5*n+1 ), iinfo )
1576 IF( iinfo.NE.0 )
THEN
1577 WRITE( nounit, fmt = 9998 )
'CHBEVX(V,V,' // uplo //
1578 $
')', iinfo, n, kd, jtype, ioldsd
1580 IF( iinfo.LT.0 )
THEN
1583 result( ntest ) = ulpinv
1584 result( ntest+1 ) = ulpinv
1585 result( ntest+2 ) = ulpinv
1592 CALL chet22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1593 $ v, ldu, tau, work, rwork, result( ntest ) )
1597 IF( iuplo.EQ.1 )
THEN
1599 DO 890 i = max( 1, j-kd ), j
1600 v( kd+1+i-j, j ) = a( i, j )
1605 DO 910 i = j, min( n, j+kd )
1606 v( 1+i-j, j ) = a( i, j )
1610 CALL chbevx(
'N',
'V', uplo, n, kd, v, ldu, u, ldu, vl,
1611 $ vu, il, iu, abstol, m3, wa3, z, ldu, work,
1612 $ rwork, iwork, iwork( 5*n+1 ), iinfo )
1613 IF( iinfo.NE.0 )
THEN
1614 WRITE( nounit, fmt = 9998 )
'CHBEVX(N,V,' // uplo //
1615 $
')', iinfo, n, kd, jtype, ioldsd
1617 IF( iinfo.LT.0 )
THEN
1620 result( ntest ) = ulpinv
1625 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
1626 result( ntest ) = ulpinv
1632 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1633 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1635 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
1639 result( ntest ) = ( temp1+temp2 ) /
1640 $ max( unfl, temp3*ulp )
1646 CALL clacpy(
' ', n, n, a, lda, v, ldu )
1649 CALL cheev(
'V', uplo, n, a, ldu, d1, work, lwork, rwork,
1651 IF( iinfo.NE.0 )
THEN
1652 WRITE( nounit, fmt = 9999 )
'CHEEV(V,' // uplo //
')',
1653 $ iinfo, n, jtype, ioldsd
1655 IF( iinfo.LT.0 )
THEN
1658 result( ntest ) = ulpinv
1659 result( ntest+1 ) = ulpinv
1660 result( ntest+2 ) = ulpinv
1667 CALL chet21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
1668 $ ldu, tau, work, rwork, result( ntest ) )
1670 CALL clacpy(
' ', n, n, v, ldu, a, lda )
1673 CALL cheev(
'N', uplo, n, a, ldu, d3, work, lwork, rwork,
1675 IF( iinfo.NE.0 )
THEN
1676 WRITE( nounit, fmt = 9999 )
'CHEEV(N,' // uplo //
')',
1677 $ iinfo, n, jtype, ioldsd
1679 IF( iinfo.LT.0 )
THEN
1682 result( ntest ) = ulpinv
1692 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1693 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1695 result( ntest ) = temp2 / max( unfl,
1696 $ ulp*max( temp1, temp2 ) )
1700 CALL clacpy(
' ', n, n, v, ldu, a, lda )
1707 IF( iuplo.EQ.1 )
THEN
1711 work( indx ) = a( i, j )
1719 work( indx ) = a( i, j )
1726 indwrk = n*( n+1 ) / 2 + 1
1727 CALL chpev(
'V', uplo, n, work, d1, z, ldu,
1728 $ work( indwrk ), rwork, iinfo )
1729 IF( iinfo.NE.0 )
THEN
1730 WRITE( nounit, fmt = 9999 )
'CHPEV(V,' // uplo //
')',
1731 $ iinfo, n, jtype, ioldsd
1733 IF( iinfo.LT.0 )
THEN
1736 result( ntest ) = ulpinv
1737 result( ntest+1 ) = ulpinv
1738 result( ntest+2 ) = ulpinv
1745 CALL chet21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
1746 $ ldu, tau, work, rwork, result( ntest ) )
1748 IF( iuplo.EQ.1 )
THEN
1752 work( indx ) = a( i, j )
1760 work( indx ) = a( i, j )
1767 indwrk = n*( n+1 ) / 2 + 1
1768 CALL chpev(
'N', uplo, n, work, d3, z, ldu,
1769 $ work( indwrk ), rwork, iinfo )
1770 IF( iinfo.NE.0 )
THEN
1771 WRITE( nounit, fmt = 9999 )
'CHPEV(N,' // uplo //
')',
1772 $ iinfo, n, jtype, ioldsd
1774 IF( iinfo.LT.0 )
THEN
1777 result( ntest ) = ulpinv
1787 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1788 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1790 result( ntest ) = temp2 / max( unfl,
1791 $ ulp*max( temp1, temp2 ) )
1797 IF( jtype.LE.7 )
THEN
1799 ELSE IF( jtype.GE.8 .AND. jtype.LE.15 )
THEN
1808 IF( iuplo.EQ.1 )
THEN
1810 DO 1060 i = max( 1, j-kd ), j
1811 v( kd+1+i-j, j ) = a( i, j )
1816 DO 1080 i = j, min( n, j+kd )
1817 v( 1+i-j, j ) = a( i, j )
1823 CALL chbev(
'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
1825 IF( iinfo.NE.0 )
THEN
1826 WRITE( nounit, fmt = 9998 )
'CHBEV(V,' // uplo //
')',
1827 $ iinfo, n, kd, jtype, ioldsd
1829 IF( iinfo.LT.0 )
THEN
1832 result( ntest ) = ulpinv
1833 result( ntest+1 ) = ulpinv
1834 result( ntest+2 ) = ulpinv
1841 CALL chet21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
1842 $ ldu, tau, work, rwork, result( ntest ) )
1844 IF( iuplo.EQ.1 )
THEN
1846 DO 1100 i = max( 1, j-kd ), j
1847 v( kd+1+i-j, j ) = a( i, j )
1852 DO 1120 i = j, min( n, j+kd )
1853 v( 1+i-j, j ) = a( i, j )
1859 CALL chbev(
'N', uplo, n, kd, v, ldu, d3, z, ldu, work,
1861 IF( iinfo.NE.0 )
THEN
1862 WRITE( nounit, fmt = 9998 )
'CHBEV(N,' // uplo //
')',
1863 $ iinfo, n, kd, jtype, ioldsd
1865 IF( iinfo.LT.0 )
THEN
1868 result( ntest ) = ulpinv
1880 temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
1881 temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
1883 result( ntest ) = temp2 / max( unfl,
1884 $ ulp*max( temp1, temp2 ) )
1886 CALL clacpy(
' ', n, n, a, lda, v, ldu )
1888 CALL cheevr(
'V',
'A', uplo, n, a, ldu, vl, vu, il, iu,
1889 $ abstol, m, wa1, z, ldu, iwork, work, lwork,
1890 $ rwork, lrwork, iwork( 2*n+1 ), liwork-2*n,
1892 IF( iinfo.NE.0 )
THEN
1893 WRITE( nounit, fmt = 9999 )
'CHEEVR(V,A,' // uplo //
1894 $
')', iinfo, n, jtype, ioldsd
1896 IF( iinfo.LT.0 )
THEN
1899 result( ntest ) = ulpinv
1900 result( ntest+1 ) = ulpinv
1901 result( ntest+2 ) = ulpinv
1908 CALL clacpy(
' ', n, n, v, ldu, a, lda )
1910 CALL chet21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
1911 $ ldu, tau, work, rwork, result( ntest ) )
1914 CALL cheevr(
'N',
'A', uplo, n, a, ldu, vl, vu, il, iu,
1915 $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
1916 $ rwork, lrwork, iwork( 2*n+1 ), liwork-2*n,
1918 IF( iinfo.NE.0 )
THEN
1919 WRITE( nounit, fmt = 9999 )
'CHEEVR(N,A,' // uplo //
1920 $
')', iinfo, n, jtype, ioldsd
1922 IF( iinfo.LT.0 )
THEN
1925 result( ntest ) = ulpinv
1935 temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
1936 temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
1938 result( ntest ) = temp2 / max( unfl,
1939 $ ulp*max( temp1, temp2 ) )
1944 CALL clacpy(
' ', n, n, v, ldu, a, lda )
1945 CALL cheevr(
'V',
'I', uplo, n, a, ldu, vl, vu, il, iu,
1946 $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
1947 $ rwork, lrwork, iwork( 2*n+1 ), liwork-2*n,
1949 IF( iinfo.NE.0 )
THEN
1950 WRITE( nounit, fmt = 9999 )
'CHEEVR(V,I,' // uplo //
1951 $
')', iinfo, n, jtype, ioldsd
1953 IF( iinfo.LT.0 )
THEN
1956 result( ntest ) = ulpinv
1957 result( ntest+1 ) = ulpinv
1958 result( ntest+2 ) = ulpinv
1965 CALL clacpy(
' ', n, n, v, ldu, a, lda )
1967 CALL chet22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
1968 $ v, ldu, tau, work, rwork, result( ntest ) )
1971 CALL clacpy(
' ', n, n, v, ldu, a, lda )
1972 CALL cheevr(
'N',
'I', uplo, n, a, ldu, vl, vu, il, iu,
1973 $ abstol, m3, wa3, z, ldu, iwork, work, lwork,
1974 $ rwork, lrwork, iwork( 2*n+1 ), liwork-2*n,
1976 IF( iinfo.NE.0 )
THEN
1977 WRITE( nounit, fmt = 9999 )
'CHEEVR(N,I,' // uplo //
1978 $
')', iinfo, n, jtype, ioldsd
1980 IF( iinfo.LT.0 )
THEN
1983 result( ntest ) = ulpinv
1990 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1991 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1992 result( ntest ) = ( temp1+temp2 ) /
1993 $ max( unfl, ulp*temp3 )
1997 CALL clacpy(
' ', n, n, v, ldu, a, lda )
1998 CALL cheevr(
'V',
'V', uplo, n, a, ldu, vl, vu, il, iu,
1999 $ abstol, m2, wa2, z, ldu, iwork, work, lwork,
2000 $ rwork, lrwork, iwork( 2*n+1 ), liwork-2*n,
2002 IF( iinfo.NE.0 )
THEN
2003 WRITE( nounit, fmt = 9999 )
'CHEEVR(V,V,' // uplo //
2004 $
')', iinfo, n, jtype, ioldsd
2006 IF( iinfo.LT.0 )
THEN
2009 result( ntest ) = ulpinv
2010 result( ntest+1 ) = ulpinv
2011 result( ntest+2 ) = ulpinv
2018 CALL clacpy(
' ', n, n, v, ldu, a, lda )
2020 CALL chet22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
2021 $ v, ldu, tau, work, rwork, result( ntest ) )
2024 CALL clacpy(
' ', n, n, v, ldu, a, lda )
2025 CALL cheevr(
'N',
'V', uplo, n, a, ldu, vl, vu, il, iu,
2026 $ abstol, m3, wa3, z, ldu, iwork, work, lwork,
2027 $ rwork, lrwork, iwork( 2*n+1 ), liwork-2*n,
2029 IF( iinfo.NE.0 )
THEN
2030 WRITE( nounit, fmt = 9999 )
'CHEEVR(N,V,' // uplo //
2031 $
')', iinfo, n, jtype, ioldsd
2033 IF( iinfo.LT.0 )
THEN
2036 result( ntest ) = ulpinv
2041 IF( m3.EQ.0 .AND. n.GT.0 )
THEN
2042 result( ntest ) = ulpinv
2048 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
2049 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
2051 temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
2055 result( ntest ) = ( temp1+temp2 ) /
2056 $ max( unfl, temp3*ulp )
2058 CALL clacpy(
' ', n, n, v, ldu, a, lda )
2072 ntestt = ntestt + ntest
2073 CALL slafts(
'CST', n, n, jtype, ntest, result, ioldsd,
2074 $ thresh, nounit, nerrs )
2081 CALL alasvm(
'CST', nounit, nerrs, ntestt, 0 )
2083 9999
FORMAT(
' CDRVST: ', a,
' returned INFO=', i6, / 9x,
'N=', i6,
2084 $
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )
2085 9998
FORMAT(
' CDRVST: ', a,
' returned INFO=', i6, / 9x,
'N=', i6,
2086 $
', KD=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
subroutine clatmr(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)
CLATMR
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine chet22(ITYPE, UPLO, N, M, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RWORK, RESULT)
CHET22
subroutine chpevd(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine cheev(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, INFO)
CHEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine chbevd(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine chpev(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK, INFO)
CHPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine slafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
SLAFTS
subroutine chpevx(JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
CHPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine chbev(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, RWORK, INFO)
CHBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
subroutine chet21(ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RWORK, RESULT)
CHET21
subroutine cheevr(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHEEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine xerbla(SRNAME, INFO)
XERBLA
real function slarnd(IDIST, ISEED)
SLARND
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
real function ssxt1(IJOB, D1, N1, D2, N2, ABSTOL, ULP, UNFL)
SSXT1
real function slamch(CMACH)
SLAMCH
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cheevd(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine cheevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, INFO)
CHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine chbevx(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
CHBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...