OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
serrpo.f
Go to the documentation of this file.
1*> \brief \b SERRPO
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE SERRPO( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> SERRPO tests the error exits for the REAL routines
25*> for symmetric positive definite matrices.
26*> \endverbatim
27*
28* Arguments:
29* ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*> PATH is CHARACTER*3
34*> The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*> NUNIT is INTEGER
40*> The unit number for output.
41*> \endverbatim
42*
43* Authors:
44* ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup single_lin
52*
53* =====================================================================
54 SUBROUTINE serrpo( PATH, NUNIT )
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*
464 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
spbtrs
subroutine spbtrs(uplo, n, kd, nrhs, ab, ldab, b, ldb, info)
SPBTRS
Definition spbtrs.f:121
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
spptrf
subroutine spptrf(uplo, n, ap, info)
SPPTRF
Definition spptrf.f:119
spptrs
subroutine spptrs(uplo, n, nrhs, ap, b, ldb, info)
SPPTRS
Definition spptrs.f:108
spptri
subroutine spptri(uplo, n, ap, info)
SPPTRI
Definition spptri.f:93
spbequ
subroutine spbequ(uplo, n, kd, ab, ldab, s, scond, amax, info)
SPBEQU
Definition spbequ.f:129
sppequ
subroutine sppequ(uplo, n, ap, s, scond, amax, info)
SPPEQU
Definition sppequ.f:116
spbcon
subroutine spbcon(uplo, n, kd, ab, ldab, anorm, rcond, work, iwork, info)
SPBCON
Definition spbcon.f:132
sppcon
subroutine sppcon(uplo, n, ap, anorm, rcond, work, iwork, info)
SPPCON
Definition sppcon.f:118
spbtrf
subroutine spbtrf(uplo, n, kd, ab, ldab, info)
SPBTRF
Definition spbtrf.f:142
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
spprfs
subroutine spprfs(uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SPPRFS
Definition spprfs.f:171
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
spotrs
subroutine spotrs(uplo, n, nrhs, a, lda, b, ldb, info)
SPOTRS
Definition spotrs.f:110
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
spotri
subroutine spotri(uplo, n, a, lda, info)
SPOTRI
Definition spotri.f:95
spotrf
subroutine spotrf(uplo, n, a, lda, info)
SPOTRF
Definition spotrf.f:107
serrpo
subroutine serrpo(path, nunit)
SERRPO
Definition serrpo.f:55