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

◆ cerrpo()

subroutine cerrpo ( character*3  path,
integer  nunit 
)

CERRPO

Purpose:
 CERRPO tests the error exits for the COMPLEX routines
 for Hermitian 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 cerrpo.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 REAL R( NMAX ), R1( NMAX ), R2( NMAX )
78 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
79 $ W( 2*NMAX ), X( NMAX )
80* ..
81* .. External Functions ..
82 LOGICAL LSAMEN
83 EXTERNAL lsamen
84* ..
85* .. External Subroutines ..
86 EXTERNAL alaesm, chkxer, cpbcon, cpbequ, cpbrfs, cpbtf2,
87 $ cpbtrf, cpbtrs, cpocon, cpoequ, cporfs, cpotf2,
88 $ cpotrf, cpotri, cpotrs, cppcon, cppequ, cpprfs,
89 $ cpptrf, cpptri, cpptrs
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 cmplx, 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 ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
114 af( i, j ) = cmplx( 1. / real( 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 20 CONTINUE
122 anrm = 1.
123 ok = .true.
124*
125* Test error exits of the routines that use the Cholesky
126* decomposition of a Hermitian positive definite matrix.
127*
128 IF( lsamen( 2, c2, 'PO' ) ) THEN
129*
130* CPOTRF
131*
132 srnamt = 'CPOTRF'
133 infot = 1
134 CALL cpotrf( '/', 0, a, 1, info )
135 CALL chkxer( 'CPOTRF', infot, nout, lerr, ok )
136 infot = 2
137 CALL cpotrf( 'U', -1, a, 1, info )
138 CALL chkxer( 'CPOTRF', infot, nout, lerr, ok )
139 infot = 4
140 CALL cpotrf( 'U', 2, a, 1, info )
141 CALL chkxer( 'CPOTRF', infot, nout, lerr, ok )
142*
143* CPOTF2
144*
145 srnamt = 'CPOTF2'
146 infot = 1
147 CALL cpotf2( '/', 0, a, 1, info )
148 CALL chkxer( 'CPOTF2', infot, nout, lerr, ok )
149 infot = 2
150 CALL cpotf2( 'U', -1, a, 1, info )
151 CALL chkxer( 'CPOTF2', infot, nout, lerr, ok )
152 infot = 4
153 CALL cpotf2( 'U', 2, a, 1, info )
154 CALL chkxer( 'CPOTF2', infot, nout, lerr, ok )
155*
156* CPOTRI
157*
158 srnamt = 'CPOTRI'
159 infot = 1
160 CALL cpotri( '/', 0, a, 1, info )
161 CALL chkxer( 'CPOTRI', infot, nout, lerr, ok )
162 infot = 2
163 CALL cpotri( 'U', -1, a, 1, info )
164 CALL chkxer( 'CPOTRI', infot, nout, lerr, ok )
165 infot = 4
166 CALL cpotri( 'U', 2, a, 1, info )
167 CALL chkxer( 'CPOTRI', infot, nout, lerr, ok )
168*
169* CPOTRS
170*
171 srnamt = 'CPOTRS'
172 infot = 1
173 CALL cpotrs( '/', 0, 0, a, 1, b, 1, info )
174 CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
175 infot = 2
176 CALL cpotrs( 'U', -1, 0, a, 1, b, 1, info )
177 CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
178 infot = 3
179 CALL cpotrs( 'U', 0, -1, a, 1, b, 1, info )
180 CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
181 infot = 5
182 CALL cpotrs( 'U', 2, 1, a, 1, b, 2, info )
183 CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
184 infot = 7
185 CALL cpotrs( 'U', 2, 1, a, 2, b, 1, info )
186 CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
187*
188* CPORFS
189*
190 srnamt = 'CPORFS'
191 infot = 1
192 CALL cporfs( '/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
193 $ info )
194 CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
195 infot = 2
196 CALL cporfs( 'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
197 $ info )
198 CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
199 infot = 3
200 CALL cporfs( 'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
201 $ info )
202 CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
203 infot = 5
204 CALL cporfs( 'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, r,
205 $ info )
206 CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
207 infot = 7
208 CALL cporfs( 'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, r,
209 $ info )
210 CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
211 infot = 9
212 CALL cporfs( 'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, r,
213 $ info )
214 CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
215 infot = 11
216 CALL cporfs( 'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, r,
217 $ info )
218 CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
219*
220* CPOCON
221*
222 srnamt = 'CPOCON'
223 infot = 1
224 CALL cpocon( '/', 0, a, 1, anrm, rcond, w, r, info )
225 CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
226 infot = 2
227 CALL cpocon( 'U', -1, a, 1, anrm, rcond, w, r, info )
228 CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
229 infot = 4
230 CALL cpocon( 'U', 2, a, 1, anrm, rcond, w, r, info )
231 CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
232 infot = 5
233 CALL cpocon( 'U', 1, a, 1, -anrm, rcond, w, r, info )
234 CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
235*
236* CPOEQU
237*
238 srnamt = 'CPOEQU'
239 infot = 1
240 CALL cpoequ( -1, a, 1, r1, rcond, anrm, info )
241 CALL chkxer( 'CPOEQU', infot, nout, lerr, ok )
242 infot = 3
243 CALL cpoequ( 2, a, 1, r1, rcond, anrm, info )
244 CALL chkxer( 'CPOEQU', infot, nout, lerr, ok )
245*
246* Test error exits of the routines that use the Cholesky
247* decomposition of a Hermitian positive definite packed matrix.
248*
249 ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
250*
251* CPPTRF
252*
253 srnamt = 'CPPTRF'
254 infot = 1
255 CALL cpptrf( '/', 0, a, info )
256 CALL chkxer( 'CPPTRF', infot, nout, lerr, ok )
257 infot = 2
258 CALL cpptrf( 'U', -1, a, info )
259 CALL chkxer( 'CPPTRF', infot, nout, lerr, ok )
260*
261* CPPTRI
262*
263 srnamt = 'CPPTRI'
264 infot = 1
265 CALL cpptri( '/', 0, a, info )
266 CALL chkxer( 'CPPTRI', infot, nout, lerr, ok )
267 infot = 2
268 CALL cpptri( 'U', -1, a, info )
269 CALL chkxer( 'CPPTRI', infot, nout, lerr, ok )
270*
271* CPPTRS
272*
273 srnamt = 'CPPTRS'
274 infot = 1
275 CALL cpptrs( '/', 0, 0, a, b, 1, info )
276 CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
277 infot = 2
278 CALL cpptrs( 'U', -1, 0, a, b, 1, info )
279 CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
280 infot = 3
281 CALL cpptrs( 'U', 0, -1, a, b, 1, info )
282 CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
283 infot = 6
284 CALL cpptrs( 'U', 2, 1, a, b, 1, info )
285 CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
286*
287* CPPRFS
288*
289 srnamt = 'CPPRFS'
290 infot = 1
291 CALL cpprfs( '/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, r, info )
292 CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
293 infot = 2
294 CALL cpprfs( 'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, r,
295 $ info )
296 CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
297 infot = 3
298 CALL cpprfs( 'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, r,
299 $ info )
300 CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
301 infot = 7
302 CALL cpprfs( 'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, r, info )
303 CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
304 infot = 9
305 CALL cpprfs( 'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, r, info )
306 CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
307*
308* CPPCON
309*
310 srnamt = 'CPPCON'
311 infot = 1
312 CALL cppcon( '/', 0, a, anrm, rcond, w, r, info )
313 CALL chkxer( 'CPPCON', infot, nout, lerr, ok )
314 infot = 2
315 CALL cppcon( 'U', -1, a, anrm, rcond, w, r, info )
316 CALL chkxer( 'CPPCON', infot, nout, lerr, ok )
317 infot = 4
318 CALL cppcon( 'U', 1, a, -anrm, rcond, w, r, info )
319 CALL chkxer( 'CPPCON', infot, nout, lerr, ok )
320*
321* CPPEQU
322*
323 srnamt = 'CPPEQU'
324 infot = 1
325 CALL cppequ( '/', 0, a, r1, rcond, anrm, info )
326 CALL chkxer( 'CPPEQU', infot, nout, lerr, ok )
327 infot = 2
328 CALL cppequ( 'U', -1, a, r1, rcond, anrm, info )
329 CALL chkxer( 'CPPEQU', infot, nout, lerr, ok )
330*
331* Test error exits of the routines that use the Cholesky
332* decomposition of a Hermitian positive definite band matrix.
333*
334 ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
335*
336* CPBTRF
337*
338 srnamt = 'CPBTRF'
339 infot = 1
340 CALL cpbtrf( '/', 0, 0, a, 1, info )
341 CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
342 infot = 2
343 CALL cpbtrf( 'U', -1, 0, a, 1, info )
344 CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
345 infot = 3
346 CALL cpbtrf( 'U', 1, -1, a, 1, info )
347 CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
348 infot = 5
349 CALL cpbtrf( 'U', 2, 1, a, 1, info )
350 CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
351*
352* CPBTF2
353*
354 srnamt = 'CPBTF2'
355 infot = 1
356 CALL cpbtf2( '/', 0, 0, a, 1, info )
357 CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
358 infot = 2
359 CALL cpbtf2( 'U', -1, 0, a, 1, info )
360 CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
361 infot = 3
362 CALL cpbtf2( 'U', 1, -1, a, 1, info )
363 CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
364 infot = 5
365 CALL cpbtf2( 'U', 2, 1, a, 1, info )
366 CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
367*
368* CPBTRS
369*
370 srnamt = 'CPBTRS'
371 infot = 1
372 CALL cpbtrs( '/', 0, 0, 0, a, 1, b, 1, info )
373 CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
374 infot = 2
375 CALL cpbtrs( 'U', -1, 0, 0, a, 1, b, 1, info )
376 CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
377 infot = 3
378 CALL cpbtrs( 'U', 1, -1, 0, a, 1, b, 1, info )
379 CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
380 infot = 4
381 CALL cpbtrs( 'U', 0, 0, -1, a, 1, b, 1, info )
382 CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
383 infot = 6
384 CALL cpbtrs( 'U', 2, 1, 1, a, 1, b, 1, info )
385 CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
386 infot = 8
387 CALL cpbtrs( 'U', 2, 0, 1, a, 1, b, 1, info )
388 CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
389*
390* CPBRFS
391*
392 srnamt = 'CPBRFS'
393 infot = 1
394 CALL cpbrfs( '/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
395 $ r, info )
396 CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
397 infot = 2
398 CALL cpbrfs( 'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
399 $ r, info )
400 CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
401 infot = 3
402 CALL cpbrfs( 'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
403 $ r, info )
404 CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
405 infot = 4
406 CALL cpbrfs( 'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
407 $ r, info )
408 CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
409 infot = 6
410 CALL cpbrfs( 'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
411 $ r, info )
412 CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
413 infot = 8
414 CALL cpbrfs( 'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
415 $ r, info )
416 CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
417 infot = 10
418 CALL cpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
419 $ r, info )
420 CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
421 infot = 12
422 CALL cpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
423 $ r, info )
424 CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
425*
426* CPBCON
427*
428 srnamt = 'CPBCON'
429 infot = 1
430 CALL cpbcon( '/', 0, 0, a, 1, anrm, rcond, w, r, info )
431 CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
432 infot = 2
433 CALL cpbcon( 'U', -1, 0, a, 1, anrm, rcond, w, r, info )
434 CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
435 infot = 3
436 CALL cpbcon( 'U', 1, -1, a, 1, anrm, rcond, w, r, info )
437 CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
438 infot = 5
439 CALL cpbcon( 'U', 2, 1, a, 1, anrm, rcond, w, r, info )
440 CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
441 infot = 6
442 CALL cpbcon( 'U', 1, 0, a, 1, -anrm, rcond, w, r, info )
443 CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
444*
445* CPBEQU
446*
447 srnamt = 'CPBEQU'
448 infot = 1
449 CALL cpbequ( '/', 0, 0, a, 1, r1, rcond, anrm, info )
450 CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
451 infot = 2
452 CALL cpbequ( 'U', -1, 0, a, 1, r1, rcond, anrm, info )
453 CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
454 infot = 3
455 CALL cpbequ( 'U', 1, -1, a, 1, r1, rcond, anrm, info )
456 CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
457 infot = 5
458 CALL cpbequ( 'U', 2, 1, a, 1, r1, rcond, anrm, info )
459 CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
460 END IF
461*
462* Print a summary line.
463*
464 CALL alaesm( path, ok, nout )
465*
466 RETURN
467*
468* End of CERRPO
469*
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
cpbcon
subroutine cpbcon(uplo, n, kd, ab, ldab, anorm, rcond, work, rwork, info)
CPBCON
Definition cpbcon.f:133
cpbequ
subroutine cpbequ(uplo, n, kd, ab, ldab, s, scond, amax, info)
CPBEQU
Definition cpbequ.f:130
cpbrfs
subroutine cpbrfs(uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CPBRFS
Definition cpbrfs.f:189
cpbtf2
subroutine cpbtf2(uplo, n, kd, ab, ldab, info)
CPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
Definition cpbtf2.f:142
cpbtrf
subroutine cpbtrf(uplo, n, kd, ab, ldab, info)
CPBTRF
Definition cpbtrf.f:142
cpbtrs
subroutine cpbtrs(uplo, n, kd, nrhs, ab, ldab, b, ldb, info)
CPBTRS
Definition cpbtrs.f:121
cpocon
subroutine cpocon(uplo, n, a, lda, anorm, rcond, work, rwork, info)
CPOCON
Definition cpocon.f:121
cpoequ
subroutine cpoequ(n, a, lda, s, scond, amax, info)
CPOEQU
Definition cpoequ.f:113
cporfs
subroutine cporfs(uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CPORFS
Definition cporfs.f:183
cpotf2
subroutine cpotf2(uplo, n, a, lda, info)
CPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition cpotf2.f:109
cpotrf
subroutine cpotrf(uplo, n, a, lda, info)
CPOTRF
Definition cpotrf.f:107
cpotri
subroutine cpotri(uplo, n, a, lda, info)
CPOTRI
Definition cpotri.f:95
cpotrs
subroutine cpotrs(uplo, n, nrhs, a, lda, b, ldb, info)
CPOTRS
Definition cpotrs.f:110
cppcon
subroutine cppcon(uplo, n, ap, anorm, rcond, work, rwork, info)
CPPCON
Definition cppcon.f:118
cppequ
subroutine cppequ(uplo, n, ap, s, scond, amax, info)
CPPEQU
Definition cppequ.f:117
cpprfs
subroutine cpprfs(uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CPPRFS
Definition cpprfs.f:171
cpptrf
subroutine cpptrf(uplo, n, ap, info)
CPPTRF
Definition cpptrf.f:119
cpptri
subroutine cpptri(uplo, n, ap, info)
CPPTRI
Definition cpptri.f:93
cpptrs
subroutine cpptrs(uplo, n, nrhs, ap, b, ldb, info)
CPPTRS
Definition cpptrs.f:108
Here is the call graph for this function:
Here is the caller graph for this function: