1 SUBROUTINE SERRSY( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * SERRSY tests the error exits for the REAL routines
16 * for symmetric indefinite matrices.
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 4 )
32 * ..
33 * .. Local Scalars ..
34 CHARACTER*2 C2
35 INTEGER I, INFO, J
36 REAL ANRM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX ), IW( NMAX )
40 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
41 $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX )
42 * ..
43 * .. External Functions ..
44 LOGICAL LSAMEN
45 EXTERNAL LSAMEN
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL ALAESM, CHKXER, SSPCON, SSPRFS, SSPTRF, SSPTRI,
49 $ SSPTRS, SSYCON, SSYRFS, SSYTF2, SSYTRF, SSYTRI,
50 $ SSYTRI2, SSYTRS
51 * ..
52 * .. Scalars in Common ..
53 LOGICAL LERR, OK
54 CHARACTER*32 SRNAMT
55 INTEGER INFOT, NOUT
56 * ..
57 * .. Common blocks ..
58 COMMON / INFOC / INFOT, NOUT, OK, LERR
59 COMMON / SRNAMC / SRNAMT
60 * ..
61 * .. Intrinsic Functions ..
62 INTRINSIC REAL
63 * ..
64 * .. Executable Statements ..
65 *
66 NOUT = NUNIT
67 WRITE( NOUT, FMT = * )
68 C2 = PATH( 2: 3 )
69 *
70 * Set the variables to innocuous values.
71 *
72 DO 20 J = 1, NMAX
73 DO 10 I = 1, NMAX
74 A( I, J ) = 1. / REAL( I+J )
75 AF( I, J ) = 1. / REAL( I+J )
76 10 CONTINUE
77 B( J ) = 0.
78 R1( J ) = 0.
79 R2( J ) = 0.
80 W( J ) = 0.
81 X( J ) = 0.
82 IP( J ) = J
83 IW( J ) = J
84 20 CONTINUE
85 ANRM = 1.0
86 RCOND = 1.0
87 OK = .TRUE.
88 *
89 IF( LSAMEN( 2, C2, 'SY' ) ) THEN
90 *
91 * Test error exits of the routines that use the Bunch-Kaufman
92 * factorization of a symmetric indefinite matrix.
93 *
94 * SSYTRF
95 *
96 SRNAMT = 'SSYTRF'
97 INFOT = 1
98 CALL SSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
99 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
100 INFOT = 2
101 CALL SSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
102 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
103 INFOT = 4
104 CALL SSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
105 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
106 *
107 * SSYTF2
108 *
109 SRNAMT = 'SSYTF2'
110 INFOT = 1
111 CALL SSYTF2( '/', 0, A, 1, IP, INFO )
112 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
113 INFOT = 2
114 CALL SSYTF2( 'U', -1, A, 1, IP, INFO )
115 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
116 INFOT = 4
117 CALL SSYTF2( 'U', 2, A, 1, IP, INFO )
118 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
119 *
120 * SSYTRI
121 *
122 SRNAMT = 'SSYTRI'
123 INFOT = 1
124 CALL SSYTRI( '/', 0, A, 1, IP, W, INFO )
125 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
126 INFOT = 2
127 CALL SSYTRI( 'U', -1, A, 1, IP, W, INFO )
128 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
129 INFOT = 4
130 CALL SSYTRI( 'U', 2, A, 1, IP, W, INFO )
131 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
132 *
133 * SSYTRI2
134 *
135 SRNAMT = 'SSYTRI2'
136 INFOT = 1
137 CALL SSYTRI2( '/', 0, A, 1, IP, W, IW, INFO )
138 CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
139 INFOT = 2
140 CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO )
141 CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
142 INFOT = 4
143 CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
144 CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
145 *
146 * SSYTRS
147 *
148 SRNAMT = 'SSYTRS'
149 INFOT = 1
150 CALL SSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
151 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
152 INFOT = 2
153 CALL SSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
154 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
155 INFOT = 3
156 CALL SSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
157 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
158 INFOT = 5
159 CALL SSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
160 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
161 INFOT = 8
162 CALL SSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
163 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
164 *
165 * SSYRFS
166 *
167 SRNAMT = 'SSYRFS'
168 INFOT = 1
169 CALL SSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
170 $ IW, INFO )
171 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
172 INFOT = 2
173 CALL SSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
174 $ W, IW, INFO )
175 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
176 INFOT = 3
177 CALL SSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
178 $ W, IW, INFO )
179 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
180 INFOT = 5
181 CALL SSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
182 $ IW, INFO )
183 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
184 INFOT = 7
185 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
186 $ IW, INFO )
187 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
188 INFOT = 10
189 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
190 $ IW, INFO )
191 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
192 INFOT = 12
193 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
194 $ IW, INFO )
195 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
196 *
197 * SSYCON
198 *
199 SRNAMT = 'SSYCON'
200 INFOT = 1
201 CALL SSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
202 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
203 INFOT = 2
204 CALL SSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
205 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
206 INFOT = 4
207 CALL SSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
208 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
209 INFOT = 6
210 CALL SSYCON( 'U', 1, A, 1, IP, -1.0, RCOND, W, IW, INFO )
211 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
212 *
213 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
214 *
215 * Test error exits of the routines that use the Bunch-Kaufman
216 * factorization of a symmetric indefinite packed matrix.
217 *
218 * SSPTRF
219 *
220 SRNAMT = 'SSPTRF'
221 INFOT = 1
222 CALL SSPTRF( '/', 0, A, IP, INFO )
223 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
224 INFOT = 2
225 CALL SSPTRF( 'U', -1, A, IP, INFO )
226 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
227 *
228 * SSPTRI
229 *
230 SRNAMT = 'SSPTRI'
231 INFOT = 1
232 CALL SSPTRI( '/', 0, A, IP, W, INFO )
233 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
234 INFOT = 2
235 CALL SSPTRI( 'U', -1, A, IP, W, INFO )
236 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
237 *
238 * SSPTRS
239 *
240 SRNAMT = 'SSPTRS'
241 INFOT = 1
242 CALL SSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
243 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
244 INFOT = 2
245 CALL SSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
246 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
247 INFOT = 3
248 CALL SSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
249 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
250 INFOT = 7
251 CALL SSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
252 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
253 *
254 * SSPRFS
255 *
256 SRNAMT = 'SSPRFS'
257 INFOT = 1
258 CALL SSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
259 $ INFO )
260 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
261 INFOT = 2
262 CALL SSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
263 $ INFO )
264 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
265 INFOT = 3
266 CALL SSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
267 $ INFO )
268 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
269 INFOT = 8
270 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
271 $ INFO )
272 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
273 INFOT = 10
274 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
275 $ INFO )
276 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
277 *
278 * SSPCON
279 *
280 SRNAMT = 'SSPCON'
281 INFOT = 1
282 CALL SSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO )
283 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
284 INFOT = 2
285 CALL SSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO )
286 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
287 INFOT = 5
288 CALL SSPCON( 'U', 1, A, IP, -1.0, RCOND, W, IW, INFO )
289 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
290 END IF
291 *
292 * Print a summary line.
293 *
294 CALL ALAESM( PATH, OK, NOUT )
295 *
296 RETURN
297 *
298 * End of SERRSY
299 *
300 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * SERRSY tests the error exits for the REAL routines
16 * for symmetric indefinite matrices.
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 4 )
32 * ..
33 * .. Local Scalars ..
34 CHARACTER*2 C2
35 INTEGER I, INFO, J
36 REAL ANRM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX ), IW( NMAX )
40 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
41 $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX )
42 * ..
43 * .. External Functions ..
44 LOGICAL LSAMEN
45 EXTERNAL LSAMEN
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL ALAESM, CHKXER, SSPCON, SSPRFS, SSPTRF, SSPTRI,
49 $ SSPTRS, SSYCON, SSYRFS, SSYTF2, SSYTRF, SSYTRI,
50 $ SSYTRI2, SSYTRS
51 * ..
52 * .. Scalars in Common ..
53 LOGICAL LERR, OK
54 CHARACTER*32 SRNAMT
55 INTEGER INFOT, NOUT
56 * ..
57 * .. Common blocks ..
58 COMMON / INFOC / INFOT, NOUT, OK, LERR
59 COMMON / SRNAMC / SRNAMT
60 * ..
61 * .. Intrinsic Functions ..
62 INTRINSIC REAL
63 * ..
64 * .. Executable Statements ..
65 *
66 NOUT = NUNIT
67 WRITE( NOUT, FMT = * )
68 C2 = PATH( 2: 3 )
69 *
70 * Set the variables to innocuous values.
71 *
72 DO 20 J = 1, NMAX
73 DO 10 I = 1, NMAX
74 A( I, J ) = 1. / REAL( I+J )
75 AF( I, J ) = 1. / REAL( I+J )
76 10 CONTINUE
77 B( J ) = 0.
78 R1( J ) = 0.
79 R2( J ) = 0.
80 W( J ) = 0.
81 X( J ) = 0.
82 IP( J ) = J
83 IW( J ) = J
84 20 CONTINUE
85 ANRM = 1.0
86 RCOND = 1.0
87 OK = .TRUE.
88 *
89 IF( LSAMEN( 2, C2, 'SY' ) ) THEN
90 *
91 * Test error exits of the routines that use the Bunch-Kaufman
92 * factorization of a symmetric indefinite matrix.
93 *
94 * SSYTRF
95 *
96 SRNAMT = 'SSYTRF'
97 INFOT = 1
98 CALL SSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
99 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
100 INFOT = 2
101 CALL SSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
102 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
103 INFOT = 4
104 CALL SSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
105 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
106 *
107 * SSYTF2
108 *
109 SRNAMT = 'SSYTF2'
110 INFOT = 1
111 CALL SSYTF2( '/', 0, A, 1, IP, INFO )
112 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
113 INFOT = 2
114 CALL SSYTF2( 'U', -1, A, 1, IP, INFO )
115 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
116 INFOT = 4
117 CALL SSYTF2( 'U', 2, A, 1, IP, INFO )
118 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
119 *
120 * SSYTRI
121 *
122 SRNAMT = 'SSYTRI'
123 INFOT = 1
124 CALL SSYTRI( '/', 0, A, 1, IP, W, INFO )
125 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
126 INFOT = 2
127 CALL SSYTRI( 'U', -1, A, 1, IP, W, INFO )
128 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
129 INFOT = 4
130 CALL SSYTRI( 'U', 2, A, 1, IP, W, INFO )
131 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
132 *
133 * SSYTRI2
134 *
135 SRNAMT = 'SSYTRI2'
136 INFOT = 1
137 CALL SSYTRI2( '/', 0, A, 1, IP, W, IW, INFO )
138 CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
139 INFOT = 2
140 CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO )
141 CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
142 INFOT = 4
143 CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
144 CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
145 *
146 * SSYTRS
147 *
148 SRNAMT = 'SSYTRS'
149 INFOT = 1
150 CALL SSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
151 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
152 INFOT = 2
153 CALL SSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
154 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
155 INFOT = 3
156 CALL SSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
157 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
158 INFOT = 5
159 CALL SSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
160 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
161 INFOT = 8
162 CALL SSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
163 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
164 *
165 * SSYRFS
166 *
167 SRNAMT = 'SSYRFS'
168 INFOT = 1
169 CALL SSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
170 $ IW, INFO )
171 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
172 INFOT = 2
173 CALL SSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
174 $ W, IW, INFO )
175 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
176 INFOT = 3
177 CALL SSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
178 $ W, IW, INFO )
179 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
180 INFOT = 5
181 CALL SSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
182 $ IW, INFO )
183 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
184 INFOT = 7
185 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
186 $ IW, INFO )
187 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
188 INFOT = 10
189 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
190 $ IW, INFO )
191 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
192 INFOT = 12
193 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
194 $ IW, INFO )
195 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
196 *
197 * SSYCON
198 *
199 SRNAMT = 'SSYCON'
200 INFOT = 1
201 CALL SSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
202 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
203 INFOT = 2
204 CALL SSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
205 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
206 INFOT = 4
207 CALL SSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
208 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
209 INFOT = 6
210 CALL SSYCON( 'U', 1, A, 1, IP, -1.0, RCOND, W, IW, INFO )
211 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
212 *
213 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
214 *
215 * Test error exits of the routines that use the Bunch-Kaufman
216 * factorization of a symmetric indefinite packed matrix.
217 *
218 * SSPTRF
219 *
220 SRNAMT = 'SSPTRF'
221 INFOT = 1
222 CALL SSPTRF( '/', 0, A, IP, INFO )
223 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
224 INFOT = 2
225 CALL SSPTRF( 'U', -1, A, IP, INFO )
226 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
227 *
228 * SSPTRI
229 *
230 SRNAMT = 'SSPTRI'
231 INFOT = 1
232 CALL SSPTRI( '/', 0, A, IP, W, INFO )
233 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
234 INFOT = 2
235 CALL SSPTRI( 'U', -1, A, IP, W, INFO )
236 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
237 *
238 * SSPTRS
239 *
240 SRNAMT = 'SSPTRS'
241 INFOT = 1
242 CALL SSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
243 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
244 INFOT = 2
245 CALL SSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
246 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
247 INFOT = 3
248 CALL SSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
249 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
250 INFOT = 7
251 CALL SSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
252 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
253 *
254 * SSPRFS
255 *
256 SRNAMT = 'SSPRFS'
257 INFOT = 1
258 CALL SSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
259 $ INFO )
260 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
261 INFOT = 2
262 CALL SSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
263 $ INFO )
264 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
265 INFOT = 3
266 CALL SSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
267 $ INFO )
268 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
269 INFOT = 8
270 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
271 $ INFO )
272 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
273 INFOT = 10
274 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
275 $ INFO )
276 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
277 *
278 * SSPCON
279 *
280 SRNAMT = 'SSPCON'
281 INFOT = 1
282 CALL SSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO )
283 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
284 INFOT = 2
285 CALL SSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO )
286 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
287 INFOT = 5
288 CALL SSPCON( 'U', 1, A, IP, -1.0, RCOND, W, IW, INFO )
289 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
290 END IF
291 *
292 * Print a summary line.
293 *
294 CALL ALAESM( PATH, OK, NOUT )
295 *
296 RETURN
297 *
298 * End of SERRSY
299 *
300 END