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

◆ derrpo()

subroutine derrpo ( character*3  path,
integer  nunit 
)

DERRPO

Purpose:
 DERRPO tests the error exits for the DOUBLE PRECISION 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 derrpo.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 DOUBLE PRECISION ANRM, RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IW( NMAX )
78 DOUBLE PRECISION 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, dpbcon, dpbequ, dpbrfs, dpbtf2,
87 $ dpbtrf, dpbtrs, dpocon, dpoequ, dporfs, dpotf2,
88 $ dpotrf, dpotri, dpotrs, dppcon, dppequ, dpprfs,
89 $ dpptrf, dpptri, dpptrs
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 dble
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.d0 / dble( i+j )
114 af( i, j ) = 1.d0 / dble( i+j )
115 10 CONTINUE
116 b( j ) = 0.d0
117 r1( j ) = 0.d0
118 r2( j ) = 0.d0
119 w( j ) = 0.d0
120 x( j ) = 0.d0
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* DPOTRF
131*
132 srnamt = 'DPOTRF'
133 infot = 1
134 CALL dpotrf( '/', 0, a, 1, info )
135 CALL chkxer( 'DPOTRF', infot, nout, lerr, ok )
136 infot = 2
137 CALL dpotrf( 'U', -1, a, 1, info )
138 CALL chkxer( 'DPOTRF', infot, nout, lerr, ok )
139 infot = 4
140 CALL dpotrf( 'U', 2, a, 1, info )
141 CALL chkxer( 'DPOTRF', infot, nout, lerr, ok )
142*
143* DPOTF2
144*
145 srnamt = 'DPOTF2'
146 infot = 1
147 CALL dpotf2( '/', 0, a, 1, info )
148 CALL chkxer( 'DPOTF2', infot, nout, lerr, ok )
149 infot = 2
150 CALL dpotf2( 'U', -1, a, 1, info )
151 CALL chkxer( 'DPOTF2', infot, nout, lerr, ok )
152 infot = 4
153 CALL dpotf2( 'U', 2, a, 1, info )
154 CALL chkxer( 'DPOTF2', infot, nout, lerr, ok )
155*
156* DPOTRI
157*
158 srnamt = 'DPOTRI'
159 infot = 1
160 CALL dpotri( '/', 0, a, 1, info )
161 CALL chkxer( 'DPOTRI', infot, nout, lerr, ok )
162 infot = 2
163 CALL dpotri( 'U', -1, a, 1, info )
164 CALL chkxer( 'DPOTRI', infot, nout, lerr, ok )
165 infot = 4
166 CALL dpotri( 'U', 2, a, 1, info )
167 CALL chkxer( 'DPOTRI', infot, nout, lerr, ok )
168*
169* DPOTRS
170*
171 srnamt = 'DPOTRS'
172 infot = 1
173 CALL dpotrs( '/', 0, 0, a, 1, b, 1, info )
174 CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
175 infot = 2
176 CALL dpotrs( 'U', -1, 0, a, 1, b, 1, info )
177 CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
178 infot = 3
179 CALL dpotrs( 'U', 0, -1, a, 1, b, 1, info )
180 CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
181 infot = 5
182 CALL dpotrs( 'U', 2, 1, a, 1, b, 2, info )
183 CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
184 infot = 7
185 CALL dpotrs( 'U', 2, 1, a, 2, b, 1, info )
186 CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
187*
188* DPORFS
189*
190 srnamt = 'DPORFS'
191 infot = 1
192 CALL dporfs( '/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, iw,
193 $ info )
194 CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
195 infot = 2
196 CALL dporfs( 'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
197 $ iw, info )
198 CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
199 infot = 3
200 CALL dporfs( 'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
201 $ iw, info )
202 CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
203 infot = 5
204 CALL dporfs( 'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, iw,
205 $ info )
206 CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
207 infot = 7
208 CALL dporfs( 'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, iw,
209 $ info )
210 CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
211 infot = 9
212 CALL dporfs( 'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, iw,
213 $ info )
214 CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
215 infot = 11
216 CALL dporfs( 'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, iw,
217 $ info )
218 CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
219*
220* DPOCON
221*
222 srnamt = 'DPOCON'
223 infot = 1
224 CALL dpocon( '/', 0, a, 1, anrm, rcond, w, iw, info )
225 CALL chkxer( 'DPOCON', infot, nout, lerr, ok )
226 infot = 2
227 CALL dpocon( 'U', -1, a, 1, anrm, rcond, w, iw, info )
228 CALL chkxer( 'DPOCON', infot, nout, lerr, ok )
229 infot = 4
230 CALL dpocon( 'U', 2, a, 1, anrm, rcond, w, iw, info )
231 CALL chkxer( 'DPOCON', infot, nout, lerr, ok )
232*
233* DPOEQU
234*
235 srnamt = 'DPOEQU'
236 infot = 1
237 CALL dpoequ( -1, a, 1, r1, rcond, anrm, info )
238 CALL chkxer( 'DPOEQU', infot, nout, lerr, ok )
239 infot = 3
240 CALL dpoequ( 2, a, 1, r1, rcond, anrm, info )
241 CALL chkxer( 'DPOEQU', 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* DPPTRF
249*
250 srnamt = 'DPPTRF'
251 infot = 1
252 CALL dpptrf( '/', 0, a, info )
253 CALL chkxer( 'DPPTRF', infot, nout, lerr, ok )
254 infot = 2
255 CALL dpptrf( 'U', -1, a, info )
256 CALL chkxer( 'DPPTRF', infot, nout, lerr, ok )
257*
258* DPPTRI
259*
260 srnamt = 'DPPTRI'
261 infot = 1
262 CALL dpptri( '/', 0, a, info )
263 CALL chkxer( 'DPPTRI', infot, nout, lerr, ok )
264 infot = 2
265 CALL dpptri( 'U', -1, a, info )
266 CALL chkxer( 'DPPTRI', infot, nout, lerr, ok )
267*
268* DPPTRS
269*
270 srnamt = 'DPPTRS'
271 infot = 1
272 CALL dpptrs( '/', 0, 0, a, b, 1, info )
273 CALL chkxer( 'DPPTRS', infot, nout, lerr, ok )
274 infot = 2
275 CALL dpptrs( 'U', -1, 0, a, b, 1, info )
276 CALL chkxer( 'DPPTRS', infot, nout, lerr, ok )
277 infot = 3
278 CALL dpptrs( 'U', 0, -1, a, b, 1, info )
279 CALL chkxer( 'DPPTRS', infot, nout, lerr, ok )
280 infot = 6
281 CALL dpptrs( 'U', 2, 1, a, b, 1, info )
282 CALL chkxer( 'DPPTRS', infot, nout, lerr, ok )
283*
284* DPPRFS
285*
286 srnamt = 'DPPRFS'
287 infot = 1
288 CALL dpprfs( '/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
289 $ info )
290 CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
291 infot = 2
292 CALL dpprfs( 'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
293 $ info )
294 CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
295 infot = 3
296 CALL dpprfs( 'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, iw,
297 $ info )
298 CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
299 infot = 7
300 CALL dpprfs( 'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, iw,
301 $ info )
302 CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
303 infot = 9
304 CALL dpprfs( 'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, iw,
305 $ info )
306 CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
307*
308* DPPCON
309*
310 srnamt = 'DPPCON'
311 infot = 1
312 CALL dppcon( '/', 0, a, anrm, rcond, w, iw, info )
313 CALL chkxer( 'DPPCON', infot, nout, lerr, ok )
314 infot = 2
315 CALL dppcon( 'U', -1, a, anrm, rcond, w, iw, info )
316 CALL chkxer( 'DPPCON', infot, nout, lerr, ok )
317*
318* DPPEQU
319*
320 srnamt = 'DPPEQU'
321 infot = 1
322 CALL dppequ( '/', 0, a, r1, rcond, anrm, info )
323 CALL chkxer( 'DPPEQU', infot, nout, lerr, ok )
324 infot = 2
325 CALL dppequ( 'U', -1, a, r1, rcond, anrm, info )
326 CALL chkxer( 'DPPEQU', 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* DPBTRF
334*
335 srnamt = 'DPBTRF'
336 infot = 1
337 CALL dpbtrf( '/', 0, 0, a, 1, info )
338 CALL chkxer( 'DPBTRF', infot, nout, lerr, ok )
339 infot = 2
340 CALL dpbtrf( 'U', -1, 0, a, 1, info )
341 CALL chkxer( 'DPBTRF', infot, nout, lerr, ok )
342 infot = 3
343 CALL dpbtrf( 'U', 1, -1, a, 1, info )
344 CALL chkxer( 'DPBTRF', infot, nout, lerr, ok )
345 infot = 5
346 CALL dpbtrf( 'U', 2, 1, a, 1, info )
347 CALL chkxer( 'DPBTRF', infot, nout, lerr, ok )
348*
349* DPBTF2
350*
351 srnamt = 'DPBTF2'
352 infot = 1
353 CALL dpbtf2( '/', 0, 0, a, 1, info )
354 CALL chkxer( 'DPBTF2', infot, nout, lerr, ok )
355 infot = 2
356 CALL dpbtf2( 'U', -1, 0, a, 1, info )
357 CALL chkxer( 'DPBTF2', infot, nout, lerr, ok )
358 infot = 3
359 CALL dpbtf2( 'U', 1, -1, a, 1, info )
360 CALL chkxer( 'DPBTF2', infot, nout, lerr, ok )
361 infot = 5
362 CALL dpbtf2( 'U', 2, 1, a, 1, info )
363 CALL chkxer( 'DPBTF2', infot, nout, lerr, ok )
364*
365* DPBTRS
366*
367 srnamt = 'DPBTRS'
368 infot = 1
369 CALL dpbtrs( '/', 0, 0, 0, a, 1, b, 1, info )
370 CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
371 infot = 2
372 CALL dpbtrs( 'U', -1, 0, 0, a, 1, b, 1, info )
373 CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
374 infot = 3
375 CALL dpbtrs( 'U', 1, -1, 0, a, 1, b, 1, info )
376 CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
377 infot = 4
378 CALL dpbtrs( 'U', 0, 0, -1, a, 1, b, 1, info )
379 CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
380 infot = 6
381 CALL dpbtrs( 'U', 2, 1, 1, a, 1, b, 1, info )
382 CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
383 infot = 8
384 CALL dpbtrs( 'U', 2, 0, 1, a, 1, b, 1, info )
385 CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
386*
387* DPBRFS
388*
389 srnamt = 'DPBRFS'
390 infot = 1
391 CALL dpbrfs( '/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
392 $ iw, info )
393 CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
394 infot = 2
395 CALL dpbrfs( 'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
396 $ iw, info )
397 CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
398 infot = 3
399 CALL dpbrfs( 'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
400 $ iw, info )
401 CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
402 infot = 4
403 CALL dpbrfs( 'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
404 $ iw, info )
405 CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
406 infot = 6
407 CALL dpbrfs( 'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
408 $ iw, info )
409 CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
410 infot = 8
411 CALL dpbrfs( 'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
412 $ iw, info )
413 CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
414 infot = 10
415 CALL dpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
416 $ iw, info )
417 CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
418 infot = 12
419 CALL dpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
420 $ iw, info )
421 CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
422*
423* DPBCON
424*
425 srnamt = 'DPBCON'
426 infot = 1
427 CALL dpbcon( '/', 0, 0, a, 1, anrm, rcond, w, iw, info )
428 CALL chkxer( 'DPBCON', infot, nout, lerr, ok )
429 infot = 2
430 CALL dpbcon( 'U', -1, 0, a, 1, anrm, rcond, w, iw, info )
431 CALL chkxer( 'DPBCON', infot, nout, lerr, ok )
432 infot = 3
433 CALL dpbcon( 'U', 1, -1, a, 1, anrm, rcond, w, iw, info )
434 CALL chkxer( 'DPBCON', infot, nout, lerr, ok )
435 infot = 5
436 CALL dpbcon( 'U', 2, 1, a, 1, anrm, rcond, w, iw, info )
437 CALL chkxer( 'DPBCON', infot, nout, lerr, ok )
438*
439* DPBEQU
440*
441 srnamt = 'DPBEQU'
442 infot = 1
443 CALL dpbequ( '/', 0, 0, a, 1, r1, rcond, anrm, info )
444 CALL chkxer( 'DPBEQU', infot, nout, lerr, ok )
445 infot = 2
446 CALL dpbequ( 'U', -1, 0, a, 1, r1, rcond, anrm, info )
447 CALL chkxer( 'DPBEQU', infot, nout, lerr, ok )
448 infot = 3
449 CALL dpbequ( 'U', 1, -1, a, 1, r1, rcond, anrm, info )
450 CALL chkxer( 'DPBEQU', infot, nout, lerr, ok )
451 infot = 5
452 CALL dpbequ( 'U', 2, 1, a, 1, r1, rcond, anrm, info )
453 CALL chkxer( 'DPBEQU', 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 DERRPO
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
dpbcon
subroutine dpbcon(uplo, n, kd, ab, ldab, anorm, rcond, work, iwork, info)
DPBCON
Definition dpbcon.f:132
dpbequ
subroutine dpbequ(uplo, n, kd, ab, ldab, s, scond, amax, info)
DPBEQU
Definition dpbequ.f:129
dpbrfs
subroutine dpbrfs(uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DPBRFS
Definition dpbrfs.f:189
dpbtf2
subroutine dpbtf2(uplo, n, kd, ab, ldab, info)
DPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
Definition dpbtf2.f:142
dpbtrf
subroutine dpbtrf(uplo, n, kd, ab, ldab, info)
DPBTRF
Definition dpbtrf.f:142
dpbtrs
subroutine dpbtrs(uplo, n, kd, nrhs, ab, ldab, b, ldb, info)
DPBTRS
Definition dpbtrs.f:121
dpocon
subroutine dpocon(uplo, n, a, lda, anorm, rcond, work, iwork, info)
DPOCON
Definition dpocon.f:121
dpoequ
subroutine dpoequ(n, a, lda, s, scond, amax, info)
DPOEQU
Definition dpoequ.f:112
dporfs
subroutine dporfs(uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DPORFS
Definition dporfs.f:183
dpotf2
subroutine dpotf2(uplo, n, a, lda, info)
DPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition dpotf2.f:109
dpotrf
subroutine dpotrf(uplo, n, a, lda, info)
DPOTRF
Definition dpotrf.f:107
dpotri
subroutine dpotri(uplo, n, a, lda, info)
DPOTRI
Definition dpotri.f:95
dpotrs
subroutine dpotrs(uplo, n, nrhs, a, lda, b, ldb, info)
DPOTRS
Definition dpotrs.f:110
dppcon
subroutine dppcon(uplo, n, ap, anorm, rcond, work, iwork, info)
DPPCON
Definition dppcon.f:118
dppequ
subroutine dppequ(uplo, n, ap, s, scond, amax, info)
DPPEQU
Definition dppequ.f:116
dpprfs
subroutine dpprfs(uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DPPRFS
Definition dpprfs.f:171
dpptrf
subroutine dpptrf(uplo, n, ap, info)
DPPTRF
Definition dpptrf.f:119
dpptri
subroutine dpptri(uplo, n, ap, info)
DPPTRI
Definition dpptri.f:93
dpptrs
subroutine dpptrs(uplo, n, nrhs, ap, b, ldb, info)
DPPTRS
Definition dpptrs.f:108
Here is the call graph for this function:
Here is the caller graph for this function: