591
592
593
594
595
596
597 INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
598 $ NTYPES
599 DOUBLE PRECISION THRESH
600
601
602 LOGICAL DOTYPE( * )
603 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
604 DOUBLE PRECISION A( LDA, * ), AP( * ), D1( * ), D2( * ),
605 $ D3( * ), D4( * ), D5( * ), RESULT( * ),
606 $ SD( * ), SE( * ), TAU( * ), U( LDU, * ),
607 $ V( LDU, * ), VP( * ), WA1( * ), WA2( * ),
608 $ WA3( * ), WORK( * ), WR( * ), Z( LDU, * )
609
610
611
612
613
614 DOUBLE PRECISION ZERO, ONE, TWO, EIGHT, TEN, HUN
615 parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0,
616 $ eight = 8.0d0, ten = 10.0d0, hun = 100.0d0 )
617 DOUBLE PRECISION HALF
618 parameter( half = one / two )
619 INTEGER MAXTYP
620 parameter( maxtyp = 21 )
621 LOGICAL SRANGE
622 parameter( srange = .false. )
623 LOGICAL SREL
624 parameter( srel = .false. )
625
626
627 LOGICAL BADNN, TRYRAC
628 INTEGER I, IINFO, IL, IMODE, ITEMP, ITYPE, IU, J, JC,
629 $ JR, JSIZE, JTYPE, LGN, LIWEDC, LOG2UI, LWEDC,
630 $ M, M2, M3, MTYPES, N, NAP, NBLOCK, NERRS,
631 $ NMATS, NMAX, NSPLIT, NTEST, NTESTT
632 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
633 $ RTUNFL, TEMP1, TEMP2, TEMP3, TEMP4, ULP,
634 $ ULPINV, UNFL, VL, VU
635
636
637 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
638 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
639 $ KTYPE( MAXTYP )
640 DOUBLE PRECISION DUMMA( 1 )
641
642
643 INTEGER ILAENV
644 DOUBLE PRECISION DLAMCH, DLARND, DSXT1
646
647
652
653
654 INTRINSIC abs, dble, int, log, max, min, sqrt
655
656
657 DATA ktype / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
658 $ 8, 8, 9, 9, 9, 9, 9, 10 /
659 DATA kmagn / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
660 $ 2, 3, 1, 1, 1, 2, 3, 1 /
661 DATA kmode / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
662 $ 0, 0, 4, 3, 1, 4, 4, 3 /
663
664
665
666
667 idumma( 1 ) = 1
668
669
670
671 ntestt = 0
672 info = 0
673
674
675
676 badnn = .false.
677 tryrac = .true.
678 nmax = 1
679 DO 10 j = 1, nsizes
680 nmax = max( nmax, nn( j ) )
681 IF( nn( j ).LT.0 )
682 $ badnn = .true.
683 10 CONTINUE
684
685 nblock =
ilaenv( 1,
'DSYTRD',
'L', nmax, -1, -1, -1 )
686 nblock = min( nmax, max( 1, nblock ) )
687
688
689
690 IF( nsizes.LT.0 ) THEN
691 info = -1
692 ELSE IF( badnn ) THEN
693 info = -2
694 ELSE IF( ntypes.LT.0 ) THEN
695 info = -3
696 ELSE IF( lda.LT.nmax ) THEN
697 info = -9
698 ELSE IF( ldu.LT.nmax ) THEN
699 info = -23
700 ELSE IF( 2*max( 2, nmax )**2.GT.lwork ) THEN
701 info = -29
702 END IF
703
704 IF( info.NE.0 ) THEN
705 CALL xerbla(
'DCHKST', -info )
706 RETURN
707 END IF
708
709
710
711 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
712 $ RETURN
713
714
715
716 unfl =
dlamch(
'Safe minimum' )
717 ovfl = one / unfl
720 ulpinv = one / ulp
721 log2ui = int( log( ulpinv ) / log( two ) )
722 rtunfl = sqrt( unfl )
723 rtovfl = sqrt( ovfl )
724
725
726
727 DO 20 i = 1, 4
728 iseed2( i ) = iseed( i )
729 20 CONTINUE
730 nerrs = 0
731 nmats = 0
732
733 DO 310 jsize = 1, nsizes
734 n = nn( jsize )
735 IF( n.GT.0 ) THEN
736 lgn = int( log( dble( n ) ) / log( two ) )
737 IF( 2**lgn.LT.n )
738 $ lgn = lgn + 1
739 IF( 2**lgn.LT.n )
740 $ lgn = lgn + 1
741 lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
742 liwedc = 6 + 6*n + 5*n*lgn
743 ELSE
744 lwedc = 8
745 liwedc = 12
746 END IF
747 nap = ( n*( n+1 ) ) / 2
748 aninv = one / dble( max( 1, n ) )
749
750 IF( nsizes.NE.1 ) THEN
751 mtypes = min( maxtyp, ntypes )
752 ELSE
753 mtypes = min( maxtyp+1, ntypes )
754 END IF
755
756 DO 300 jtype = 1, mtypes
757 IF( .NOT.dotype( jtype ) )
758 $ GO TO 300
759 nmats = nmats + 1
760 ntest = 0
761
762 DO 30 j = 1, 4
763 ioldsd( j ) = iseed( j )
764 30 CONTINUE
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782 IF( mtypes.GT.maxtyp )
783 $ GO TO 100
784
785 itype = ktype( jtype )
786 imode = kmode( jtype )
787
788
789
790 GO TO ( 40, 50, 60 )kmagn( jtype )
791
792 40 CONTINUE
793 anorm = one
794 GO TO 70
795
796 50 CONTINUE
797 anorm = ( rtovfl*ulp )*aninv
798 GO TO 70
799
800 60 CONTINUE
801 anorm = rtunfl*n*ulpinv
802 GO TO 70
803
804 70 CONTINUE
805
806 CALL dlaset(
'Full', lda, n, zero, zero, a, lda )
807 iinfo = 0
808 IF( jtype.LE.15 ) THEN
809 cond = ulpinv
810 ELSE
811 cond = ulpinv*aninv / ten
812 END IF
813
814
815
816
817
818 IF( itype.EQ.1 ) THEN
819 iinfo = 0
820
821 ELSE IF( itype.EQ.2 ) THEN
822
823
824
825 DO 80 jc = 1, n
826 a( jc, jc ) = anorm
827 80 CONTINUE
828
829 ELSE IF( itype.EQ.4 ) THEN
830
831
832
833 CALL dlatms( n, n,
'S', iseed,
'S', work, imode, cond,
834 $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
835 $ iinfo )
836
837
838 ELSE IF( itype.EQ.5 ) THEN
839
840
841
842 CALL dlatms( n, n,
'S', iseed,
'S', work, imode, cond,
843 $ anorm, n, n, 'N', a, lda, work( n+1 ),
844 $ iinfo )
845
846 ELSE IF( itype.EQ.7 ) THEN
847
848
849
850 CALL dlatmr( n, n,
'S', iseed,
'S', work, 6, one, one,
851 $ 'T', 'N', work( n+1 ), 1, one,
852 $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
853 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
854
855 ELSE IF( itype.EQ.8 ) THEN
856
857
858
859 CALL dlatmr( n, n,
'S', iseed,
'S', work, 6, one, one,
860 $ 'T', 'N', work( n+1 ), 1, one,
861 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
862 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
863
864 ELSE IF( itype.EQ.9 ) THEN
865
866
867
868 CALL dlatms( n, n,
'S', iseed,
'P', work, imode, cond,
869 $ anorm, n, n, 'N', a, lda, work( n+1 ),
870 $ iinfo )
871
872 ELSE IF( itype.EQ.10 ) THEN
873
874
875
876 CALL dlatms( n, n,
'S', iseed,
'P', work, imode, cond,
877 $ anorm, 1, 1, 'N', a, lda, work( n+1 ),
878 $ iinfo )
879 DO 90 i = 2, n
880 temp1 = abs( a( i-1, i ) ) /
881 $ sqrt( abs( a( i-1, i-1 )*a( i, i ) ) )
882 IF( temp1.GT.half ) THEN
883 a( i-1, i ) = half*sqrt( abs( a( i-1, i-1 )*a( i,
884 $ i ) ) )
885 a( i, i-1 ) = a( i-1, i )
886 END IF
887 90 CONTINUE
888
889 ELSE
890
891 iinfo = 1
892 END IF
893
894 IF( iinfo.NE.0 ) THEN
895 WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
896 $ ioldsd
897 info = abs( iinfo )
898 RETURN
899 END IF
900
901 100 CONTINUE
902
903
904
905
906 CALL dlacpy(
'U', n, n, a, lda, v, ldu )
907
908 ntest = 1
909 CALL dsytrd(
'U', n, v, ldu, sd, se, tau, work, lwork,
910 $ iinfo )
911
912 IF( iinfo.NE.0 ) THEN
913 WRITE( nounit, fmt = 9999 )'DSYTRD(U)', iinfo, n, jtype,
914 $ ioldsd
915 info = abs( iinfo )
916 IF( iinfo.LT.0 ) THEN
917 RETURN
918 ELSE
919 result( 1 ) = ulpinv
920 GO TO 280
921 END IF
922 END IF
923
924 CALL dlacpy(
'U', n, n, v, ldu, u, ldu )
925
926 ntest = 2
927 CALL dorgtr(
'U', n, u, ldu, tau, work, lwork, iinfo )
928 IF( iinfo.NE.0 ) THEN
929 WRITE( nounit, fmt = 9999 )'DORGTR(U)', iinfo, n, jtype,
930 $ ioldsd
931 info = abs( iinfo )
932 IF( iinfo.LT.0 ) THEN
933 RETURN
934 ELSE
935 result( 2 ) = ulpinv
936 GO TO 280
937 END IF
938 END IF
939
940
941
942 CALL dsyt21( 2,
'Upper', n, 1, a, lda, sd, se, u, ldu, v,
943 $ ldu, tau, work, result( 1 ) )
944 CALL dsyt21( 3,
'Upper', n, 1, a, lda, sd, se, u, ldu, v,
945 $ ldu, tau, work, result( 2 ) )
946
947
948
949
950 CALL dlacpy(
'L', n, n, a, lda, v, ldu )
951
952 ntest = 3
953 CALL dsytrd(
'L', n, v, ldu, sd, se, tau, work, lwork,
954 $ iinfo )
955
956 IF( iinfo.NE.0 ) THEN
957 WRITE( nounit, fmt = 9999 )'DSYTRD(L)', iinfo, n, jtype,
958 $ ioldsd
959 info = abs( iinfo )
960 IF( iinfo.LT.0 ) THEN
961 RETURN
962 ELSE
963 result( 3 ) = ulpinv
964 GO TO 280
965 END IF
966 END IF
967
968 CALL dlacpy(
'L', n, n, v, ldu, u, ldu )
969
970 ntest = 4
971 CALL dorgtr(
'L', n, u, ldu, tau, work, lwork, iinfo )
972 IF( iinfo.NE.0 ) THEN
973 WRITE( nounit, fmt = 9999 )'DORGTR(L)', iinfo, n, jtype,
974 $ ioldsd
975 info = abs( iinfo )
976 IF( iinfo.LT.0 ) THEN
977 RETURN
978 ELSE
979 result( 4 ) = ulpinv
980 GO TO 280
981 END IF
982 END IF
983
984 CALL dsyt21( 2,
'Lower', n, 1, a, lda, sd, se, u, ldu, v,
985 $ ldu, tau, work, result( 3 ) )
986 CALL dsyt21( 3,
'Lower', n, 1, a, lda, sd, se, u, ldu, v,
987 $ ldu, tau, work, result( 4 ) )
988
989
990
991 i = 0
992 DO 120 jc = 1, n
993 DO 110 jr = 1, jc
994 i = i + 1
995 ap( i ) = a( jr, jc )
996 110 CONTINUE
997 120 CONTINUE
998
999
1000
1001 CALL dcopy( nap, ap, 1, vp, 1 )
1002
1003 ntest = 5
1004 CALL dsptrd(
'U', n, vp, sd, se, tau, iinfo )
1005
1006 IF( iinfo.NE.0 ) THEN
1007 WRITE( nounit, fmt = 9999 )'DSPTRD(U)', iinfo, n, jtype,
1008 $ ioldsd
1009 info = abs( iinfo )
1010 IF( iinfo.LT.0 ) THEN
1011 RETURN
1012 ELSE
1013 result( 5 ) = ulpinv
1014 GO TO 280
1015 END IF
1016 END IF
1017
1018 ntest = 6
1019 CALL dopgtr(
'U', n, vp, tau, u, ldu, work, iinfo )
1020 IF( iinfo.NE.0 ) THEN
1021 WRITE( nounit, fmt = 9999 )'DOPGTR(U)', iinfo, n, jtype,
1022 $ ioldsd
1023 info = abs( iinfo )
1024 IF( iinfo.LT.0 ) THEN
1025 RETURN
1026 ELSE
1027 result( 6 ) = ulpinv
1028 GO TO 280
1029 END IF
1030 END IF
1031
1032
1033
1034 CALL dspt21( 2,
'Upper', n, 1, ap, sd, se, u, ldu, vp, tau,
1035 $ work, result( 5 ) )
1036 CALL dspt21( 3,
'Upper', n, 1, ap, sd, se, u, ldu, vp, tau,
1037 $ work, result( 6 ) )
1038
1039
1040
1041 i = 0
1042 DO 140 jc = 1, n
1043 DO 130 jr = jc, n
1044 i = i + 1
1045 ap( i ) = a( jr, jc )
1046 130 CONTINUE
1047 140 CONTINUE
1048
1049
1050
1051 CALL dcopy( nap, ap, 1, vp, 1 )
1052
1053 ntest = 7
1054 CALL dsptrd(
'L', n, vp, sd, se, tau, iinfo )
1055
1056 IF( iinfo.NE.0 ) THEN
1057 WRITE( nounit, fmt = 9999 )'DSPTRD(L)', iinfo, n, jtype,
1058 $ ioldsd
1059 info = abs( iinfo )
1060 IF( iinfo.LT.0 ) THEN
1061 RETURN
1062 ELSE
1063 result( 7 ) = ulpinv
1064 GO TO 280
1065 END IF
1066 END IF
1067
1068 ntest = 8
1069 CALL dopgtr(
'L', n, vp, tau, u, ldu, work, iinfo )
1070 IF( iinfo.NE.0 ) THEN
1071 WRITE( nounit, fmt = 9999 )'DOPGTR(L)', iinfo, n, jtype,
1072 $ ioldsd
1073 info = abs( iinfo )
1074 IF( iinfo.LT.0 ) THEN
1075 RETURN
1076 ELSE
1077 result( 8 ) = ulpinv
1078 GO TO 280
1079 END IF
1080 END IF
1081
1082 CALL dspt21( 2,
'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1083 $ work, result( 7 ) )
1084 CALL dspt21( 3,
'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1085 $ work, result( 8 ) )
1086
1087
1088
1089
1090
1091 CALL dcopy( n, sd, 1, d1, 1 )
1092 IF( n.GT.0 )
1093 $
CALL dcopy( n-1, se, 1, work, 1 )
1094 CALL dlaset(
'Full', n, n, zero, one, z, ldu )
1095
1096 ntest = 9
1097 CALL dsteqr(
'V', n, d1, work, z, ldu, work( n+1 ), iinfo )
1098 IF( iinfo.NE.0 ) THEN
1099 WRITE( nounit, fmt = 9999 )'DSTEQR(V)', iinfo, n, jtype,
1100 $ ioldsd
1101 info = abs( iinfo )
1102 IF( iinfo.LT.0 ) THEN
1103 RETURN
1104 ELSE
1105 result( 9 ) = ulpinv
1106 GO TO 280
1107 END IF
1108 END IF
1109
1110
1111
1112 CALL dcopy( n, sd, 1, d2, 1 )
1113 IF( n.GT.0 )
1114 $
CALL dcopy( n-1, se, 1, work, 1 )
1115
1116 ntest = 11
1117 CALL dsteqr(
'N', n, d2, work, work( n+1 ), ldu,
1118 $ work( n+1 ), iinfo )
1119 IF( iinfo.NE.0 ) THEN
1120 WRITE( nounit, fmt = 9999 )'DSTEQR(N)', iinfo, n, jtype,
1121 $ ioldsd
1122 info = abs( iinfo )
1123 IF( iinfo.LT.0 ) THEN
1124 RETURN
1125 ELSE
1126 result( 11 ) = ulpinv
1127 GO TO 280
1128 END IF
1129 END IF
1130
1131
1132
1133 CALL dcopy( n, sd, 1, d3, 1 )
1134 IF( n.GT.0 )
1135 $
CALL dcopy( n-1, se, 1, work, 1 )
1136
1137 ntest = 12
1138 CALL dsterf( n, d3, work, iinfo )
1139 IF( iinfo.NE.0 ) THEN
1140 WRITE( nounit, fmt = 9999 )'DSTERF', iinfo, n, jtype,
1141 $ ioldsd
1142 info = abs( iinfo )
1143 IF( iinfo.LT.0 ) THEN
1144 RETURN
1145 ELSE
1146 result( 12 ) = ulpinv
1147 GO TO 280
1148 END IF
1149 END IF
1150
1151
1152
1153 CALL dstt21( n, 0, sd, se, d1, dumma, z, ldu, work,
1154 $ result( 9 ) )
1155
1156
1157
1158 temp1 = zero
1159 temp2 = zero
1160 temp3 = zero
1161 temp4 = zero
1162
1163 DO 150 j = 1, n
1164 temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1165 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1166 temp3 = max( temp3, abs( d1( j ) ), abs( d3( j ) ) )
1167 temp4 = max( temp4, abs( d1( j )-d3( j ) ) )
1168 150 CONTINUE
1169
1170 result( 11 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1171 result( 12 ) = temp4 / max( unfl, ulp*max( temp3, temp4 ) )
1172
1173
1174
1175
1176 ntest = 13
1177 temp1 = thresh*( half-ulp )
1178
1179 DO 160 j = 0, log2ui
1180 CALL dstech( n, sd, se, d1, temp1, work, iinfo )
1181 IF( iinfo.EQ.0 )
1182 $ GO TO 170
1183 temp1 = temp1*two
1184 160 CONTINUE
1185
1186 170 CONTINUE
1187 result( 13 ) = temp1
1188
1189
1190
1191
1192 IF( jtype.GT.15 ) THEN
1193
1194
1195
1196 CALL dcopy( n, sd, 1, d4, 1 )
1197 IF( n.GT.0 )
1198 $
CALL dcopy( n-1, se, 1, work, 1 )
1199 CALL dlaset(
'Full', n, n, zero, one, z, ldu )
1200
1201 ntest = 14
1202 CALL dpteqr(
'V', n, d4, work, z, ldu, work( n+1 ),
1203 $ iinfo )
1204 IF( iinfo.NE.0 ) THEN
1205 WRITE( nounit, fmt = 9999 )'DPTEQR(V)', iinfo, n,
1206 $ jtype, ioldsd
1207 info = abs( iinfo )
1208 IF( iinfo.LT.0 ) THEN
1209 RETURN
1210 ELSE
1211 result( 14 ) = ulpinv
1212 GO TO 280
1213 END IF
1214 END IF
1215
1216
1217
1218 CALL dstt21( n, 0, sd, se, d4, dumma, z, ldu, work,
1219 $ result( 14 ) )
1220
1221
1222
1223 CALL dcopy( n, sd, 1, d5, 1 )
1224 IF( n.GT.0 )
1225 $
CALL dcopy( n-1, se, 1, work, 1 )
1226
1227 ntest = 16
1228 CALL dpteqr(
'N', n, d5, work, z, ldu, work( n+1 ),
1229 $ iinfo )
1230 IF( iinfo.NE.0 ) THEN
1231 WRITE( nounit, fmt = 9999 )'DPTEQR(N)', iinfo, n,
1232 $ jtype, ioldsd
1233 info = abs( iinfo )
1234 IF( iinfo.LT.0 ) THEN
1235 RETURN
1236 ELSE
1237 result( 16 ) = ulpinv
1238 GO TO 280
1239 END IF
1240 END IF
1241
1242
1243
1244 temp1 = zero
1245 temp2 = zero
1246 DO 180 j = 1, n
1247 temp1 = max( temp1, abs( d4( j ) ), abs( d5( j ) ) )
1248 temp2 = max( temp2, abs( d4( j )-d5( j ) ) )
1249 180 CONTINUE
1250
1251 result( 16 ) = temp2 / max( unfl,
1252 $ hun*ulp*max( temp1, temp2 ) )
1253 ELSE
1254 result( 14 ) = zero
1255 result( 15 ) = zero
1256 result( 16 ) = zero
1257 END IF
1258
1259
1260
1261
1262
1263
1264 vl = zero
1265 vu = zero
1266 il = 0
1267 iu = 0
1268 IF( jtype.EQ.21 ) THEN
1269 ntest = 17
1270 abstol = unfl + unfl
1271 CALL dstebz(
'A',
'E', n, vl, vu, il, iu, abstol, sd, se,
1272 $ m, nsplit, wr, iwork( 1 ), iwork( n+1 ),
1273 $ work, iwork( 2*n+1 ), iinfo )
1274 IF( iinfo.NE.0 ) THEN
1275 WRITE( nounit, fmt = 9999 )'DSTEBZ(A,rel)', iinfo, n,
1276 $ jtype, ioldsd
1277 info = abs( iinfo )
1278 IF( iinfo.LT.0 ) THEN
1279 RETURN
1280 ELSE
1281 result( 17 ) = ulpinv
1282 GO TO 280
1283 END IF
1284 END IF
1285
1286
1287
1288 temp2 = two*( two*n-one )*ulp*( one+eight*half**2 ) /
1289 $ ( one-half )**4
1290
1291 temp1 = zero
1292 DO 190 j = 1, n
1293 temp1 = max( temp1, abs( d4( j )-wr( n-j+1 ) ) /
1294 $ ( abstol+abs( d4( j ) ) ) )
1295 190 CONTINUE
1296
1297 result( 17 ) = temp1 / temp2
1298 ELSE
1299 result( 17 ) = zero
1300 END IF
1301
1302
1303
1304 ntest = 18
1305 abstol = unfl + unfl
1306 CALL dstebz(
'A',
'E', n, vl, vu, il, iu, abstol, sd, se, m,
1307 $ nsplit, wa1, iwork( 1 ), iwork( n+1 ), work,
1308 $ iwork( 2*n+1 ), iinfo )
1309 IF( iinfo.NE.0 ) THEN
1310 WRITE( nounit, fmt = 9999 )'DSTEBZ(A)', iinfo, n, jtype,
1311 $ ioldsd
1312 info = abs( iinfo )
1313 IF( iinfo.LT.0 ) THEN
1314 RETURN
1315 ELSE
1316 result( 18 ) = ulpinv
1317 GO TO 280
1318 END IF
1319 END IF
1320
1321
1322
1323 temp1 = zero
1324 temp2 = zero
1325 DO 200 j = 1, n
1326 temp1 = max( temp1, abs( d3( j ) ), abs( wa1( j ) ) )
1327 temp2 = max( temp2, abs( d3( j )-wa1( j ) ) )
1328 200 CONTINUE
1329
1330 result( 18 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1331
1332
1333
1334
1335 ntest = 19
1336 IF( n.LE.1 ) THEN
1337 il = 1
1338 iu = n
1339 ELSE
1340 il = 1 + ( n-1 )*int(
dlarnd( 1, iseed2 ) )
1341 iu = 1 + ( n-1 )*int(
dlarnd( 1, iseed2 ) )
1342 IF( iu.LT.il ) THEN
1343 itemp = iu
1344 iu = il
1345 il = itemp
1346 END IF
1347 END IF
1348
1349 CALL dstebz(
'I',
'E', n, vl, vu, il, iu, abstol, sd, se,
1350 $ m2, nsplit, wa2, iwork( 1 ), iwork( n+1 ),
1351 $ work, iwork( 2*n+1 ), iinfo )
1352 IF( iinfo.NE.0 ) THEN
1353 WRITE( nounit, fmt = 9999 )'DSTEBZ(I)', iinfo, n, jtype,
1354 $ ioldsd
1355 info = abs( iinfo )
1356 IF( iinfo.LT.0 ) THEN
1357 RETURN
1358 ELSE
1359 result( 19 ) = ulpinv
1360 GO TO 280
1361 END IF
1362 END IF
1363
1364
1365
1366
1367 IF( n.GT.0 ) THEN
1368 IF( il.NE.1 ) THEN
1369 vl = wa1( il ) - max( half*( wa1( il )-wa1( il-1 ) ),
1370 $ ulp*anorm, two*rtunfl )
1371 ELSE
1372 vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
1373 $ ulp*anorm, two*rtunfl )
1374 END IF
1375 IF( iu.NE.n ) THEN
1376 vu = wa1( iu ) + max( half*( wa1( iu+1 )-wa1( iu ) ),
1377 $ ulp*anorm, two*rtunfl )
1378 ELSE
1379 vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
1380 $ ulp*anorm, two*rtunfl )
1381 END IF
1382 ELSE
1383 vl = zero
1384 vu = one
1385 END IF
1386
1387 CALL dstebz(
'V',
'E', n, vl, vu, il, iu, abstol, sd, se,
1388 $ m3, nsplit, wa3, iwork( 1 ), iwork( n+1 ),
1389 $ work, iwork( 2*n+1 ), iinfo )
1390 IF( iinfo.NE.0 ) THEN
1391 WRITE( nounit, fmt = 9999 )'DSTEBZ(V)', iinfo, n, jtype,
1392 $ ioldsd
1393 info = abs( iinfo )
1394 IF( iinfo.LT.0 ) THEN
1395 RETURN
1396 ELSE
1397 result( 19 ) = ulpinv
1398 GO TO 280
1399 END IF
1400 END IF
1401
1402 IF( m3.EQ.0 .AND. n.NE.0 ) THEN
1403 result( 19 ) = ulpinv
1404 GO TO 280
1405 END IF
1406
1407
1408
1409 temp1 =
dsxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1410 temp2 =
dsxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1411 IF( n.GT.0 ) THEN
1412 temp3 = max( abs( wa1( n ) ), abs( wa1( 1 ) ) )
1413 ELSE
1414 temp3 = zero
1415 END IF
1416
1417 result( 19 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1418
1419
1420
1421
1422
1423 ntest = 21
1424 CALL dstebz(
'A',
'B', n, vl, vu, il, iu, abstol, sd, se, m,
1425 $ nsplit, wa1, iwork( 1 ), iwork( n+1 ), work,
1426 $ iwork( 2*n+1 ), iinfo )
1427 IF( iinfo.NE.0 ) THEN
1428 WRITE( nounit, fmt = 9999 )'DSTEBZ(A,B)', iinfo, n,
1429 $ jtype, ioldsd
1430 info = abs( iinfo )
1431 IF( iinfo.LT.0 ) THEN
1432 RETURN
1433 ELSE
1434 result( 20 ) = ulpinv
1435 result( 21 ) = ulpinv
1436 GO TO 280
1437 END IF
1438 END IF
1439
1440 CALL dstein( n, sd, se, m, wa1, iwork( 1 ), iwork( n+1 ), z,
1441 $ ldu, work, iwork( 2*n+1 ), iwork( 3*n+1 ),
1442 $ iinfo )
1443 IF( iinfo.NE.0 ) THEN
1444 WRITE( nounit, fmt = 9999 )'DSTEIN', iinfo, n, jtype,
1445 $ ioldsd
1446 info = abs( iinfo )
1447 IF( iinfo.LT.0 ) THEN
1448 RETURN
1449 ELSE
1450 result( 20 ) = ulpinv
1451 result( 21 ) = ulpinv
1452 GO TO 280
1453 END IF
1454 END IF
1455
1456
1457
1458 CALL dstt21( n, 0, sd, se, wa1, dumma, z, ldu, work,
1459 $ result( 20 ) )
1460
1461
1462
1463
1464
1465 CALL dcopy( n, sd, 1, d1, 1 )
1466 IF( n.GT.0 )
1467 $
CALL dcopy( n-1, se, 1, work, 1 )
1468 CALL dlaset(
'Full', n, n, zero, one, z, ldu )
1469
1470 ntest = 22
1471 CALL dstedc(
'I', n, d1, work, z, ldu, work( n+1 ), lwedc-n,
1472 $ iwork, liwedc, iinfo )
1473 IF( iinfo.NE.0 ) THEN
1474 WRITE( nounit, fmt = 9999 )'DSTEDC(I)', iinfo, n, jtype,
1475 $ ioldsd
1476 info = abs( iinfo )
1477 IF( iinfo.LT.0 ) THEN
1478 RETURN
1479 ELSE
1480 result( 22 ) = ulpinv
1481 GO TO 280
1482 END IF
1483 END IF
1484
1485
1486
1487 CALL dstt21( n, 0, sd, se, d1, dumma, z, ldu, work,
1488 $ result( 22 ) )
1489
1490
1491
1492
1493
1494 CALL dcopy( n, sd, 1, d1, 1 )
1495 IF( n.GT.0 )
1496 $
CALL dcopy( n-1, se, 1, work, 1 )
1497 CALL dlaset(
'Full', n, n, zero, one, z, ldu )
1498
1499 ntest = 24
1500 CALL dstedc(
'V', n, d1, work, z, ldu, work( n+1 ), lwedc-n,
1501 $ iwork, liwedc, iinfo )
1502 IF( iinfo.NE.0 ) THEN
1503 WRITE( nounit, fmt = 9999 )'DSTEDC(V)', iinfo, n, jtype,
1504 $ ioldsd
1505 info = abs( iinfo )
1506 IF( iinfo.LT.0 ) THEN
1507 RETURN
1508 ELSE
1509 result( 24 ) = ulpinv
1510 GO TO 280
1511 END IF
1512 END IF
1513
1514
1515
1516 CALL dstt21( n, 0, sd, se, d1, dumma, z, ldu, work,
1517 $ result( 24 ) )
1518
1519
1520
1521
1522
1523 CALL dcopy( n, sd, 1, d2, 1 )
1524 IF( n.GT.0 )
1525 $
CALL dcopy( n-1, se, 1, work, 1 )
1526 CALL dlaset(
'Full', n, n, zero, one, z, ldu )
1527
1528 ntest = 26
1529 CALL dstedc(
'N', n, d2, work, z, ldu, work( n+1 ), lwedc-n,
1530 $ iwork, liwedc, iinfo )
1531 IF( iinfo.NE.0 ) THEN
1532 WRITE( nounit, fmt = 9999 )'DSTEDC(N)', iinfo, n, jtype,
1533 $ ioldsd
1534 info = abs( iinfo )
1535 IF( iinfo.LT.0 ) THEN
1536 RETURN
1537 ELSE
1538 result( 26 ) = ulpinv
1539 GO TO 280
1540 END IF
1541 END IF
1542
1543
1544
1545 temp1 = zero
1546 temp2 = zero
1547
1548 DO 210 j = 1, n
1549 temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1550 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1551 210 CONTINUE
1552
1553 result( 26 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1554
1555
1556
1557 IF(
ilaenv( 10,
'DSTEMR',
'VA', 1, 0, 0, 0 ).EQ.1 .AND.
1558 $
ilaenv( 11,
'DSTEMR',
'VA', 1, 0, 0, 0 ).EQ.1 )
THEN
1559
1560
1561
1562
1563
1564
1565 vl = zero
1566 vu = zero
1567 il = 0
1568 iu = 0
1569 IF( jtype.EQ.21 .AND. srel ) THEN
1570 ntest = 27
1571 abstol = unfl + unfl
1572 CALL dstemr(
'V',
'A', n, sd, se, vl, vu, il, iu,
1573 $ m, wr, z, ldu, n, iwork( 1 ), tryrac,
1574 $ work, lwork, iwork( 2*n+1 ), lwork-2*n,
1575 $ iinfo )
1576 IF( iinfo.NE.0 ) THEN
1577 WRITE( nounit, fmt = 9999 )'DSTEMR(V,A,rel)',
1578 $ iinfo, n, jtype, ioldsd
1579 info = abs( iinfo )
1580 IF( iinfo.LT.0 ) THEN
1581 RETURN
1582 ELSE
1583 result( 27 ) = ulpinv
1584 GO TO 270
1585 END IF
1586 END IF
1587
1588
1589
1590 temp2 = two*( two*n-one )*ulp*( one+eight*half**2 ) /
1591 $ ( one-half )**4
1592
1593 temp1 = zero
1594 DO 220 j = 1, n
1595 temp1 = max( temp1, abs( d4( j )-wr( n-j+1 ) ) /
1596 $ ( abstol+abs( d4( j ) ) ) )
1597 220 CONTINUE
1598
1599 result( 27 ) = temp1 / temp2
1600
1601 il = 1 + ( n-1 )*int(
dlarnd( 1, iseed2 ) )
1602 iu = 1 + ( n-1 )*int(
dlarnd( 1, iseed2 ) )
1603 IF( iu.LT.il ) THEN
1604 itemp = iu
1605 iu = il
1606 il = itemp
1607 END IF
1608
1609 IF( srange ) THEN
1610 ntest = 28
1611 abstol = unfl + unfl
1612 CALL dstemr(
'V',
'I', n, sd, se, vl, vu, il, iu,
1613 $ m, wr, z, ldu, n, iwork( 1 ), tryrac,
1614 $ work, lwork, iwork( 2*n+1 ),
1615 $ lwork-2*n, iinfo )
1616
1617 IF( iinfo.NE.0 ) THEN
1618 WRITE( nounit, fmt = 9999 )'DSTEMR(V,I,rel)',
1619 $ iinfo, n, jtype, ioldsd
1620 info = abs( iinfo )
1621 IF( iinfo.LT.0 ) THEN
1622 RETURN
1623 ELSE
1624 result( 28 ) = ulpinv
1625 GO TO 270
1626 END IF
1627 END IF
1628
1629
1630
1631
1632 temp2 = two*( two*n-one )*ulp*
1633 $ ( one+eight*half**2 ) / ( one-half )**4
1634
1635 temp1 = zero
1636 DO 230 j = il, iu
1637 temp1 = max( temp1, abs( wr( j-il+1 )-d4( n-j+
1638 $ 1 ) ) / ( abstol+abs( wr( j-il+1 ) ) ) )
1639 230 CONTINUE
1640
1641 result( 28 ) = temp1 / temp2
1642 ELSE
1643 result( 28 ) = zero
1644 END IF
1645 ELSE
1646 result( 27 ) = zero
1647 result( 28 ) = zero
1648 END IF
1649
1650
1651
1652
1653
1654 CALL dcopy( n, sd, 1, d5, 1 )
1655 IF( n.GT.0 )
1656 $
CALL dcopy( n-1, se, 1, work, 1 )
1657 CALL dlaset(
'Full', n, n, zero, one, z, ldu )
1658
1659 IF( srange ) THEN
1660 ntest = 29
1661 il = 1 + ( n-1 )*int(
dlarnd( 1, iseed2 ) )
1662 iu = 1 + ( n-1 )*int(
dlarnd( 1, iseed2 ) )
1663 IF( iu.LT.il ) THEN
1664 itemp = iu
1665 iu = il
1666 il = itemp
1667 END IF
1668 CALL dstemr(
'V',
'I', n, d5, work, vl, vu, il, iu,
1669 $ m, d1, z, ldu, n, iwork( 1 ), tryrac,
1670 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1671 $ liwork-2*n, iinfo )
1672 IF( iinfo.NE.0 ) THEN
1673 WRITE( nounit, fmt = 9999 )'DSTEMR(V,I)', iinfo,
1674 $ n, jtype, ioldsd
1675 info = abs( iinfo )
1676 IF( iinfo.LT.0 ) THEN
1677 RETURN
1678 ELSE
1679 result( 29 ) = ulpinv
1680 GO TO 280
1681 END IF
1682 END IF
1683
1684
1685
1686 CALL dstt22( n, m, 0, sd, se, d1, dumma, z, ldu, work,
1687 $ m, result( 29 ) )
1688
1689
1690
1691
1692
1693 CALL dcopy( n, sd, 1, d5, 1 )
1694 IF( n.GT.0 )
1695 $
CALL dcopy( n-1, se, 1, work, 1 )
1696
1697 ntest = 31
1698 CALL dstemr(
'N',
'I', n, d5, work, vl, vu, il, iu,
1699 $ m, d2, z, ldu, n, iwork( 1 ), tryrac,
1700 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1701 $ liwork-2*n, iinfo )
1702 IF( iinfo.NE.0 ) THEN
1703 WRITE( nounit, fmt = 9999 )'DSTEMR(N,I)', iinfo,
1704 $ n, jtype, ioldsd
1705 info = abs( iinfo )
1706 IF( iinfo.LT.0 ) THEN
1707 RETURN
1708 ELSE
1709 result( 31 ) = ulpinv
1710 GO TO 280
1711 END IF
1712 END IF
1713
1714
1715
1716 temp1 = zero
1717 temp2 = zero
1718
1719 DO 240 j = 1, iu - il + 1
1720 temp1 = max( temp1, abs( d1( j ) ),
1721 $ abs( d2( j ) ) )
1722 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1723 240 CONTINUE
1724
1725 result( 31 ) = temp2 / max( unfl,
1726 $ ulp*max( temp1, temp2 ) )
1727
1728
1729
1730
1731
1732
1733 CALL dcopy( n, sd, 1, d5, 1 )
1734 IF( n.GT.0 )
1735 $
CALL dcopy( n-1, se, 1, work, 1 )
1736 CALL dlaset(
'Full', n, n, zero, one, z, ldu )
1737
1738 ntest = 32
1739
1740 IF( n.GT.0 ) THEN
1741 IF( il.NE.1 ) THEN
1742 vl = d2( il ) - max( half*
1743 $ ( d2( il )-d2( il-1 ) ), ulp*anorm,
1744 $ two*rtunfl )
1745 ELSE
1746 vl = d2( 1 ) - max( half*( d2( n )-d2( 1 ) ),
1747 $ ulp*anorm, two*rtunfl )
1748 END IF
1749 IF( iu.NE.n ) THEN
1750 vu = d2( iu ) + max( half*
1751 $ ( d2( iu+1 )-d2( iu ) ), ulp*anorm,
1752 $ two*rtunfl )
1753 ELSE
1754 vu = d2( n ) + max( half*( d2( n )-d2( 1 ) ),
1755 $ ulp*anorm, two*rtunfl )
1756 END IF
1757 ELSE
1758 vl = zero
1759 vu = one
1760 END IF
1761
1762 CALL dstemr(
'V',
'V', n, d5, work, vl, vu, il, iu,
1763 $ m, d1, z, ldu, n, iwork( 1 ), tryrac,
1764 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1765 $ liwork-2*n, iinfo )
1766 IF( iinfo.NE.0 ) THEN
1767 WRITE( nounit, fmt = 9999 )'DSTEMR(V,V)', iinfo,
1768 $ n, jtype, ioldsd
1769 info = abs( iinfo )
1770 IF( iinfo.LT.0 ) THEN
1771 RETURN
1772 ELSE
1773 result( 32 ) = ulpinv
1774 GO TO 280
1775 END IF
1776 END IF
1777
1778
1779
1780 CALL dstt22( n, m, 0, sd, se, d1, dumma, z, ldu, work,
1781 $ m, result( 32 ) )
1782
1783
1784
1785
1786
1787 CALL dcopy( n, sd, 1, d5, 1 )
1788 IF( n.GT.0 )
1789 $
CALL dcopy( n-1, se, 1, work, 1 )
1790
1791 ntest = 34
1792 CALL dstemr(
'N',
'V', n, d5, work, vl, vu, il, iu,
1793 $ m, d2, z, ldu, n, iwork( 1 ), tryrac,
1794 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1795 $ liwork-2*n, iinfo )
1796 IF( iinfo.NE.0 ) THEN
1797 WRITE( nounit, fmt = 9999 )'DSTEMR(N,V)', iinfo,
1798 $ n, jtype, ioldsd
1799 info = abs( iinfo )
1800 IF( iinfo.LT.0 ) THEN
1801 RETURN
1802 ELSE
1803 result( 34 ) = ulpinv
1804 GO TO 280
1805 END IF
1806 END IF
1807
1808
1809
1810 temp1 = zero
1811 temp2 = zero
1812
1813 DO 250 j = 1, iu - il + 1
1814 temp1 = max( temp1, abs( d1( j ) ),
1815 $ abs( d2( j ) ) )
1816 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1817 250 CONTINUE
1818
1819 result( 34 ) = temp2 / max( unfl,
1820 $ ulp*max( temp1, temp2 ) )
1821 ELSE
1822 result( 29 ) = zero
1823 result( 30 ) = zero
1824 result( 31 ) = zero
1825 result( 32 ) = zero
1826 result( 33 ) = zero
1827 result( 34 ) = zero
1828 END IF
1829
1830
1831
1832
1833
1834
1835 CALL dcopy( n, sd, 1, d5, 1 )
1836 IF( n.GT.0 )
1837 $
CALL dcopy( n-1, se, 1, work, 1 )
1838
1839 ntest = 35
1840
1841 CALL dstemr(
'V',
'A', n, d5, work, vl, vu, il, iu,
1842 $ m, d1, z, ldu, n, iwork( 1 ), tryrac,
1843 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1844 $ liwork-2*n, iinfo )
1845 IF( iinfo.NE.0 ) THEN
1846 WRITE( nounit, fmt = 9999 )'DSTEMR(V,A)', iinfo, n,
1847 $ jtype, ioldsd
1848 info = abs( iinfo )
1849 IF( iinfo.LT.0 ) THEN
1850 RETURN
1851 ELSE
1852 result( 35 ) = ulpinv
1853 GO TO 280
1854 END IF
1855 END IF
1856
1857
1858
1859 CALL dstt22( n, m, 0, sd, se, d1, dumma, z, ldu, work, m,
1860 $ result( 35 ) )
1861
1862
1863
1864
1865
1866 CALL dcopy( n, sd, 1, d5, 1 )
1867 IF( n.GT.0 )
1868 $
CALL dcopy( n-1, se, 1, work, 1 )
1869
1870 ntest = 37
1871 CALL dstemr(
'N',
'A', n, d5, work, vl, vu, il, iu,
1872 $ m, d2, z, ldu, n, iwork( 1 ), tryrac,
1873 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1874 $ liwork-2*n, iinfo )
1875 IF( iinfo.NE.0 ) THEN
1876 WRITE( nounit, fmt = 9999 )'DSTEMR(N,A)', iinfo, n,
1877 $ jtype, ioldsd
1878 info = abs( iinfo )
1879 IF( iinfo.LT.0 ) THEN
1880 RETURN
1881 ELSE
1882 result( 37 ) = ulpinv
1883 GO TO 280
1884 END IF
1885 END IF
1886
1887
1888
1889 temp1 = zero
1890 temp2 = zero
1891
1892 DO 260 j = 1, n
1893 temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1894 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1895 260 CONTINUE
1896
1897 result( 37 ) = temp2 / max( unfl,
1898 $ ulp*max( temp1, temp2 ) )
1899 END IF
1900 270 CONTINUE
1901 280 CONTINUE
1902 ntestt = ntestt + ntest
1903
1904
1905
1906
1907
1908
1909 DO 290 jr = 1, ntest
1910 IF( result( jr ).GE.thresh ) THEN
1911
1912
1913
1914
1915 IF( nerrs.EQ.0 ) THEN
1916 WRITE( nounit, fmt = 9998 )'DST'
1917 WRITE( nounit, fmt = 9997 )
1918 WRITE( nounit, fmt = 9996 )
1919 WRITE( nounit, fmt = 9995 )'Symmetric'
1920 WRITE( nounit, fmt = 9994 )
1921
1922
1923
1924 WRITE( nounit, fmt = 9988 )
1925 END IF
1926 nerrs = nerrs + 1
1927 WRITE( nounit, fmt = 9990 )n, ioldsd, jtype, jr,
1928 $ result( jr )
1929 END IF
1930 290 CONTINUE
1931 300 CONTINUE
1932 310 CONTINUE
1933
1934
1935
1936 CALL dlasum(
'DST', nounit, nerrs, ntestt )
1937 RETURN
1938
1939 9999 FORMAT( ' DCHKST: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
1940 $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1941
1942 9998 FORMAT( / 1x, a3, ' -- Real Symmetric eigenvalue problem' )
1943 9997 FORMAT( ' Matrix types (see DCHKST for details): ' )
1944
1945 9996 FORMAT( / ' Special Matrices:',
1946 $ / ' 1=Zero matrix. ',
1947 $ ' 5=Diagonal: clustered entries.',
1948 $ / ' 2=Identity matrix. ',
1949 $ ' 6=Diagonal: large, evenly spaced.',
1950 $ / ' 3=Diagonal: evenly spaced entries. ',
1951 $ ' 7=Diagonal: small, evenly spaced.',
1952 $ / ' 4=Diagonal: geometr. spaced entries.' )
1953 9995 FORMAT( ' Dense ', a, ' Matrices:',
1954 $ / ' 8=Evenly spaced eigenvals. ',
1955 $ ' 12=Small, evenly spaced eigenvals.',
1956 $ / ' 9=Geometrically spaced eigenvals. ',
1957 $ ' 13=Matrix with random O(1) entries.',
1958 $ / ' 10=Clustered eigenvalues. ',
1959 $ ' 14=Matrix with large random entries.',
1960 $ / ' 11=Large, evenly spaced eigenvals. ',
1961 $ ' 15=Matrix with small random entries.' )
1962 9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues',
1963 $ / ' 17=Positive definite, geometrically spaced eigenvlaues',
1964 $ / ' 18=Positive definite, clustered eigenvalues',
1965 $ / ' 19=Positive definite, small evenly spaced eigenvalues',
1966 $ / ' 20=Positive definite, large evenly spaced eigenvalues',
1967 $ / ' 21=Diagonally dominant tridiagonal, geometrically',
1968 $ ' spaced eigenvalues' )
1969
1970 9990 FORMAT( ' N=', i5, ', seed=', 4( i4, ',' ), ' type ', i2,
1971 $ ', test(', i2, ')=', g10.3 )
1972
1973 9988 FORMAT( / 'Test performed: see DCHKST for details.', / )
1974
1975
double precision function dlamch(CMACH)
DLAMCH
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
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.
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
subroutine dstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEDC
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
double precision function dsxt1(IJOB, D1, N1, D2, N2, ABSTOL, ULP, UNFL)
DSXT1
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
subroutine dstt22(N, M, KBAND, AD, AE, SD, SE, U, LDU, WORK, LDWORK, RESULT)
DSTT22
subroutine dspt21(ITYPE, UPLO, N, KBAND, AP, D, E, U, LDU, VP, TAU, WORK, RESULT)
DSPT21
subroutine dstech(N, A, B, EIG, TOL, WORK, INFO)
DSTECH
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 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
double precision function dlarnd(IDIST, ISEED)
DLARND
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEMR
subroutine dsptrd(UPLO, N, AP, D, E, TAU, INFO)
DSPTRD
subroutine dstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEIN
subroutine dopgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
DOPGTR
subroutine dorgtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
DORGTR
subroutine dpteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DPTEQR
subroutine dsytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
DSYTRD