LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
cerrpo.f
Go to the documentation of this file.
1 *> \brief \b CERRPO
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 CERRPO( 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 *> CERRPO tests the error exits for the COMPLEX routines
25 *> for Hermitian 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 complex_lin
52 *
53 * =====================================================================
54  SUBROUTINE cerrpo( 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  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,
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 *
470  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine cerrpo(PATH, NUNIT)
CERRPO
Definition: cerrpo.f:55
subroutine cpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
CPPTRS
Definition: cpptrs.f:108
subroutine cppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
CPPEQU
Definition: cppequ.f:117
subroutine cpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
CPBEQU
Definition: cpbequ.f:130
subroutine cppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
CPPCON
Definition: cppcon.f:118
subroutine cpbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPBRFS
Definition: cpbrfs.f:189
subroutine cpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, RWORK, INFO)
CPBCON
Definition: cpbcon.f:133
subroutine cpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
CPBTRS
Definition: cpbtrs.f:121
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
subroutine cpptri(UPLO, N, AP, INFO)
CPPTRI
Definition: cpptri.f:93
subroutine cpptrf(UPLO, N, AP, INFO)
CPPTRF
Definition: cpptrf.f:119
subroutine cpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPPRFS
Definition: cpprfs.f:171
subroutine cpbtrf(UPLO, N, KD, AB, LDAB, INFO)
CPBTRF
Definition: cpbtrf.f:142
subroutine cpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
CPOEQU
Definition: cpoequ.f:113
subroutine cporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPORFS
Definition: cporfs.f:183
subroutine cpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CPOCON
Definition: cpocon.f:121
subroutine cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
Definition: cpotrf.f:107
subroutine cpotri(UPLO, N, A, LDA, INFO)
CPOTRI
Definition: cpotri.f:95
subroutine cpotf2(UPLO, N, A, LDA, INFO)
CPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition: cpotf2.f:109
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS
Definition: cpotrs.f:110