LAPACK  3.9.0
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 *> \date December 2016
52 *
53 *> \ingroup double_lin
54 *
55 * =====================================================================
56  SUBROUTINE derrpo( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.7.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * December 2016
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 PATH
65  INTEGER NUNIT
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER NMAX
72  parameter( nmax = 4 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 C2
76  INTEGER I, INFO, J
77  DOUBLE PRECISION ANRM, RCOND
78 * ..
79 * .. Local Arrays ..
80  INTEGER IW( NMAX )
81  DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
82  $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX )
83 * ..
84 * .. External Functions ..
85  LOGICAL LSAMEN
86  EXTERNAL lsamen
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL alaesm, chkxer, dpbcon, dpbequ, dpbrfs, dpbtf2,
90  $ dpbtrf, dpbtrs, dpocon, dpoequ, dporfs, dpotf2,
91  $ dpotrf, dpotri, dpotrs, dppcon, dppequ, dpprfs,
92  $ dpptrf, dpptri, dpptrs
93 * ..
94 * .. Scalars in Common ..
95  LOGICAL LERR, OK
96  CHARACTER*32 SRNAMT
97  INTEGER INFOT, NOUT
98 * ..
99 * .. Common blocks ..
100  COMMON / infoc / infot, nout, ok, lerr
101  COMMON / srnamc / srnamt
102 * ..
103 * .. Intrinsic Functions ..
104  INTRINSIC dble
105 * ..
106 * .. Executable Statements ..
107 *
108  nout = nunit
109  WRITE( nout, fmt = * )
110  c2 = path( 2: 3 )
111 *
112 * Set the variables to innocuous values.
113 *
114  DO 20 j = 1, nmax
115  DO 10 i = 1, nmax
116  a( i, j ) = 1.d0 / dble( i+j )
117  af( i, j ) = 1.d0 / dble( i+j )
118  10 CONTINUE
119  b( j ) = 0.d0
120  r1( j ) = 0.d0
121  r2( j ) = 0.d0
122  w( j ) = 0.d0
123  x( j ) = 0.d0
124  iw( j ) = j
125  20 CONTINUE
126  ok = .true.
127 *
128  IF( lsamen( 2, c2, 'PO' ) ) THEN
129 *
130 * Test error exits of the routines that use the Cholesky
131 * decomposition of a symmetric positive definite matrix.
132 *
133 * DPOTRF
134 *
135  srnamt = 'DPOTRF'
136  infot = 1
137  CALL dpotrf( '/', 0, a, 1, info )
138  CALL chkxer( 'DPOTRF', infot, nout, lerr, ok )
139  infot = 2
140  CALL dpotrf( 'U', -1, a, 1, info )
141  CALL chkxer( 'DPOTRF', infot, nout, lerr, ok )
142  infot = 4
143  CALL dpotrf( 'U', 2, a, 1, info )
144  CALL chkxer( 'DPOTRF', infot, nout, lerr, ok )
145 *
146 * DPOTF2
147 *
148  srnamt = 'DPOTF2'
149  infot = 1
150  CALL dpotf2( '/', 0, a, 1, info )
151  CALL chkxer( 'DPOTF2', infot, nout, lerr, ok )
152  infot = 2
153  CALL dpotf2( 'U', -1, a, 1, info )
154  CALL chkxer( 'DPOTF2', infot, nout, lerr, ok )
155  infot = 4
156  CALL dpotf2( 'U', 2, a, 1, info )
157  CALL chkxer( 'DPOTF2', infot, nout, lerr, ok )
158 *
159 * DPOTRI
160 *
161  srnamt = 'DPOTRI'
162  infot = 1
163  CALL dpotri( '/', 0, a, 1, info )
164  CALL chkxer( 'DPOTRI', infot, nout, lerr, ok )
165  infot = 2
166  CALL dpotri( 'U', -1, a, 1, info )
167  CALL chkxer( 'DPOTRI', infot, nout, lerr, ok )
168  infot = 4
169  CALL dpotri( 'U', 2, a, 1, info )
170  CALL chkxer( 'DPOTRI', infot, nout, lerr, ok )
171 *
172 * DPOTRS
173 *
174  srnamt = 'DPOTRS'
175  infot = 1
176  CALL dpotrs( '/', 0, 0, a, 1, b, 1, info )
177  CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
178  infot = 2
179  CALL dpotrs( 'U', -1, 0, a, 1, b, 1, info )
180  CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
181  infot = 3
182  CALL dpotrs( 'U', 0, -1, a, 1, b, 1, info )
183  CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
184  infot = 5
185  CALL dpotrs( 'U', 2, 1, a, 1, b, 2, info )
186  CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
187  infot = 7
188  CALL dpotrs( 'U', 2, 1, a, 2, b, 1, info )
189  CALL chkxer( 'DPOTRS', infot, nout, lerr, ok )
190 *
191 * DPORFS
192 *
193  srnamt = 'DPORFS'
194  infot = 1
195  CALL dporfs( '/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, iw,
196  $ info )
197  CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
198  infot = 2
199  CALL dporfs( 'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
200  $ iw, info )
201  CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
202  infot = 3
203  CALL dporfs( 'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
204  $ iw, info )
205  CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
206  infot = 5
207  CALL dporfs( 'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, iw,
208  $ info )
209  CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
210  infot = 7
211  CALL dporfs( 'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, iw,
212  $ info )
213  CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
214  infot = 9
215  CALL dporfs( 'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, iw,
216  $ info )
217  CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
218  infot = 11
219  CALL dporfs( 'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, iw,
220  $ info )
221  CALL chkxer( 'DPORFS', infot, nout, lerr, ok )
222 *
223 * DPOCON
224 *
225  srnamt = 'DPOCON'
226  infot = 1
227  CALL dpocon( '/', 0, a, 1, anrm, rcond, w, iw, info )
228  CALL chkxer( 'DPOCON', infot, nout, lerr, ok )
229  infot = 2
230  CALL dpocon( 'U', -1, a, 1, anrm, rcond, w, iw, info )
231  CALL chkxer( 'DPOCON', infot, nout, lerr, ok )
232  infot = 4
233  CALL dpocon( 'U', 2, a, 1, anrm, rcond, w, iw, info )
234  CALL chkxer( 'DPOCON', infot, nout, lerr, ok )
235 *
236 * DPOEQU
237 *
238  srnamt = 'DPOEQU'
239  infot = 1
240  CALL dpoequ( -1, a, 1, r1, rcond, anrm, info )
241  CALL chkxer( 'DPOEQU', infot, nout, lerr, ok )
242  infot = 3
243  CALL dpoequ( 2, a, 1, r1, rcond, anrm, info )
244  CALL chkxer( 'DPOEQU', infot, nout, lerr, ok )
245 *
246  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
247 *
248 * Test error exits of the routines that use the Cholesky
249 * decomposition of a symmetric positive definite packed matrix.
250 *
251 * DPPTRF
252 *
253  srnamt = 'DPPTRF'
254  infot = 1
255  CALL dpptrf( '/', 0, a, info )
256  CALL chkxer( 'DPPTRF', infot, nout, lerr, ok )
257  infot = 2
258  CALL dpptrf( 'U', -1, a, info )
259  CALL chkxer( 'DPPTRF', infot, nout, lerr, ok )
260 *
261 * DPPTRI
262 *
263  srnamt = 'DPPTRI'
264  infot = 1
265  CALL dpptri( '/', 0, a, info )
266  CALL chkxer( 'DPPTRI', infot, nout, lerr, ok )
267  infot = 2
268  CALL dpptri( 'U', -1, a, info )
269  CALL chkxer( 'DPPTRI', infot, nout, lerr, ok )
270 *
271 * DPPTRS
272 *
273  srnamt = 'DPPTRS'
274  infot = 1
275  CALL dpptrs( '/', 0, 0, a, b, 1, info )
276  CALL chkxer( 'DPPTRS', infot, nout, lerr, ok )
277  infot = 2
278  CALL dpptrs( 'U', -1, 0, a, b, 1, info )
279  CALL chkxer( 'DPPTRS', infot, nout, lerr, ok )
280  infot = 3
281  CALL dpptrs( 'U', 0, -1, a, b, 1, info )
282  CALL chkxer( 'DPPTRS', infot, nout, lerr, ok )
283  infot = 6
284  CALL dpptrs( 'U', 2, 1, a, b, 1, info )
285  CALL chkxer( 'DPPTRS', infot, nout, lerr, ok )
286 *
287 * DPPRFS
288 *
289  srnamt = 'DPPRFS'
290  infot = 1
291  CALL dpprfs( '/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
292  $ info )
293  CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
294  infot = 2
295  CALL dpprfs( 'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
296  $ info )
297  CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
298  infot = 3
299  CALL dpprfs( 'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, iw,
300  $ info )
301  CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
302  infot = 7
303  CALL dpprfs( 'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, iw,
304  $ info )
305  CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
306  infot = 9
307  CALL dpprfs( 'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, iw,
308  $ info )
309  CALL chkxer( 'DPPRFS', infot, nout, lerr, ok )
310 *
311 * DPPCON
312 *
313  srnamt = 'DPPCON'
314  infot = 1
315  CALL dppcon( '/', 0, a, anrm, rcond, w, iw, info )
316  CALL chkxer( 'DPPCON', infot, nout, lerr, ok )
317  infot = 2
318  CALL dppcon( 'U', -1, a, anrm, rcond, w, iw, info )
319  CALL chkxer( 'DPPCON', infot, nout, lerr, ok )
320 *
321 * DPPEQU
322 *
323  srnamt = 'DPPEQU'
324  infot = 1
325  CALL dppequ( '/', 0, a, r1, rcond, anrm, info )
326  CALL chkxer( 'DPPEQU', infot, nout, lerr, ok )
327  infot = 2
328  CALL dppequ( 'U', -1, a, r1, rcond, anrm, info )
329  CALL chkxer( 'DPPEQU', infot, nout, lerr, ok )
330 *
331  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
332 *
333 * Test error exits of the routines that use the Cholesky
334 * decomposition of a symmetric positive definite band matrix.
335 *
336 * DPBTRF
337 *
338  srnamt = 'DPBTRF'
339  infot = 1
340  CALL dpbtrf( '/', 0, 0, a, 1, info )
341  CALL chkxer( 'DPBTRF', infot, nout, lerr, ok )
342  infot = 2
343  CALL dpbtrf( 'U', -1, 0, a, 1, info )
344  CALL chkxer( 'DPBTRF', infot, nout, lerr, ok )
345  infot = 3
346  CALL dpbtrf( 'U', 1, -1, a, 1, info )
347  CALL chkxer( 'DPBTRF', infot, nout, lerr, ok )
348  infot = 5
349  CALL dpbtrf( 'U', 2, 1, a, 1, info )
350  CALL chkxer( 'DPBTRF', infot, nout, lerr, ok )
351 *
352 * DPBTF2
353 *
354  srnamt = 'DPBTF2'
355  infot = 1
356  CALL dpbtf2( '/', 0, 0, a, 1, info )
357  CALL chkxer( 'DPBTF2', infot, nout, lerr, ok )
358  infot = 2
359  CALL dpbtf2( 'U', -1, 0, a, 1, info )
360  CALL chkxer( 'DPBTF2', infot, nout, lerr, ok )
361  infot = 3
362  CALL dpbtf2( 'U', 1, -1, a, 1, info )
363  CALL chkxer( 'DPBTF2', infot, nout, lerr, ok )
364  infot = 5
365  CALL dpbtf2( 'U', 2, 1, a, 1, info )
366  CALL chkxer( 'DPBTF2', infot, nout, lerr, ok )
367 *
368 * DPBTRS
369 *
370  srnamt = 'DPBTRS'
371  infot = 1
372  CALL dpbtrs( '/', 0, 0, 0, a, 1, b, 1, info )
373  CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
374  infot = 2
375  CALL dpbtrs( 'U', -1, 0, 0, a, 1, b, 1, info )
376  CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
377  infot = 3
378  CALL dpbtrs( 'U', 1, -1, 0, a, 1, b, 1, info )
379  CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
380  infot = 4
381  CALL dpbtrs( 'U', 0, 0, -1, a, 1, b, 1, info )
382  CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
383  infot = 6
384  CALL dpbtrs( 'U', 2, 1, 1, a, 1, b, 1, info )
385  CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
386  infot = 8
387  CALL dpbtrs( 'U', 2, 0, 1, a, 1, b, 1, info )
388  CALL chkxer( 'DPBTRS', infot, nout, lerr, ok )
389 *
390 * DPBRFS
391 *
392  srnamt = 'DPBRFS'
393  infot = 1
394  CALL dpbrfs( '/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
395  $ iw, info )
396  CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
397  infot = 2
398  CALL dpbrfs( 'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
399  $ iw, info )
400  CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
401  infot = 3
402  CALL dpbrfs( 'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
403  $ iw, info )
404  CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
405  infot = 4
406  CALL dpbrfs( 'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
407  $ iw, info )
408  CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
409  infot = 6
410  CALL dpbrfs( 'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
411  $ iw, info )
412  CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
413  infot = 8
414  CALL dpbrfs( 'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
415  $ iw, info )
416  CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
417  infot = 10
418  CALL dpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
419  $ iw, info )
420  CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
421  infot = 12
422  CALL dpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
423  $ iw, info )
424  CALL chkxer( 'DPBRFS', infot, nout, lerr, ok )
425 *
426 * DPBCON
427 *
428  srnamt = 'DPBCON'
429  infot = 1
430  CALL dpbcon( '/', 0, 0, a, 1, anrm, rcond, w, iw, info )
431  CALL chkxer( 'DPBCON', infot, nout, lerr, ok )
432  infot = 2
433  CALL dpbcon( 'U', -1, 0, a, 1, anrm, rcond, w, iw, info )
434  CALL chkxer( 'DPBCON', infot, nout, lerr, ok )
435  infot = 3
436  CALL dpbcon( 'U', 1, -1, a, 1, anrm, rcond, w, iw, info )
437  CALL chkxer( 'DPBCON', infot, nout, lerr, ok )
438  infot = 5
439  CALL dpbcon( 'U', 2, 1, a, 1, anrm, rcond, w, iw, info )
440  CALL chkxer( 'DPBCON', infot, nout, lerr, ok )
441 *
442 * DPBEQU
443 *
444  srnamt = 'DPBEQU'
445  infot = 1
446  CALL dpbequ( '/', 0, 0, a, 1, r1, rcond, anrm, info )
447  CALL chkxer( 'DPBEQU', infot, nout, lerr, ok )
448  infot = 2
449  CALL dpbequ( 'U', -1, 0, a, 1, r1, rcond, anrm, info )
450  CALL chkxer( 'DPBEQU', infot, nout, lerr, ok )
451  infot = 3
452  CALL dpbequ( 'U', 1, -1, a, 1, r1, rcond, anrm, info )
453  CALL chkxer( 'DPBEQU', infot, nout, lerr, ok )
454  infot = 5
455  CALL dpbequ( 'U', 2, 1, a, 1, r1, rcond, anrm, info )
456  CALL chkxer( 'DPBEQU', infot, nout, lerr, ok )
457  END IF
458 *
459 * Print a summary line.
460 *
461  CALL alaesm( path, ok, nout )
462 *
463  RETURN
464 *
465 * End of DERRPO
466 *
467  END
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
derrpo
subroutine derrpo(PATH, NUNIT)
DERRPO
Definition: derrpo.f:57
dpbrfs
subroutine dpbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPBRFS
Definition: dpbrfs.f:191
dpotri
subroutine dpotri(UPLO, N, A, LDA, INFO)
DPOTRI
Definition: dpotri.f:97
dppcon
subroutine dppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
DPPCON
Definition: dppcon.f:120
dpbtrf
subroutine dpbtrf(UPLO, N, KD, AB, LDAB, INFO)
DPBTRF
Definition: dpbtrf.f:144
dporfs
subroutine dporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPORFS
Definition: dporfs.f:185
dpptrs
subroutine dpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
DPPTRS
Definition: dpptrs.f:110
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:144
dpptrf
subroutine dpptrf(UPLO, N, AP, INFO)
DPPTRF
Definition: dpptrf.f:121
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dpbequ
subroutine dpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
DPBEQU
Definition: dpbequ.f:131
dpprfs
subroutine dpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPPRFS
Definition: dpprfs.f:173
dpptri
subroutine dpptri(UPLO, N, AP, INFO)
DPPTRI
Definition: dpptri.f:95
dpbtrs
subroutine dpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
DPBTRS
Definition: dpbtrs.f:123
dpotf2
subroutine dpotf2(UPLO, N, A, LDA, INFO)
DPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition: dpotf2.f:111
dpbcon
subroutine dpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
DPBCON
Definition: dpbcon.f:134
dppequ
subroutine dppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
DPPEQU
Definition: dppequ.f:118
dpotrs
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOTRS
Definition: dpotrs.f:112
dpotrf
subroutine dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
Definition: dpotrf.f:109
dpocon
subroutine dpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DPOCON
Definition: dpocon.f:123
dpoequ
subroutine dpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
DPOEQU
Definition: dpoequ.f:114