LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cerrpo()

subroutine cerrpo ( character*3  PATH,
integer  NUNIT 
)

CERRPO

CERRPOX

Purpose:
 CERRPO tests the error exits for the COMPLEX routines
 for Hermitian 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.
Purpose:
 CERRPO tests the error exits for the COMPLEX routines
 for Hermitian positive definite matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise cerrpo.f defines this subroutine.
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 cerrpo.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  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 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
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
Here is the call graph for this function:
Here is the caller graph for this function: