LAPACK  3.8.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.
Date
December 2016
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.
Date
December 2016

Definition at line 57 of file cerrpo.f.

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  REAL anrm, rcond
78 * ..
79 * .. Local Arrays ..
80  REAL r( nmax ), r1( nmax ), r2( nmax )
81  COMPLEX a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
82  $ w( 2*nmax ), x( nmax )
83 * ..
84 * .. External Functions ..
85  LOGICAL lsamen
86  EXTERNAL lsamen
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL alaesm, chkxer, cpbcon, cpbequ, cpbrfs, cpbtf2,
92  $ cpptrf, cpptri, cpptrs
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 cmplx, real
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 ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
117  af( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
118  10 CONTINUE
119  b( j ) = 0.
120  r1( j ) = 0.
121  r2( j ) = 0.
122  w( j ) = 0.
123  x( j ) = 0.
124  20 CONTINUE
125  anrm = 1.
126  ok = .true.
127 *
128 * Test error exits of the routines that use the Cholesky
129 * decomposition of a Hermitian positive definite matrix.
130 *
131  IF( lsamen( 2, c2, 'PO' ) ) THEN
132 *
133 * CPOTRF
134 *
135  srnamt = 'CPOTRF'
136  infot = 1
137  CALL cpotrf( '/', 0, a, 1, info )
138  CALL chkxer( 'CPOTRF', infot, nout, lerr, ok )
139  infot = 2
140  CALL cpotrf( 'U', -1, a, 1, info )
141  CALL chkxer( 'CPOTRF', infot, nout, lerr, ok )
142  infot = 4
143  CALL cpotrf( 'U', 2, a, 1, info )
144  CALL chkxer( 'CPOTRF', infot, nout, lerr, ok )
145 *
146 * CPOTF2
147 *
148  srnamt = 'CPOTF2'
149  infot = 1
150  CALL cpotf2( '/', 0, a, 1, info )
151  CALL chkxer( 'CPOTF2', infot, nout, lerr, ok )
152  infot = 2
153  CALL cpotf2( 'U', -1, a, 1, info )
154  CALL chkxer( 'CPOTF2', infot, nout, lerr, ok )
155  infot = 4
156  CALL cpotf2( 'U', 2, a, 1, info )
157  CALL chkxer( 'CPOTF2', infot, nout, lerr, ok )
158 *
159 * CPOTRI
160 *
161  srnamt = 'CPOTRI'
162  infot = 1
163  CALL cpotri( '/', 0, a, 1, info )
164  CALL chkxer( 'CPOTRI', infot, nout, lerr, ok )
165  infot = 2
166  CALL cpotri( 'U', -1, a, 1, info )
167  CALL chkxer( 'CPOTRI', infot, nout, lerr, ok )
168  infot = 4
169  CALL cpotri( 'U', 2, a, 1, info )
170  CALL chkxer( 'CPOTRI', infot, nout, lerr, ok )
171 *
172 * CPOTRS
173 *
174  srnamt = 'CPOTRS'
175  infot = 1
176  CALL cpotrs( '/', 0, 0, a, 1, b, 1, info )
177  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
178  infot = 2
179  CALL cpotrs( 'U', -1, 0, a, 1, b, 1, info )
180  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
181  infot = 3
182  CALL cpotrs( 'U', 0, -1, a, 1, b, 1, info )
183  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
184  infot = 5
185  CALL cpotrs( 'U', 2, 1, a, 1, b, 2, info )
186  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
187  infot = 7
188  CALL cpotrs( 'U', 2, 1, a, 2, b, 1, info )
189  CALL chkxer( 'CPOTRS', infot, nout, lerr, ok )
190 *
191 * CPORFS
192 *
193  srnamt = 'CPORFS'
194  infot = 1
195  CALL cporfs( '/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
196  $ info )
197  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
198  infot = 2
199  CALL cporfs( 'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
200  $ info )
201  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
202  infot = 3
203  CALL cporfs( 'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
204  $ info )
205  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
206  infot = 5
207  CALL cporfs( 'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, r,
208  $ info )
209  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
210  infot = 7
211  CALL cporfs( 'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, r,
212  $ info )
213  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
214  infot = 9
215  CALL cporfs( 'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, r,
216  $ info )
217  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
218  infot = 11
219  CALL cporfs( 'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, r,
220  $ info )
221  CALL chkxer( 'CPORFS', infot, nout, lerr, ok )
222 *
223 * CPOCON
224 *
225  srnamt = 'CPOCON'
226  infot = 1
227  CALL cpocon( '/', 0, a, 1, anrm, rcond, w, r, info )
228  CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
229  infot = 2
230  CALL cpocon( 'U', -1, a, 1, anrm, rcond, w, r, info )
231  CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
232  infot = 4
233  CALL cpocon( 'U', 2, a, 1, anrm, rcond, w, r, info )
234  CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
235  infot = 5
236  CALL cpocon( 'U', 1, a, 1, -anrm, rcond, w, r, info )
237  CALL chkxer( 'CPOCON', infot, nout, lerr, ok )
238 *
239 * CPOEQU
240 *
241  srnamt = 'CPOEQU'
242  infot = 1
243  CALL cpoequ( -1, a, 1, r1, rcond, anrm, info )
244  CALL chkxer( 'CPOEQU', infot, nout, lerr, ok )
245  infot = 3
246  CALL cpoequ( 2, a, 1, r1, rcond, anrm, info )
247  CALL chkxer( 'CPOEQU', infot, nout, lerr, ok )
248 *
249 * Test error exits of the routines that use the Cholesky
250 * decomposition of a Hermitian positive definite packed matrix.
251 *
252  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
253 *
254 * CPPTRF
255 *
256  srnamt = 'CPPTRF'
257  infot = 1
258  CALL cpptrf( '/', 0, a, info )
259  CALL chkxer( 'CPPTRF', infot, nout, lerr, ok )
260  infot = 2
261  CALL cpptrf( 'U', -1, a, info )
262  CALL chkxer( 'CPPTRF', infot, nout, lerr, ok )
263 *
264 * CPPTRI
265 *
266  srnamt = 'CPPTRI'
267  infot = 1
268  CALL cpptri( '/', 0, a, info )
269  CALL chkxer( 'CPPTRI', infot, nout, lerr, ok )
270  infot = 2
271  CALL cpptri( 'U', -1, a, info )
272  CALL chkxer( 'CPPTRI', infot, nout, lerr, ok )
273 *
274 * CPPTRS
275 *
276  srnamt = 'CPPTRS'
277  infot = 1
278  CALL cpptrs( '/', 0, 0, a, b, 1, info )
279  CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
280  infot = 2
281  CALL cpptrs( 'U', -1, 0, a, b, 1, info )
282  CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
283  infot = 3
284  CALL cpptrs( 'U', 0, -1, a, b, 1, info )
285  CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
286  infot = 6
287  CALL cpptrs( 'U', 2, 1, a, b, 1, info )
288  CALL chkxer( 'CPPTRS', infot, nout, lerr, ok )
289 *
290 * CPPRFS
291 *
292  srnamt = 'CPPRFS'
293  infot = 1
294  CALL cpprfs( '/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, r, info )
295  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
296  infot = 2
297  CALL cpprfs( 'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, r,
298  $ info )
299  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
300  infot = 3
301  CALL cpprfs( 'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, r,
302  $ info )
303  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
304  infot = 7
305  CALL cpprfs( 'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, r, info )
306  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
307  infot = 9
308  CALL cpprfs( 'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, r, info )
309  CALL chkxer( 'CPPRFS', infot, nout, lerr, ok )
310 *
311 * CPPCON
312 *
313  srnamt = 'CPPCON'
314  infot = 1
315  CALL cppcon( '/', 0, a, anrm, rcond, w, r, info )
316  CALL chkxer( 'CPPCON', infot, nout, lerr, ok )
317  infot = 2
318  CALL cppcon( 'U', -1, a, anrm, rcond, w, r, info )
319  CALL chkxer( 'CPPCON', infot, nout, lerr, ok )
320  infot = 4
321  CALL cppcon( 'U', 1, a, -anrm, rcond, w, r, info )
322  CALL chkxer( 'CPPCON', infot, nout, lerr, ok )
323 *
324 * CPPEQU
325 *
326  srnamt = 'CPPEQU'
327  infot = 1
328  CALL cppequ( '/', 0, a, r1, rcond, anrm, info )
329  CALL chkxer( 'CPPEQU', infot, nout, lerr, ok )
330  infot = 2
331  CALL cppequ( 'U', -1, a, r1, rcond, anrm, info )
332  CALL chkxer( 'CPPEQU', infot, nout, lerr, ok )
333 *
334 * Test error exits of the routines that use the Cholesky
335 * decomposition of a Hermitian positive definite band matrix.
336 *
337  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
338 *
339 * CPBTRF
340 *
341  srnamt = 'CPBTRF'
342  infot = 1
343  CALL cpbtrf( '/', 0, 0, a, 1, info )
344  CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
345  infot = 2
346  CALL cpbtrf( 'U', -1, 0, a, 1, info )
347  CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
348  infot = 3
349  CALL cpbtrf( 'U', 1, -1, a, 1, info )
350  CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
351  infot = 5
352  CALL cpbtrf( 'U', 2, 1, a, 1, info )
353  CALL chkxer( 'CPBTRF', infot, nout, lerr, ok )
354 *
355 * CPBTF2
356 *
357  srnamt = 'CPBTF2'
358  infot = 1
359  CALL cpbtf2( '/', 0, 0, a, 1, info )
360  CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
361  infot = 2
362  CALL cpbtf2( 'U', -1, 0, a, 1, info )
363  CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
364  infot = 3
365  CALL cpbtf2( 'U', 1, -1, a, 1, info )
366  CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
367  infot = 5
368  CALL cpbtf2( 'U', 2, 1, a, 1, info )
369  CALL chkxer( 'CPBTF2', infot, nout, lerr, ok )
370 *
371 * CPBTRS
372 *
373  srnamt = 'CPBTRS'
374  infot = 1
375  CALL cpbtrs( '/', 0, 0, 0, a, 1, b, 1, info )
376  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
377  infot = 2
378  CALL cpbtrs( 'U', -1, 0, 0, a, 1, b, 1, info )
379  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
380  infot = 3
381  CALL cpbtrs( 'U', 1, -1, 0, a, 1, b, 1, info )
382  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
383  infot = 4
384  CALL cpbtrs( 'U', 0, 0, -1, a, 1, b, 1, info )
385  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
386  infot = 6
387  CALL cpbtrs( 'U', 2, 1, 1, a, 1, b, 1, info )
388  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
389  infot = 8
390  CALL cpbtrs( 'U', 2, 0, 1, a, 1, b, 1, info )
391  CALL chkxer( 'CPBTRS', infot, nout, lerr, ok )
392 *
393 * CPBRFS
394 *
395  srnamt = 'CPBRFS'
396  infot = 1
397  CALL cpbrfs( '/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
398  $ r, info )
399  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
400  infot = 2
401  CALL cpbrfs( 'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
402  $ r, info )
403  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
404  infot = 3
405  CALL cpbrfs( 'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
406  $ r, info )
407  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
408  infot = 4
409  CALL cpbrfs( 'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
410  $ r, info )
411  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
412  infot = 6
413  CALL cpbrfs( 'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
414  $ r, info )
415  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
416  infot = 8
417  CALL cpbrfs( 'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
418  $ r, info )
419  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
420  infot = 10
421  CALL cpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
422  $ r, info )
423  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
424  infot = 12
425  CALL cpbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
426  $ r, info )
427  CALL chkxer( 'CPBRFS', infot, nout, lerr, ok )
428 *
429 * CPBCON
430 *
431  srnamt = 'CPBCON'
432  infot = 1
433  CALL cpbcon( '/', 0, 0, a, 1, anrm, rcond, w, r, info )
434  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
435  infot = 2
436  CALL cpbcon( 'U', -1, 0, a, 1, anrm, rcond, w, r, info )
437  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
438  infot = 3
439  CALL cpbcon( 'U', 1, -1, a, 1, anrm, rcond, w, r, info )
440  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
441  infot = 5
442  CALL cpbcon( 'U', 2, 1, a, 1, anrm, rcond, w, r, info )
443  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
444  infot = 6
445  CALL cpbcon( 'U', 1, 0, a, 1, -anrm, rcond, w, r, info )
446  CALL chkxer( 'CPBCON', infot, nout, lerr, ok )
447 *
448 * CPBEQU
449 *
450  srnamt = 'CPBEQU'
451  infot = 1
452  CALL cpbequ( '/', 0, 0, a, 1, r1, rcond, anrm, info )
453  CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
454  infot = 2
455  CALL cpbequ( 'U', -1, 0, a, 1, r1, rcond, anrm, info )
456  CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
457  infot = 3
458  CALL cpbequ( 'U', 1, -1, a, 1, r1, rcond, anrm, info )
459  CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
460  infot = 5
461  CALL cpbequ( 'U', 2, 1, a, 1, r1, rcond, anrm, info )
462  CALL chkxer( 'CPBEQU', infot, nout, lerr, ok )
463  END IF
464 *
465 * Print a summary line.
466 *
467  CALL alaesm( path, ok, nout )
468 *
469  RETURN
470 *
471 * End of CERRPO
472 *
subroutine cpotri(UPLO, N, A, LDA, INFO)
CPOTRI
Definition: cpotri.f:97
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:144
subroutine cpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
CPBTRS
Definition: cpbtrs.f:123
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
subroutine cpbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPBRFS
Definition: cpbrfs.f:191
subroutine cppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
CPPEQU
Definition: cppequ.f:119
subroutine cporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPORFS
Definition: cporfs.f:185
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS
Definition: cpotrs.f:112
subroutine cpptri(UPLO, N, AP, INFO)
CPPTRI
Definition: cpptri.f:95
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine cpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
CPBEQU
Definition: cpbequ.f:132
subroutine cppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
CPPCON
Definition: cppcon.f:120
subroutine cpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CPOCON
Definition: cpocon.f:123
subroutine cpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
CPOEQU
Definition: cpoequ.f:115
subroutine cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
Definition: cpotrf.f:109
subroutine cpotf2(UPLO, N, A, LDA, INFO)
CPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition: cpotf2.f:111
subroutine cpbtrf(UPLO, N, KD, AB, LDAB, INFO)
CPBTRF
Definition: cpbtrf.f:144
subroutine cpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, RWORK, INFO)
CPBCON
Definition: cpbcon.f:135
subroutine cpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
CPPTRS
Definition: cpptrs.f:110
subroutine cpptrf(UPLO, N, AP, INFO)
CPPTRF
Definition: cpptrf.f:121
subroutine cpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPPRFS
Definition: cpprfs.f:173
Here is the call graph for this function:
Here is the caller graph for this function: