LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
derrpo.f
Go to the documentation of this file.
1*> \brief \b DERRPO
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 DERRPO( 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*> DERRPO tests the error exits for the DOUBLE PRECISION 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 double_lin
52*
53* =====================================================================
54 SUBROUTINE derrpo( 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 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,
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*
464 END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3224
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine derrpo(PATH, NUNIT)
DERRPO
Definition: derrpo.f:55
subroutine dpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
DPBCON
Definition: dpbcon.f:132
subroutine dpptrf(UPLO, N, AP, INFO)
DPPTRF
Definition: dpptrf.f:119
subroutine dppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
DPPEQU
Definition: dppequ.f:116
subroutine dpbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPBRFS
Definition: dpbrfs.f:189
subroutine dpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPPRFS
Definition: dpprfs.f:171
subroutine dppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
DPPCON
Definition: dppcon.f:118
subroutine dpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
DPPTRS
Definition: dpptrs.f:108
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
subroutine dpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
DPBTRS
Definition: dpbtrs.f:121
subroutine dpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
DPBEQU
Definition: dpbequ.f:129
subroutine dpbtrf(UPLO, N, KD, AB, LDAB, INFO)
DPBTRF
Definition: dpbtrf.f:142
subroutine dpptri(UPLO, N, AP, INFO)
DPPTRI
Definition: dpptri.f:93
subroutine dporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPORFS
Definition: dporfs.f:183
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOTRS
Definition: dpotrs.f:110
subroutine dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
Definition: dpotrf.f:107
subroutine dpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DPOCON
Definition: dpocon.f:121
subroutine dpotf2(UPLO, N, A, LDA, INFO)
DPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition: dpotf2.f:109
subroutine dpotri(UPLO, N, A, LDA, INFO)
DPOTRI
Definition: dpotri.f:95
subroutine dpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
DPOEQU
Definition: dpoequ.f:112