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