591
592
593
594
595
596
597 INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
598 $ NTYPES
599 REAL THRESH
600
601
602 LOGICAL DOTYPE( * )
603 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
604 REAL 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 REAL ZERO, ONE, TWO, EIGHT, TEN, HUN
615 parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
616 $ eight = 8.0e0, ten = 10.0e0, hun = 100.0e0 )
617 REAL 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 REAL 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 REAL DUMMA( 1 )
641
642
643 INTEGER ILAENV
644 REAL SLAMCH, SLARND, SSXT1
646
647
652
653
654 INTRINSIC abs, int, log, max, min, real, 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,
'SSYTRD',
'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(
'SCHKST', -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 =
slamch(
'Safe minimum' )
717 ovfl = one / unfl
719 ulpinv = one / ulp
720 log2ui = int( log( ulpinv ) / log( two ) )
721 rtunfl = sqrt( unfl )
722 rtovfl = sqrt( ovfl )
723
724
725
726 DO 20 i = 1, 4
727 iseed2( i ) = iseed( i )
728 20 CONTINUE
729 nerrs = 0
730 nmats = 0
731
732 DO 310 jsize = 1, nsizes
733 n = nn( jsize )
734 IF( n.GT.0 ) THEN
735 lgn = int( log( real( n ) ) / log( two ) )
736 IF( 2**lgn.LT.n )
737 $ lgn = lgn + 1
738 IF( 2**lgn.LT.n )
739 $ lgn = lgn + 1
740 lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
741 liwedc = 6 + 6*n + 5*n*lgn
742 ELSE
743 lwedc = 8
744 liwedc = 12
745 END IF
746 nap = ( n*( n+1 ) ) / 2
747 aninv = one / real( max( 1, n ) )
748
749 IF( nsizes.NE.1 ) THEN
750 mtypes = min( maxtyp, ntypes )
751 ELSE
752 mtypes = min( maxtyp+1, ntypes )
753 END IF
754
755 DO 300 jtype = 1, mtypes
756 IF( .NOT.dotype( jtype ) )
757 $ GO TO 300
758 nmats = nmats + 1
759 ntest = 0
760
761 DO 30 j = 1, 4
762 ioldsd( j ) = iseed( j )
763 30 CONTINUE
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781 IF( mtypes.GT.maxtyp )
782 $ GO TO 100
783
784 itype = ktype( jtype )
785 imode = kmode( jtype )
786
787
788
789 GO TO ( 40, 50, 60 )kmagn( jtype )
790
791 40 CONTINUE
792 anorm = one
793 GO TO 70
794
795 50 CONTINUE
796 anorm = ( rtovfl*ulp )*aninv
797 GO TO 70
798
799 60 CONTINUE
800 anorm = rtunfl*n*ulpinv
801 GO TO 70
802
803 70 CONTINUE
804
805 CALL slaset(
'Full', lda, n, zero, zero, a, lda )
806 iinfo = 0
807 IF( jtype.LE.15 ) THEN
808 cond = ulpinv
809 ELSE
810 cond = ulpinv*aninv / ten
811 END IF
812
813
814
815
816
817 IF( itype.EQ.1 ) THEN
818 iinfo = 0
819
820 ELSE IF( itype.EQ.2 ) THEN
821
822
823
824 DO 80 jc = 1, n
825 a( jc, jc ) = anorm
826 80 CONTINUE
827
828 ELSE IF( itype.EQ.4 ) THEN
829
830
831
832 CALL slatms( n, n,
'S', iseed,
'S', work, imode, cond,
833 $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
834 $ iinfo )
835
836
837 ELSE IF( itype.EQ.5 ) THEN
838
839
840
841 CALL slatms( n, n,
'S', iseed,
'S', work, imode, cond,
842 $ anorm, n, n, 'N', a, lda, work( n+1 ),
843 $ iinfo )
844
845 ELSE IF( itype.EQ.7 ) THEN
846
847
848
849 CALL slatmr( n, n,
'S', iseed,
'S', work, 6, one, one,
850 $ 'T', 'N', work( n+1 ), 1, one,
851 $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
852 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
853
854 ELSE IF( itype.EQ.8 ) THEN
855
856
857
858 CALL slatmr( n, n,
'S', iseed,
'S', work, 6, one, one,
859 $ 'T', 'N', work( n+1 ), 1, one,
860 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
861 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
862
863 ELSE IF( itype.EQ.9 ) THEN
864
865
866
867 CALL slatms( n, n,
'S', iseed,
'P', work, imode, cond,
868 $ anorm, n, n, 'N', a, lda, work( n+1 ),
869 $ iinfo )
870
871 ELSE IF( itype.EQ.10 ) THEN
872
873
874
875 CALL slatms( n, n,
'S', iseed,
'P', work, imode, cond,
876 $ anorm, 1, 1, 'N', a, lda, work( n+1 ),
877 $ iinfo )
878 DO 90 i = 2, n
879 temp1 = abs( a( i-1, i ) ) /
880 $ sqrt( abs( a( i-1, i-1 )*a( i, i ) ) )
881 IF( temp1.GT.half ) THEN
882 a( i-1, i ) = half*sqrt( abs( a( i-1, i-1 )*a( i,
883 $ i ) ) )
884 a( i, i-1 ) = a( i-1, i )
885 END IF
886 90 CONTINUE
887
888 ELSE
889
890 iinfo = 1
891 END IF
892
893 IF( iinfo.NE.0 ) THEN
894 WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
895 $ ioldsd
896 info = abs( iinfo )
897 RETURN
898 END IF
899
900 100 CONTINUE
901
902
903
904
905 CALL slacpy(
'U', n, n, a, lda, v, ldu )
906
907 ntest = 1
908 CALL ssytrd(
'U', n, v, ldu, sd, se, tau, work, lwork,
909 $ iinfo )
910
911 IF( iinfo.NE.0 ) THEN
912 WRITE( nounit, fmt = 9999 )'SSYTRD(U)', iinfo, n, jtype,
913 $ ioldsd
914 info = abs( iinfo )
915 IF( iinfo.LT.0 ) THEN
916 RETURN
917 ELSE
918 result( 1 ) = ulpinv
919 GO TO 280
920 END IF
921 END IF
922
923 CALL slacpy(
'U', n, n, v, ldu, u, ldu )
924
925 ntest = 2
926 CALL sorgtr(
'U', n, u, ldu, tau, work, lwork, iinfo )
927 IF( iinfo.NE.0 ) THEN
928 WRITE( nounit, fmt = 9999 )'SORGTR(U)', iinfo, n, jtype,
929 $ ioldsd
930 info = abs( iinfo )
931 IF( iinfo.LT.0 ) THEN
932 RETURN
933 ELSE
934 result( 2 ) = ulpinv
935 GO TO 280
936 END IF
937 END IF
938
939
940
941 CALL ssyt21( 2,
'Upper', n, 1, a, lda, sd, se, u, ldu, v,
942 $ ldu, tau, work, result( 1 ) )
943 CALL ssyt21( 3,
'Upper', n, 1, a, lda, sd, se, u, ldu, v,
944 $ ldu, tau, work, result( 2 ) )
945
946
947
948
949 CALL slacpy(
'L', n, n, a, lda, v, ldu )
950
951 ntest = 3
952 CALL ssytrd(
'L', n, v, ldu, sd, se, tau, work, lwork,
953 $ iinfo )
954
955 IF( iinfo.NE.0 ) THEN
956 WRITE( nounit, fmt = 9999 )'SSYTRD(L)', iinfo, n, jtype,
957 $ ioldsd
958 info = abs( iinfo )
959 IF( iinfo.LT.0 ) THEN
960 RETURN
961 ELSE
962 result( 3 ) = ulpinv
963 GO TO 280
964 END IF
965 END IF
966
967 CALL slacpy(
'L', n, n, v, ldu, u, ldu )
968
969 ntest = 4
970 CALL sorgtr(
'L', n, u, ldu, tau, work, lwork, iinfo )
971 IF( iinfo.NE.0 ) THEN
972 WRITE( nounit, fmt = 9999 )'SORGTR(L)', iinfo, n, jtype,
973 $ ioldsd
974 info = abs( iinfo )
975 IF( iinfo.LT.0 ) THEN
976 RETURN
977 ELSE
978 result( 4 ) = ulpinv
979 GO TO 280
980 END IF
981 END IF
982
983 CALL ssyt21( 2,
'Lower', n, 1, a, lda, sd, se, u, ldu, v,
984 $ ldu, tau, work, result( 3 ) )
985 CALL ssyt21( 3,
'Lower', n, 1, a, lda, sd, se, u, ldu, v,
986 $ ldu, tau, work, result( 4 ) )
987
988
989
990 i = 0
991 DO 120 jc = 1, n
992 DO 110 jr = 1, jc
993 i = i + 1
994 ap( i ) = a( jr, jc )
995 110 CONTINUE
996 120 CONTINUE
997
998
999
1000 CALL scopy( nap, ap, 1, vp, 1 )
1001
1002 ntest = 5
1003 CALL ssptrd(
'U', n, vp, sd, se, tau, iinfo )
1004
1005 IF( iinfo.NE.0 ) THEN
1006 WRITE( nounit, fmt = 9999 )'SSPTRD(U)', iinfo, n, jtype,
1007 $ ioldsd
1008 info = abs( iinfo )
1009 IF( iinfo.LT.0 ) THEN
1010 RETURN
1011 ELSE
1012 result( 5 ) = ulpinv
1013 GO TO 280
1014 END IF
1015 END IF
1016
1017 ntest = 6
1018 CALL sopgtr(
'U', n, vp, tau, u, ldu, work, iinfo )
1019 IF( iinfo.NE.0 ) THEN
1020 WRITE( nounit, fmt = 9999 )'SOPGTR(U)', iinfo, n, jtype,
1021 $ ioldsd
1022 info = abs( iinfo )
1023 IF( iinfo.LT.0 ) THEN
1024 RETURN
1025 ELSE
1026 result( 6 ) = ulpinv
1027 GO TO 280
1028 END IF
1029 END IF
1030
1031
1032
1033 CALL sspt21( 2,
'Upper', n, 1, ap, sd, se, u, ldu, vp, tau,
1034 $ work, result( 5 ) )
1035 CALL sspt21( 3,
'Upper', n, 1, ap, sd, se, u, ldu, vp, tau,
1036 $ work, result( 6 ) )
1037
1038
1039
1040 i = 0
1041 DO 140 jc = 1, n
1042 DO 130 jr = jc, n
1043 i = i + 1
1044 ap( i ) = a( jr, jc )
1045 130 CONTINUE
1046 140 CONTINUE
1047
1048
1049
1050 CALL scopy( nap, ap, 1, vp, 1 )
1051
1052 ntest = 7
1053 CALL ssptrd(
'L', n, vp, sd, se, tau, iinfo )
1054
1055 IF( iinfo.NE.0 ) THEN
1056 WRITE( nounit, fmt = 9999 )'SSPTRD(L)', iinfo, n, jtype,
1057 $ ioldsd
1058 info = abs( iinfo )
1059 IF( iinfo.LT.0 ) THEN
1060 RETURN
1061 ELSE
1062 result( 7 ) = ulpinv
1063 GO TO 280
1064 END IF
1065 END IF
1066
1067 ntest = 8
1068 CALL sopgtr(
'L', n, vp, tau, u, ldu, work, iinfo )
1069 IF( iinfo.NE.0 ) THEN
1070 WRITE( nounit, fmt = 9999 )'SOPGTR(L)', iinfo, n, jtype,
1071 $ ioldsd
1072 info = abs( iinfo )
1073 IF( iinfo.LT.0 ) THEN
1074 RETURN
1075 ELSE
1076 result( 8 ) = ulpinv
1077 GO TO 280
1078 END IF
1079 END IF
1080
1081 CALL sspt21( 2,
'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1082 $ work, result( 7 ) )
1083 CALL sspt21( 3,
'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1084 $ work, result( 8 ) )
1085
1086
1087
1088
1089
1090 CALL scopy( n, sd, 1, d1, 1 )
1091 IF( n.GT.0 )
1092 $
CALL scopy( n-1, se, 1, work, 1 )
1093 CALL slaset(
'Full', n, n, zero, one, z, ldu )
1094
1095 ntest = 9
1096 CALL ssteqr(
'V', n, d1, work, z, ldu, work( n+1 ), iinfo )
1097 IF( iinfo.NE.0 ) THEN
1098 WRITE( nounit, fmt = 9999 )'SSTEQR(V)', iinfo, n, jtype,
1099 $ ioldsd
1100 info = abs( iinfo )
1101 IF( iinfo.LT.0 ) THEN
1102 RETURN
1103 ELSE
1104 result( 9 ) = ulpinv
1105 GO TO 280
1106 END IF
1107 END IF
1108
1109
1110
1111 CALL scopy( n, sd, 1, d2, 1 )
1112 IF( n.GT.0 )
1113 $
CALL scopy( n-1, se, 1, work, 1 )
1114
1115 ntest = 11
1116 CALL ssteqr(
'N', n, d2, work, work( n+1 ), ldu,
1117 $ work( n+1 ), iinfo )
1118 IF( iinfo.NE.0 ) THEN
1119 WRITE( nounit, fmt = 9999 )'SSTEQR(N)', iinfo, n, jtype,
1120 $ ioldsd
1121 info = abs( iinfo )
1122 IF( iinfo.LT.0 ) THEN
1123 RETURN
1124 ELSE
1125 result( 11 ) = ulpinv
1126 GO TO 280
1127 END IF
1128 END IF
1129
1130
1131
1132 CALL scopy( n, sd, 1, d3, 1 )
1133 IF( n.GT.0 )
1134 $
CALL scopy( n-1, se, 1, work, 1 )
1135
1136 ntest = 12
1137 CALL ssterf( n, d3, work, iinfo )
1138 IF( iinfo.NE.0 ) THEN
1139 WRITE( nounit, fmt = 9999 )'SSTERF', iinfo, n, jtype,
1140 $ ioldsd
1141 info = abs( iinfo )
1142 IF( iinfo.LT.0 ) THEN
1143 RETURN
1144 ELSE
1145 result( 12 ) = ulpinv
1146 GO TO 280
1147 END IF
1148 END IF
1149
1150
1151
1152 CALL sstt21( n, 0, sd, se, d1, dumma, z, ldu, work,
1153 $ result( 9 ) )
1154
1155
1156
1157 temp1 = zero
1158 temp2 = zero
1159 temp3 = zero
1160 temp4 = zero
1161
1162 DO 150 j = 1, n
1163 temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1164 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1165 temp3 = max( temp3, abs( d1( j ) ), abs( d3( j ) ) )
1166 temp4 = max( temp4, abs( d1( j )-d3( j ) ) )
1167 150 CONTINUE
1168
1169 result( 11 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1170 result( 12 ) = temp4 / max( unfl, ulp*max( temp3, temp4 ) )
1171
1172
1173
1174
1175 ntest = 13
1176 temp1 = thresh*( half-ulp )
1177
1178 DO 160 j = 0, log2ui
1179 CALL sstech( n, sd, se, d1, temp1, work, iinfo )
1180 IF( iinfo.EQ.0 )
1181 $ GO TO 170
1182 temp1 = temp1*two
1183 160 CONTINUE
1184
1185 170 CONTINUE
1186 result( 13 ) = temp1
1187
1188
1189
1190
1191 IF( jtype.GT.15 ) THEN
1192
1193
1194
1195 CALL scopy( n, sd, 1, d4, 1 )
1196 IF( n.GT.0 )
1197 $
CALL scopy( n-1, se, 1, work, 1 )
1198 CALL slaset(
'Full', n, n, zero, one, z, ldu )
1199
1200 ntest = 14
1201 CALL spteqr(
'V', n, d4, work, z, ldu, work( n+1 ),
1202 $ iinfo )
1203 IF( iinfo.NE.0 ) THEN
1204 WRITE( nounit, fmt = 9999 )'SPTEQR(V)', iinfo, n,
1205 $ jtype, ioldsd
1206 info = abs( iinfo )
1207 IF( iinfo.LT.0 ) THEN
1208 RETURN
1209 ELSE
1210 result( 14 ) = ulpinv
1211 GO TO 280
1212 END IF
1213 END IF
1214
1215
1216
1217 CALL sstt21( n, 0, sd, se, d4, dumma, z, ldu, work,
1218 $ result( 14 ) )
1219
1220
1221
1222 CALL scopy( n, sd, 1, d5, 1 )
1223 IF( n.GT.0 )
1224 $
CALL scopy( n-1, se, 1, work, 1 )
1225
1226 ntest = 16
1227 CALL spteqr(
'N', n, d5, work, z, ldu, work( n+1 ),
1228 $ iinfo )
1229 IF( iinfo.NE.0 ) THEN
1230 WRITE( nounit, fmt = 9999 )'SPTEQR(N)', iinfo, n,
1231 $ jtype, ioldsd
1232 info = abs( iinfo )
1233 IF( iinfo.LT.0 ) THEN
1234 RETURN
1235 ELSE
1236 result( 16 ) = ulpinv
1237 GO TO 280
1238 END IF
1239 END IF
1240
1241
1242
1243 temp1 = zero
1244 temp2 = zero
1245 DO 180 j = 1, n
1246 temp1 = max( temp1, abs( d4( j ) ), abs( d5( j ) ) )
1247 temp2 = max( temp2, abs( d4( j )-d5( j ) ) )
1248 180 CONTINUE
1249
1250 result( 16 ) = temp2 / max( unfl,
1251 $ hun*ulp*max( temp1, temp2 ) )
1252 ELSE
1253 result( 14 ) = zero
1254 result( 15 ) = zero
1255 result( 16 ) = zero
1256 END IF
1257
1258
1259
1260
1261
1262
1263 vl = zero
1264 vu = zero
1265 il = 0
1266 iu = 0
1267 IF( jtype.EQ.21 ) THEN
1268 ntest = 17
1269 abstol = unfl + unfl
1270 CALL sstebz(
'A',
'E', n, vl, vu, il, iu, abstol, sd, se,
1271 $ m, nsplit, wr, iwork( 1 ), iwork( n+1 ),
1272 $ work, iwork( 2*n+1 ), iinfo )
1273 IF( iinfo.NE.0 ) THEN
1274 WRITE( nounit, fmt = 9999 )'SSTEBZ(A,rel)', iinfo, n,
1275 $ jtype, ioldsd
1276 info = abs( iinfo )
1277 IF( iinfo.LT.0 ) THEN
1278 RETURN
1279 ELSE
1280 result( 17 ) = ulpinv
1281 GO TO 280
1282 END IF
1283 END IF
1284
1285
1286
1287 temp2 = two*( two*n-one )*ulp*( one+eight*half**2 ) /
1288 $ ( one-half )**4
1289
1290 temp1 = zero
1291 DO 190 j = 1, n
1292 temp1 = max( temp1, abs( d4( j )-wr( n-j+1 ) ) /
1293 $ ( abstol+abs( d4( j ) ) ) )
1294 190 CONTINUE
1295
1296 result( 17 ) = temp1 / temp2
1297 ELSE
1298 result( 17 ) = zero
1299 END IF
1300
1301
1302
1303 ntest = 18
1304 abstol = unfl + unfl
1305 CALL sstebz(
'A',
'E', n, vl, vu, il, iu, abstol, sd, se, m,
1306 $ nsplit, wa1, iwork( 1 ), iwork( n+1 ), work,
1307 $ iwork( 2*n+1 ), iinfo )
1308 IF( iinfo.NE.0 ) THEN
1309 WRITE( nounit, fmt = 9999 )'SSTEBZ(A)', iinfo, n, jtype,
1310 $ ioldsd
1311 info = abs( iinfo )
1312 IF( iinfo.LT.0 ) THEN
1313 RETURN
1314 ELSE
1315 result( 18 ) = ulpinv
1316 GO TO 280
1317 END IF
1318 END IF
1319
1320
1321
1322 temp1 = zero
1323 temp2 = zero
1324 DO 200 j = 1, n
1325 temp1 = max( temp1, abs( d3( j ) ), abs( wa1( j ) ) )
1326 temp2 = max( temp2, abs( d3( j )-wa1( j ) ) )
1327 200 CONTINUE
1328
1329 result( 18 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1330
1331
1332
1333
1334 ntest = 19
1335 IF( n.LE.1 ) THEN
1336 il = 1
1337 iu = n
1338 ELSE
1339 il = 1 + ( n-1 )*int(
slarnd( 1, iseed2 ) )
1340 iu = 1 + ( n-1 )*int(
slarnd( 1, iseed2 ) )
1341 IF( iu.LT.il ) THEN
1342 itemp = iu
1343 iu = il
1344 il = itemp
1345 END IF
1346 END IF
1347
1348 CALL sstebz(
'I',
'E', n, vl, vu, il, iu, abstol, sd, se,
1349 $ m2, nsplit, wa2, iwork( 1 ), iwork( n+1 ),
1350 $ work, iwork( 2*n+1 ), iinfo )
1351 IF( iinfo.NE.0 ) THEN
1352 WRITE( nounit, fmt = 9999 )'SSTEBZ(I)', iinfo, n, jtype,
1353 $ ioldsd
1354 info = abs( iinfo )
1355 IF( iinfo.LT.0 ) THEN
1356 RETURN
1357 ELSE
1358 result( 19 ) = ulpinv
1359 GO TO 280
1360 END IF
1361 END IF
1362
1363
1364
1365
1366 IF( n.GT.0 ) THEN
1367 IF( il.NE.1 ) THEN
1368 vl = wa1( il ) - max( half*( wa1( il )-wa1( il-1 ) ),
1369 $ ulp*anorm, two*rtunfl )
1370 ELSE
1371 vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
1372 $ ulp*anorm, two*rtunfl )
1373 END IF
1374 IF( iu.NE.n ) THEN
1375 vu = wa1( iu ) + max( half*( wa1( iu+1 )-wa1( iu ) ),
1376 $ ulp*anorm, two*rtunfl )
1377 ELSE
1378 vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
1379 $ ulp*anorm, two*rtunfl )
1380 END IF
1381 ELSE
1382 vl = zero
1383 vu = one
1384 END IF
1385
1386 CALL sstebz(
'V',
'E', n, vl, vu, il, iu, abstol, sd, se,
1387 $ m3, nsplit, wa3, iwork( 1 ), iwork( n+1 ),
1388 $ work, iwork( 2*n+1 ), iinfo )
1389 IF( iinfo.NE.0 ) THEN
1390 WRITE( nounit, fmt = 9999 )'SSTEBZ(V)', iinfo, n, jtype,
1391 $ ioldsd
1392 info = abs( iinfo )
1393 IF( iinfo.LT.0 ) THEN
1394 RETURN
1395 ELSE
1396 result( 19 ) = ulpinv
1397 GO TO 280
1398 END IF
1399 END IF
1400
1401 IF( m3.EQ.0 .AND. n.NE.0 ) THEN
1402 result( 19 ) = ulpinv
1403 GO TO 280
1404 END IF
1405
1406
1407
1408 temp1 =
ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1409 temp2 =
ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1410 IF( n.GT.0 ) THEN
1411 temp3 = max( abs( wa1( n ) ), abs( wa1( 1 ) ) )
1412 ELSE
1413 temp3 = zero
1414 END IF
1415
1416 result( 19 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1417
1418
1419
1420
1421
1422 ntest = 21
1423 CALL sstebz(
'A',
'B', n, vl, vu, il, iu, abstol, sd, se, m,
1424 $ nsplit, wa1, iwork( 1 ), iwork( n+1 ), work,
1425 $ iwork( 2*n+1 ), iinfo )
1426 IF( iinfo.NE.0 ) THEN
1427 WRITE( nounit, fmt = 9999 )'SSTEBZ(A,B)', iinfo, n,
1428 $ jtype, ioldsd
1429 info = abs( iinfo )
1430 IF( iinfo.LT.0 ) THEN
1431 RETURN
1432 ELSE
1433 result( 20 ) = ulpinv
1434 result( 21 ) = ulpinv
1435 GO TO 280
1436 END IF
1437 END IF
1438
1439 CALL sstein( n, sd, se, m, wa1, iwork( 1 ), iwork( n+1 ), z,
1440 $ ldu, work, iwork( 2*n+1 ), iwork( 3*n+1 ),
1441 $ iinfo )
1442 IF( iinfo.NE.0 ) THEN
1443 WRITE( nounit, fmt = 9999 )'SSTEIN', iinfo, n, jtype,
1444 $ ioldsd
1445 info = abs( iinfo )
1446 IF( iinfo.LT.0 ) THEN
1447 RETURN
1448 ELSE
1449 result( 20 ) = ulpinv
1450 result( 21 ) = ulpinv
1451 GO TO 280
1452 END IF
1453 END IF
1454
1455
1456
1457 CALL sstt21( n, 0, sd, se, wa1, dumma, z, ldu, work,
1458 $ result( 20 ) )
1459
1460
1461
1462
1463
1464 CALL scopy( n, sd, 1, d1, 1 )
1465 IF( n.GT.0 )
1466 $
CALL scopy( n-1, se, 1, work, 1 )
1467 CALL slaset(
'Full', n, n, zero, one, z, ldu )
1468
1469 ntest = 22
1470 CALL sstedc(
'I', n, d1, work, z, ldu, work( n+1 ), lwedc-n,
1471 $ iwork, liwedc, iinfo )
1472 IF( iinfo.NE.0 ) THEN
1473 WRITE( nounit, fmt = 9999 )'SSTEDC(I)', iinfo, n, jtype,
1474 $ ioldsd
1475 info = abs( iinfo )
1476 IF( iinfo.LT.0 ) THEN
1477 RETURN
1478 ELSE
1479 result( 22 ) = ulpinv
1480 GO TO 280
1481 END IF
1482 END IF
1483
1484
1485
1486 CALL sstt21( n, 0, sd, se, d1, dumma, z, ldu, work,
1487 $ result( 22 ) )
1488
1489
1490
1491
1492
1493 CALL scopy( n, sd, 1, d1, 1 )
1494 IF( n.GT.0 )
1495 $
CALL scopy( n-1, se, 1, work, 1 )
1496 CALL slaset(
'Full', n, n, zero, one, z, ldu )
1497
1498 ntest = 24
1499 CALL sstedc(
'V', n, d1, work, z, ldu, work( n+1 ), lwedc-n,
1500 $ iwork, liwedc, iinfo )
1501 IF( iinfo.NE.0 ) THEN
1502 WRITE( nounit, fmt = 9999 )'SSTEDC(V)', iinfo, n, jtype,
1503 $ ioldsd
1504 info = abs( iinfo )
1505 IF( iinfo.LT.0 ) THEN
1506 RETURN
1507 ELSE
1508 result( 24 ) = ulpinv
1509 GO TO 280
1510 END IF
1511 END IF
1512
1513
1514
1515 CALL sstt21( n, 0, sd, se, d1, dumma, z, ldu, work,
1516 $ result( 24 ) )
1517
1518
1519
1520
1521
1522 CALL scopy( n, sd, 1, d2, 1 )
1523 IF( n.GT.0 )
1524 $
CALL scopy( n-1, se, 1, work, 1 )
1525 CALL slaset(
'Full', n, n, zero, one, z, ldu )
1526
1527 ntest = 26
1528 CALL sstedc(
'N', n, d2, work, z, ldu, work( n+1 ), lwedc-n,
1529 $ iwork, liwedc, iinfo )
1530 IF( iinfo.NE.0 ) THEN
1531 WRITE( nounit, fmt = 9999 )'SSTEDC(N)', iinfo, n, jtype,
1532 $ ioldsd
1533 info = abs( iinfo )
1534 IF( iinfo.LT.0 ) THEN
1535 RETURN
1536 ELSE
1537 result( 26 ) = ulpinv
1538 GO TO 280
1539 END IF
1540 END IF
1541
1542
1543
1544 temp1 = zero
1545 temp2 = zero
1546
1547 DO 210 j = 1, n
1548 temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1549 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1550 210 CONTINUE
1551
1552 result( 26 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1553
1554
1555
1556 IF(
ilaenv( 10,
'SSTEMR',
'VA', 1, 0, 0, 0 ).EQ.1 .AND.
1557 $
ilaenv( 11,
'SSTEMR',
'VA', 1, 0, 0, 0 ).EQ.1 )
THEN
1558
1559
1560
1561
1562
1563
1564 vl = zero
1565 vu = zero
1566 il = 0
1567 iu = 0
1568 IF( jtype.EQ.21 .AND. srel ) THEN
1569 ntest = 27
1570 abstol = unfl + unfl
1571 CALL sstemr(
'V',
'A', n, sd, se, vl, vu, il, iu,
1572 $ m, wr, z, ldu, n, iwork( 1 ), tryrac,
1573 $ work, lwork, iwork( 2*n+1 ), lwork-2*n,
1574 $ iinfo )
1575 IF( iinfo.NE.0 ) THEN
1576 WRITE( nounit, fmt = 9999 )'SSTEMR(V,A,rel)',
1577 $ iinfo, n, jtype, ioldsd
1578 info = abs( iinfo )
1579 IF( iinfo.LT.0 ) THEN
1580 RETURN
1581 ELSE
1582 result( 27 ) = ulpinv
1583 GO TO 270
1584 END IF
1585 END IF
1586
1587
1588
1589 temp2 = two*( two*n-one )*ulp*( one+eight*half**2 ) /
1590 $ ( one-half )**4
1591
1592 temp1 = zero
1593 DO 220 j = 1, n
1594 temp1 = max( temp1, abs( d4( j )-wr( n-j+1 ) ) /
1595 $ ( abstol+abs( d4( j ) ) ) )
1596 220 CONTINUE
1597
1598 result( 27 ) = temp1 / temp2
1599
1600 il = 1 + ( n-1 )*int(
slarnd( 1, iseed2 ) )
1601 iu = 1 + ( n-1 )*int(
slarnd( 1, iseed2 ) )
1602 IF( iu.LT.il ) THEN
1603 itemp = iu
1604 iu = il
1605 il = itemp
1606 END IF
1607
1608 IF( srange ) THEN
1609 ntest = 28
1610 abstol = unfl + unfl
1611 CALL sstemr(
'V',
'I', n, sd, se, vl, vu, il, iu,
1612 $ m, wr, z, ldu, n, iwork( 1 ), tryrac,
1613 $ work, lwork, iwork( 2*n+1 ),
1614 $ lwork-2*n, iinfo )
1615
1616 IF( iinfo.NE.0 ) THEN
1617 WRITE( nounit, fmt = 9999 )'SSTEMR(V,I,rel)',
1618 $ iinfo, n, jtype, ioldsd
1619 info = abs( iinfo )
1620 IF( iinfo.LT.0 ) THEN
1621 RETURN
1622 ELSE
1623 result( 28 ) = ulpinv
1624 GO TO 270
1625 END IF
1626 END IF
1627
1628
1629
1630
1631 temp2 = two*( two*n-one )*ulp*
1632 $ ( one+eight*half**2 ) / ( one-half )**4
1633
1634 temp1 = zero
1635 DO 230 j = il, iu
1636 temp1 = max( temp1, abs( wr( j-il+1 )-d4( n-j+
1637 $ 1 ) ) / ( abstol+abs( wr( j-il+1 ) ) ) )
1638 230 CONTINUE
1639
1640 result( 28 ) = temp1 / temp2
1641 ELSE
1642 result( 28 ) = zero
1643 END IF
1644 ELSE
1645 result( 27 ) = zero
1646 result( 28 ) = zero
1647 END IF
1648
1649
1650
1651
1652
1653 CALL scopy( n, sd, 1, d5, 1 )
1654 IF( n.GT.0 )
1655 $
CALL scopy( n-1, se, 1, work, 1 )
1656 CALL slaset(
'Full', n, n, zero, one, z, ldu )
1657
1658 IF( srange ) THEN
1659 ntest = 29
1660 il = 1 + ( n-1 )*int(
slarnd( 1, iseed2 ) )
1661 iu = 1 + ( n-1 )*int(
slarnd( 1, iseed2 ) )
1662 IF( iu.LT.il ) THEN
1663 itemp = iu
1664 iu = il
1665 il = itemp
1666 END IF
1667 CALL sstemr(
'V',
'I', n, d5, work, vl, vu, il, iu,
1668 $ m, d1, z, ldu, n, iwork( 1 ), tryrac,
1669 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1670 $ liwork-2*n, iinfo )
1671 IF( iinfo.NE.0 ) THEN
1672 WRITE( nounit, fmt = 9999 )'SSTEMR(V,I)', iinfo,
1673 $ n, jtype, ioldsd
1674 info = abs( iinfo )
1675 IF( iinfo.LT.0 ) THEN
1676 RETURN
1677 ELSE
1678 result( 29 ) = ulpinv
1679 GO TO 280
1680 END IF
1681 END IF
1682
1683
1684
1685 CALL sstt22( n, m, 0, sd, se, d1, dumma, z, ldu, work,
1686 $ m, result( 29 ) )
1687
1688
1689
1690
1691
1692 CALL scopy( n, sd, 1, d5, 1 )
1693 IF( n.GT.0 )
1694 $
CALL scopy( n-1, se, 1, work, 1 )
1695
1696 ntest = 31
1697 CALL sstemr(
'N',
'I', n, d5, work, vl, vu, il, iu,
1698 $ m, d2, z, ldu, n, iwork( 1 ), tryrac,
1699 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1700 $ liwork-2*n, iinfo )
1701 IF( iinfo.NE.0 ) THEN
1702 WRITE( nounit, fmt = 9999 )'SSTEMR(N,I)', iinfo,
1703 $ n, jtype, ioldsd
1704 info = abs( iinfo )
1705 IF( iinfo.LT.0 ) THEN
1706 RETURN
1707 ELSE
1708 result( 31 ) = ulpinv
1709 GO TO 280
1710 END IF
1711 END IF
1712
1713
1714
1715 temp1 = zero
1716 temp2 = zero
1717
1718 DO 240 j = 1, iu - il + 1
1719 temp1 = max( temp1, abs( d1( j ) ),
1720 $ abs( d2( j ) ) )
1721 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1722 240 CONTINUE
1723
1724 result( 31 ) = temp2 / max( unfl,
1725 $ ulp*max( temp1, temp2 ) )
1726
1727
1728
1729
1730
1731
1732 CALL scopy( n, sd, 1, d5, 1 )
1733 IF( n.GT.0 )
1734 $
CALL scopy( n-1, se, 1, work, 1 )
1735 CALL slaset(
'Full', n, n, zero, one, z, ldu )
1736
1737 ntest = 32
1738
1739 IF( n.GT.0 ) THEN
1740 IF( il.NE.1 ) THEN
1741 vl = d2( il ) - max( half*
1742 $ ( d2( il )-d2( il-1 ) ), ulp*anorm,
1743 $ two*rtunfl )
1744 ELSE
1745 vl = d2( 1 ) - max( half*( d2( n )-d2( 1 ) ),
1746 $ ulp*anorm, two*rtunfl )
1747 END IF
1748 IF( iu.NE.n ) THEN
1749 vu = d2( iu ) + max( half*
1750 $ ( d2( iu+1 )-d2( iu ) ), ulp*anorm,
1751 $ two*rtunfl )
1752 ELSE
1753 vu = d2( n ) + max( half*( d2( n )-d2( 1 ) ),
1754 $ ulp*anorm, two*rtunfl )
1755 END IF
1756 ELSE
1757 vl = zero
1758 vu = one
1759 END IF
1760
1761 CALL sstemr(
'V',
'V', n, d5, work, vl, vu, il, iu,
1762 $ m, d1, z, ldu, n, iwork( 1 ), tryrac,
1763 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1764 $ liwork-2*n, iinfo )
1765 IF( iinfo.NE.0 ) THEN
1766 WRITE( nounit, fmt = 9999 )'SSTEMR(V,V)', iinfo,
1767 $ n, jtype, ioldsd
1768 info = abs( iinfo )
1769 IF( iinfo.LT.0 ) THEN
1770 RETURN
1771 ELSE
1772 result( 32 ) = ulpinv
1773 GO TO 280
1774 END IF
1775 END IF
1776
1777
1778
1779 CALL sstt22( n, m, 0, sd, se, d1, dumma, z, ldu, work,
1780 $ m, result( 32 ) )
1781
1782
1783
1784
1785
1786 CALL scopy( n, sd, 1, d5, 1 )
1787 IF( n.GT.0 )
1788 $
CALL scopy( n-1, se, 1, work, 1 )
1789
1790 ntest = 34
1791 CALL sstemr(
'N',
'V', n, d5, work, vl, vu, il, iu,
1792 $ m, d2, z, ldu, n, iwork( 1 ), tryrac,
1793 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1794 $ liwork-2*n, iinfo )
1795 IF( iinfo.NE.0 ) THEN
1796 WRITE( nounit, fmt = 9999 )'SSTEMR(N,V)', iinfo,
1797 $ n, jtype, ioldsd
1798 info = abs( iinfo )
1799 IF( iinfo.LT.0 ) THEN
1800 RETURN
1801 ELSE
1802 result( 34 ) = ulpinv
1803 GO TO 280
1804 END IF
1805 END IF
1806
1807
1808
1809 temp1 = zero
1810 temp2 = zero
1811
1812 DO 250 j = 1, iu - il + 1
1813 temp1 = max( temp1, abs( d1( j ) ),
1814 $ abs( d2( j ) ) )
1815 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1816 250 CONTINUE
1817
1818 result( 34 ) = temp2 / max( unfl,
1819 $ ulp*max( temp1, temp2 ) )
1820 ELSE
1821 result( 29 ) = zero
1822 result( 30 ) = zero
1823 result( 31 ) = zero
1824 result( 32 ) = zero
1825 result( 33 ) = zero
1826 result( 34 ) = zero
1827 END IF
1828
1829
1830
1831
1832
1833
1834 CALL scopy( n, sd, 1, d5, 1 )
1835 IF( n.GT.0 )
1836 $
CALL scopy( n-1, se, 1, work, 1 )
1837
1838 ntest = 35
1839
1840 CALL sstemr(
'V',
'A', n, d5, work, vl, vu, il, iu,
1841 $ m, d1, z, ldu, n, iwork( 1 ), tryrac,
1842 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1843 $ liwork-2*n, iinfo )
1844 IF( iinfo.NE.0 ) THEN
1845 WRITE( nounit, fmt = 9999 )'SSTEMR(V,A)', iinfo, n,
1846 $ jtype, ioldsd
1847 info = abs( iinfo )
1848 IF( iinfo.LT.0 ) THEN
1849 RETURN
1850 ELSE
1851 result( 35 ) = ulpinv
1852 GO TO 280
1853 END IF
1854 END IF
1855
1856
1857
1858 CALL sstt22( n, m, 0, sd, se, d1, dumma, z, ldu, work, m,
1859 $ result( 35 ) )
1860
1861
1862
1863
1864
1865 CALL scopy( n, sd, 1, d5, 1 )
1866 IF( n.GT.0 )
1867 $
CALL scopy( n-1, se, 1, work, 1 )
1868
1869 ntest = 37
1870 CALL sstemr(
'N',
'A', n, d5, work, vl, vu, il, iu,
1871 $ m, d2, z, ldu, n, iwork( 1 ), tryrac,
1872 $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1873 $ liwork-2*n, iinfo )
1874 IF( iinfo.NE.0 ) THEN
1875 WRITE( nounit, fmt = 9999 )'SSTEMR(N,A)', iinfo, n,
1876 $ jtype, ioldsd
1877 info = abs( iinfo )
1878 IF( iinfo.LT.0 ) THEN
1879 RETURN
1880 ELSE
1881 result( 37 ) = ulpinv
1882 GO TO 280
1883 END IF
1884 END IF
1885
1886
1887
1888 temp1 = zero
1889 temp2 = zero
1890
1891 DO 260 j = 1, n
1892 temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1893 temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1894 260 CONTINUE
1895
1896 result( 37 ) = temp2 / max( unfl,
1897 $ ulp*max( temp1, temp2 ) )
1898 END IF
1899 270 CONTINUE
1900 280 CONTINUE
1901 ntestt = ntestt + ntest
1902
1903
1904
1905
1906
1907
1908 DO 290 jr = 1, ntest
1909 IF( result( jr ).GE.thresh ) THEN
1910
1911
1912
1913
1914 IF( nerrs.EQ.0 ) THEN
1915 WRITE( nounit, fmt = 9998 )'SST'
1916 WRITE( nounit, fmt = 9997 )
1917 WRITE( nounit, fmt = 9996 )
1918 WRITE( nounit, fmt = 9995 )'Symmetric'
1919 WRITE( nounit, fmt = 9994 )
1920
1921
1922
1923 WRITE( nounit, fmt = 9988 )
1924 END IF
1925 nerrs = nerrs + 1
1926 WRITE( nounit, fmt = 9990 )n, ioldsd, jtype, jr,
1927 $ result( jr )
1928 END IF
1929 290 CONTINUE
1930 300 CONTINUE
1931 310 CONTINUE
1932
1933
1934
1935 CALL slasum(
'SST', nounit, nerrs, ntestt )
1936 RETURN
1937
1938 9999 FORMAT( ' SCHKST: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
1939 $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1940
1941 9998 FORMAT( / 1x, a3, ' -- Real Symmetric eigenvalue problem' )
1942 9997 FORMAT( ' Matrix types (see SCHKST for details): ' )
1943
1944 9996 FORMAT( / ' Special Matrices:',
1945 $ / ' 1=Zero matrix. ',
1946 $ ' 5=Diagonal: clustered entries.',
1947 $ / ' 2=Identity matrix. ',
1948 $ ' 6=Diagonal: large, evenly spaced.',
1949 $ / ' 3=Diagonal: evenly spaced entries. ',
1950 $ ' 7=Diagonal: small, evenly spaced.',
1951 $ / ' 4=Diagonal: geometr. spaced entries.' )
1952 9995 FORMAT( ' Dense ', a, ' Matrices:',
1953 $ / ' 8=Evenly spaced eigenvals. ',
1954 $ ' 12=Small, evenly spaced eigenvals.',
1955 $ / ' 9=Geometrically spaced eigenvals. ',
1956 $ ' 13=Matrix with random O(1) entries.',
1957 $ / ' 10=Clustered eigenvalues. ',
1958 $ ' 14=Matrix with large random entries.',
1959 $ / ' 11=Large, evenly spaced eigenvals. ',
1960 $ ' 15=Matrix with small random entries.' )
1961 9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues',
1962 $ / ' 17=Positive definite, geometrically spaced eigenvlaues',
1963 $ / ' 18=Positive definite, clustered eigenvalues',
1964 $ / ' 19=Positive definite, small evenly spaced eigenvalues',
1965 $ / ' 20=Positive definite, large evenly spaced eigenvalues',
1966 $ / ' 21=Diagonally dominant tridiagonal, geometrically',
1967 $ ' spaced eigenvalues' )
1968
1969 9990 FORMAT( ' N=', i5, ', seed=', 4( i4, ',' ), ' type ', i2,
1970 $ ', test(', i2, ')=', g10.3 )
1971
1972 9988 FORMAT( / 'Test performed: see SCHKST for details.', / )
1973
1974
subroutine xerbla(srname, info)
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
subroutine ssytrd(uplo, n, a, lda, d, e, tau, work, lwork, info)
SSYTRD
subroutine ssptrd(uplo, n, ap, d, e, tau, info)
SSPTRD
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
real function slamch(cmach)
SLAMCH
subroutine slaset(uplo, m, n, alpha, beta, a, lda)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine spteqr(compz, n, d, e, z, ldz, work, info)
SPTEQR
subroutine sstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
SSTEBZ
subroutine sstedc(compz, n, d, e, z, ldz, work, lwork, iwork, liwork, info)
SSTEDC
subroutine sstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
SSTEIN
subroutine sstemr(jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, work, lwork, iwork, liwork, info)
SSTEMR
subroutine ssteqr(compz, n, d, e, z, ldz, work, info)
SSTEQR
subroutine ssterf(n, d, e, info)
SSTERF
subroutine sorgtr(uplo, n, a, lda, tau, work, lwork, info)
SORGTR
subroutine sopgtr(uplo, n, ap, tau, q, ldq, work, info)
SOPGTR
real function slarnd(idist, iseed)
SLARND
subroutine slasum(type, iounit, ie, nrun)
SLASUM
subroutine slatmr(m, n, dist, iseed, sym, d, mode, cond, dmax, rsign, grade, dl, model, condl, dr, moder, condr, pivtng, ipivot, kl, ku, sparse, anorm, pack, a, lda, iwork, info)
SLATMR
subroutine slatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
SLATMS
subroutine sspt21(itype, uplo, n, kband, ap, d, e, u, ldu, vp, tau, work, result)
SSPT21
subroutine sstech(n, a, b, eig, tol, work, info)
SSTECH
subroutine sstt21(n, kband, ad, ae, sd, se, u, ldu, work, result)
SSTT21
subroutine sstt22(n, m, kband, ad, ae, sd, se, u, ldu, work, ldwork, result)
SSTT22
real function ssxt1(ijob, d1, n1, d2, n2, abstol, ulp, unfl)
SSXT1
subroutine ssyt21(itype, uplo, n, kband, a, lda, d, e, u, ldu, v, ldv, tau, work, result)
SSYT21