LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ serrpo()

subroutine serrpo ( character*3  path,
integer  nunit 
)

SERRPO

Purpose:
 SERRPO tests the error exits for the REAL routines
 for symmetric positive definite matrices.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 54 of file serrpo.f.

55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63* ..
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER NMAX
69 parameter( nmax = 4 )
70* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER I, INFO, J
74 REAL ANRM, RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IW( NMAX )
78 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
79 $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX )
80* ..
81* .. External Functions ..
82 LOGICAL LSAMEN
83 EXTERNAL lsamen
84* ..
85* .. External Subroutines ..
86 EXTERNAL alaesm, chkxer, spbcon, spbequ, spbrfs, spbtf2,
87 $ spbtrf, spbtrs, spocon, spoequ, sporfs, spotf2,
88 $ spotrf, spotri, spotrs, sppcon, sppequ, spprfs,
89 $ spptrf, spptri, spptrs
90* ..
91* .. Scalars in Common ..
92 LOGICAL LERR, OK
93 CHARACTER*32 SRNAMT
94 INTEGER INFOT, NOUT
95* ..
96* .. Common blocks ..
97 COMMON / infoc / infot, nout, ok, lerr
98 COMMON / srnamc / srnamt
99* ..
100* .. Intrinsic Functions ..
101 INTRINSIC real
102* ..
103* .. Executable Statements ..
104*
105 nout = nunit
106 WRITE( nout, fmt = * )
107 c2 = path( 2: 3 )
108*
109* Set the variables to innocuous values.
110*
111 DO 20 j = 1, nmax
112 DO 10 i = 1, nmax
113 a( i, j ) = 1. / real( i+j )
114 af( i, j ) = 1. / real( i+j )
115 10 CONTINUE
116 b( j ) = 0.
117 r1( j ) = 0.
118 r2( j ) = 0.
119 w( j ) = 0.
120 x( j ) = 0.
121 iw( j ) = j
122 20 CONTINUE
123 ok = .true.
124*
125 IF( lsamen( 2, c2, 'PO' ) ) THEN
126*
127* Test error exits of the routines that use the Cholesky
128* decomposition of a symmetric positive definite matrix.
129*
130* SPOTRF
131*
132 srnamt = 'SPOTRF'
133 infot = 1
134 CALL spotrf( '/', 0, a, 1, info )
135 CALL chkxer( 'SPOTRF', infot, nout, lerr, ok )
136 infot = 2
137 CALL spotrf( 'U', -1, a, 1, info )
138 CALL chkxer( 'SPOTRF', infot, nout, lerr, ok )
139 infot = 4
140 CALL spotrf( 'U', 2, a, 1, info )
141 CALL chkxer( 'SPOTRF', infot, nout, lerr, ok )
142*
143* SPOTF2
144*
145 srnamt = 'SPOTF2'
146 infot = 1
147 CALL spotf2( '/', 0, a, 1, info )
148 CALL chkxer( 'SPOTF2', infot, nout, lerr, ok )
149 infot = 2
150 CALL spotf2( 'U', -1, a, 1, info )
151 CALL chkxer( 'SPOTF2', infot, nout, lerr, ok )
152 infot = 4
153 CALL spotf2( 'U', 2, a, 1, info )
154 CALL chkxer( 'SPOTF2', infot, nout, lerr, ok )
155*
156* SPOTRI
157*
158 srnamt = 'SPOTRI'
159 infot = 1
160 CALL spotri( '/', 0, a, 1, info )
161 CALL chkxer( 'SPOTRI', infot, nout, lerr, ok )
162 infot = 2
163 CALL spotri( 'U', -1, a, 1, info )
164 CALL chkxer( 'SPOTRI', infot, nout, lerr, ok )
165 infot = 4
166 CALL spotri( 'U', 2, a, 1, info )
167 CALL chkxer( 'SPOTRI', infot, nout, lerr, ok )
168*
169* SPOTRS
170*
171 srnamt = 'SPOTRS'
172 infot = 1
173 CALL spotrs( '/', 0, 0, a, 1, b, 1, info )
174 CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
175 infot = 2
176 CALL spotrs( 'U', -1, 0, a, 1, b, 1, info )
177 CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
178 infot = 3
179 CALL spotrs( 'U', 0, -1, a, 1, b, 1, info )
180 CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
181 infot = 5
182 CALL spotrs( 'U', 2, 1, a, 1, b, 2, info )
183 CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
184 infot = 7
185 CALL spotrs( 'U', 2, 1, a, 2, b, 1, info )
186 CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
187*
188* SPORFS
189*
190 srnamt = 'SPORFS'
191 infot = 1
192 CALL sporfs( '/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, iw,
193 $ info )
194 CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
195 infot = 2
196 CALL sporfs( 'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
197 $ iw, info )
198 CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
199 infot = 3
200 CALL sporfs( 'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
201 $ iw, info )
202 CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
203 infot = 5
204 CALL sporfs( 'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, iw,
205 $ info )
206 CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
207 infot = 7
208 CALL sporfs( 'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, iw,
209 $ info )
210 CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
211 infot = 9
212 CALL sporfs( 'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, iw,
213 $ info )
214 CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
215 infot = 11
216 CALL sporfs( 'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, iw,
217 $ info )
218 CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
219*
220* SPOCON
221*
222 srnamt = 'SPOCON'
223 infot = 1
224 CALL spocon( '/', 0, a, 1, anrm, rcond, w, iw, info )
225 CALL chkxer( 'SPOCON', infot, nout, lerr, ok )
226 infot = 2
227 CALL spocon( 'U', -1, a, 1, anrm, rcond, w, iw, info )
228 CALL chkxer( 'SPOCON', infot, nout, lerr, ok )
229 infot = 4
230 CALL spocon( 'U', 2, a, 1, anrm, rcond, w, iw, info )
231 CALL chkxer( 'SPOCON', infot, nout, lerr, ok )
232*
233* SPOEQU
234*
235 srnamt = 'SPOEQU'
236 infot = 1
237 CALL spoequ( -1, a, 1, r1, rcond, anrm, info )
238 CALL chkxer( 'SPOEQU', infot, nout, lerr, ok )
239 infot = 3
240 CALL spoequ( 2, a, 1, r1, rcond, anrm, info )
241 CALL chkxer( 'SPOEQU', infot, nout, lerr, ok )
242*
243 ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
244*
245* Test error exits of the routines that use the Cholesky
246* decomposition of a symmetric positive definite packed matrix.
247*
248* SPPTRF
249*
250 srnamt = 'SPPTRF'
251 infot = 1
252 CALL spptrf( '/', 0, a, info )
253 CALL chkxer( 'SPPTRF', infot, nout, lerr, ok )
254 infot = 2
255 CALL spptrf( 'U', -1, a, info )
256 CALL chkxer( 'SPPTRF', infot, nout, lerr, ok )
257*
258* SPPTRI
259*
260 srnamt = 'SPPTRI'
261 infot = 1
262 CALL spptri( '/', 0, a, info )
263 CALL chkxer( 'SPPTRI', infot, nout, lerr, ok )
264 infot = 2
265 CALL spptri( 'U', -1, a, info )
266 CALL chkxer( 'SPPTRI', infot, nout, lerr, ok )
267*
268* SPPTRS
269*
270 srnamt = 'SPPTRS'
271 infot = 1
272 CALL spptrs( '/', 0, 0, a, b, 1, info )
273 CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
274 infot = 2
275 CALL spptrs( 'U', -1, 0, a, b, 1, info )
276 CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
277 infot = 3
278 CALL spptrs( 'U', 0, -1, a, b, 1, info )
279 CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
280 infot = 6
281 CALL spptrs( 'U', 2, 1, a, b, 1, info )
282 CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
283*
284* SPPRFS
285*
286 srnamt = 'SPPRFS'
287 infot = 1
288 CALL spprfs( '/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
289 $ info )
290 CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
291 infot = 2
292 CALL spprfs( 'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
293 $ info )
294 CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
295 infot = 3
296 CALL spprfs( 'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, iw,
297 $ info )
298 CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
299 infot = 7
300 CALL spprfs( 'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, iw,
301 $ info )
302 CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
303 infot = 9
304 CALL spprfs( 'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, iw,
305 $ info )
306 CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
307*
308* SPPCON
309*
310 srnamt = 'SPPCON'
311 infot = 1
312 CALL sppcon( '/', 0, a, anrm, rcond, w, iw, info )
313 CALL chkxer( 'SPPCON', infot, nout, lerr, ok )
314 infot = 2
315 CALL sppcon( 'U', -1, a, anrm, rcond, w, iw, info )
316 CALL chkxer( 'SPPCON', infot, nout, lerr, ok )
317*
318* SPPEQU
319*
320 srnamt = 'SPPEQU'
321 infot = 1
322 CALL sppequ( '/', 0, a, r1, rcond, anrm, info )
323 CALL chkxer( 'SPPEQU', infot, nout, lerr, ok )
324 infot = 2
325 CALL sppequ( 'U', -1, a, r1, rcond, anrm, info )
326 CALL chkxer( 'SPPEQU', infot, nout, lerr, ok )
327*
328 ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
329*
330* Test error exits of the routines that use the Cholesky
331* decomposition of a symmetric positive definite band matrix.
332*
333* SPBTRF
334*
335 srnamt = 'SPBTRF'
336 infot = 1
337 CALL spbtrf( '/', 0, 0, a, 1, info )
338 CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
339 infot = 2
340 CALL spbtrf( 'U', -1, 0, a, 1, info )
341 CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
342 infot = 3
343 CALL spbtrf( 'U', 1, -1, a, 1, info )
344 CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
345 infot = 5
346 CALL spbtrf( 'U', 2, 1, a, 1, info )
347 CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
348*
349* SPBTF2
350*
351 srnamt = 'SPBTF2'
352 infot = 1
353 CALL spbtf2( '/', 0, 0, a, 1, info )
354 CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
355 infot = 2
356 CALL spbtf2( 'U', -1, 0, a, 1, info )
357 CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
358 infot = 3
359 CALL spbtf2( 'U', 1, -1, a, 1, info )
360 CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
361 infot = 5
362 CALL spbtf2( 'U', 2, 1, a, 1, info )
363 CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
364*
365* SPBTRS
366*
367 srnamt = 'SPBTRS'
368 infot = 1
369 CALL spbtrs( '/', 0, 0, 0, a, 1, b, 1, info )
370 CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
371 infot = 2
372 CALL spbtrs( 'U', -1, 0, 0, a, 1, b, 1, info )
373 CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
374 infot = 3
375 CALL spbtrs( 'U', 1, -1, 0, a, 1, b, 1, info )
376 CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
377 infot = 4
378 CALL spbtrs( 'U', 0, 0, -1, a, 1, b, 1, info )
379 CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
380 infot = 6
381 CALL spbtrs( 'U', 2, 1, 1, a, 1, b, 1, info )
382 CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
383 infot = 8
384 CALL spbtrs( 'U', 2, 0, 1, a, 1, b, 1, info )
385 CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
386*
387* SPBRFS
388*
389 srnamt = 'SPBRFS'
390 infot = 1
391 CALL spbrfs( '/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
392 $ iw, info )
393 CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
394 infot = 2
395 CALL spbrfs( 'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
396 $ iw, info )
397 CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
398 infot = 3
399 CALL spbrfs( 'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
400 $ iw, info )
401 CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
402 infot = 4
403 CALL spbrfs( 'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
404 $ iw, info )
405 CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
406 infot = 6
407 CALL spbrfs( 'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
408 $ iw, info )
409 CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
410 infot = 8
411 CALL spbrfs( 'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
412 $ iw, info )
413 CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
414 infot = 10
415 CALL spbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
416 $ iw, info )
417 CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
418 infot = 12
419 CALL spbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
420 $ iw, info )
421 CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
422*
423* SPBCON
424*
425 srnamt = 'SPBCON'
426 infot = 1
427 CALL spbcon( '/', 0, 0, a, 1, anrm, rcond, w, iw, info )
428 CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
429 infot = 2
430 CALL spbcon( 'U', -1, 0, a, 1, anrm, rcond, w, iw, info )
431 CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
432 infot = 3
433 CALL spbcon( 'U', 1, -1, a, 1, anrm, rcond, w, iw, info )
434 CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
435 infot = 5
436 CALL spbcon( 'U', 2, 1, a, 1, anrm, rcond, w, iw, info )
437 CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
438*
439* SPBEQU
440*
441 srnamt = 'SPBEQU'
442 infot = 1
443 CALL spbequ( '/', 0, 0, a, 1, r1, rcond, anrm, info )
444 CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
445 infot = 2
446 CALL spbequ( 'U', -1, 0, a, 1, r1, rcond, anrm, info )
447 CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
448 infot = 3
449 CALL spbequ( 'U', 1, -1, a, 1, r1, rcond, anrm, info )
450 CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
451 infot = 5
452 CALL spbequ( 'U', 2, 1, a, 1, r1, rcond, anrm, info )
453 CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
454 END IF
455*
456* Print a summary line.
457*
458 CALL alaesm( path, ok, nout )
459*
460 RETURN
461*
462* End of SERRPO
463*
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
spbcon
subroutine spbcon(uplo, n, kd, ab, ldab, anorm, rcond, work, iwork, info)
SPBCON
Definition spbcon.f:132
spbequ
subroutine spbequ(uplo, n, kd, ab, ldab, s, scond, amax, info)
SPBEQU
Definition spbequ.f:129
spbrfs
subroutine spbrfs(uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SPBRFS
Definition spbrfs.f:189
spbtf2
subroutine spbtf2(uplo, n, kd, ab, ldab, info)
SPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
Definition spbtf2.f:142
spbtrf
subroutine spbtrf(uplo, n, kd, ab, ldab, info)
SPBTRF
Definition spbtrf.f:142
spbtrs
subroutine spbtrs(uplo, n, kd, nrhs, ab, ldab, b, ldb, info)
SPBTRS
Definition spbtrs.f:121
spocon
subroutine spocon(uplo, n, a, lda, anorm, rcond, work, iwork, info)
SPOCON
Definition spocon.f:121
spoequ
subroutine spoequ(n, a, lda, s, scond, amax, info)
SPOEQU
Definition spoequ.f:112
sporfs
subroutine sporfs(uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SPORFS
Definition sporfs.f:183
spotf2
subroutine spotf2(uplo, n, a, lda, info)
SPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition spotf2.f:109
spotrf
subroutine spotrf(uplo, n, a, lda, info)
SPOTRF
Definition spotrf.f:107
spotri
subroutine spotri(uplo, n, a, lda, info)
SPOTRI
Definition spotri.f:95
spotrs
subroutine spotrs(uplo, n, nrhs, a, lda, b, ldb, info)
SPOTRS
Definition spotrs.f:110
sppcon
subroutine sppcon(uplo, n, ap, anorm, rcond, work, iwork, info)
SPPCON
Definition sppcon.f:118
sppequ
subroutine sppequ(uplo, n, ap, s, scond, amax, info)
SPPEQU
Definition sppequ.f:116
spprfs
subroutine spprfs(uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SPPRFS
Definition spprfs.f:171
spptrf
subroutine spptrf(uplo, n, ap, info)
SPPTRF
Definition spptrf.f:119
spptri
subroutine spptri(uplo, n, ap, info)
SPPTRI
Definition spptri.f:93
spptrs
subroutine spptrs(uplo, n, nrhs, ap, b, ldb, info)
SPPTRS
Definition spptrs.f:108
Here is the call graph for this function:
Here is the caller graph for this function: