LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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,
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 *
464  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
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