PLASMA  2.4.5
PLASMA - Parallel Linear Algebra for Scalable Multi-core Architectures
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
cerrpo.f
Go to the documentation of this file.
1  SUBROUTINE cerrpo( PATH, NUNIT )
2 *
3  include 'plasmaf.h'
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10  CHARACTER*3 path
11  INTEGER nunit
12 * ..
13 *
14 * Purpose
15 * =======
16 *
17 * CERRPO tests the error exits for the COMPLEX routines
18 * for Hermitian positive definite matrices.
19 *
20 * Arguments
21 * =========
22 *
23 * PATH (input) CHARACTER*3
24 * The LAPACK path name for the routines to be tested.
25 *
26 * NUNIT (input) INTEGER
27 * The unit number for output.
28 *
29 * =====================================================================
30 *
31 * .. Parameters ..
32  INTEGER nmax
33  parameter( nmax = 4 )
34 * ..
35 * .. Local Scalars ..
36  CHARACTER*2 c2
37  INTEGER i, info, j
38  REAL anrm, rcond
39 * ..
40 * .. Local Arrays ..
41  REAL r( nmax ), r1( nmax ), r2( nmax )
42  COMPLEX a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
43  $ w( 2*nmax ), x( nmax )
44 * ..
45 * .. External Functions ..
46  LOGICAL lsamen
47  EXTERNAL lsamen
48 * ..
49 * .. External Subroutines ..
50  EXTERNAL alaesm, chkxer, cpbcon, cpbequ, cpbrfs, cpbtf2,
51  $ cpbtrf, cpbtrs, cpocon, cpoequ, cporfs, cpotf2,
52  $ cpotrf, cpotri, cpotrs, cppcon, cppequ, cpprfs,
53  $ cpptrf, cpptri, cpptrs
54 * ..
55 * .. Scalars in Common ..
56  LOGICAL lerr, ok
57  CHARACTER*32 srnamt
58  INTEGER infot, nout
59 * ..
60 * .. Common blocks ..
61  common / infoc / infot, nout, ok, lerr
62  common / srnamc / srnamt
63 * ..
64 * .. Intrinsic Functions ..
65  INTRINSIC cmplx, real
66 * ..
67 * .. Executable Statements ..
68 *
69  nout = nunit
70  WRITE( nout, fmt = * )
71  c2 = path( 2: 3 )
72 *
73 * Disable PLASMA warnings/errors
74 *
75  CALL plasma_disable( plasma_warnings, info )
76  CALL plasma_disable( plasma_errors, info )
77 *
78 * Set the variables to innocuous values.
79 *
80  DO 20 j = 1, nmax
81  DO 10 i = 1, nmax
82  a( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
83  af( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
84  10 continue
85  b( j ) = 0.
86  r1( j ) = 0.
87  r2( j ) = 0.
88  w( j ) = 0.
89  x( j ) = 0.
90  20 continue
91  anrm = 1.
92  ok = .true.
93 *
94 * Test error exits of the routines that use the Cholesky
95 * decomposition of a Hermitian positive definite matrix.
96 *
97  IF( lsamen( 2, c2, 'PO' ) ) THEN
98 *
99 * CPOTRF
100 *
101  srnamt = 'CPOTRF'
102  infot = 1
103  CALL plasma_cpotrf( '/', 0, a, 1, info )
104  CALL chkxer( 'CPOTRF', infot, nout, info, ok )
105  infot = 2
106  CALL plasma_cpotrf( plasmaupper, -1, a, 1, info )
107  CALL chkxer( 'CPOTRF', infot, nout, info, ok )
108  infot = 4
109  CALL plasma_cpotrf( plasmaupper, 2, a, 1, info )
110  CALL chkxer( 'CPOTRF', infot, nout, info, ok )
111 *
112 * CPOTRS
113 *
114  srnamt = 'CPOTRS'
115  infot = 1
116  CALL plasma_cpotrs( '/', 0, 0, a, 1, b, 1, info )
117  CALL chkxer( 'CPOTRS', infot, nout, info, ok )
118  infot = 2
119  CALL plasma_cpotrs( plasmaupper, -1, 0, a, 1, b, 1, info )
120  CALL chkxer( 'CPOTRS', infot, nout, info, ok )
121  infot = 3
122  CALL plasma_cpotrs( plasmaupper, 0, -1, a, 1, b, 1, info )
123  CALL chkxer( 'CPOTRS', infot, nout, info, ok )
124  infot = 5
125  CALL plasma_cpotrs( plasmaupper, 2, 1, a, 1, b, 2, info )
126  CALL chkxer( 'CPOTRS', infot, nout, info, ok )
127  infot = 7
128  CALL plasma_cpotrs( plasmaupper, 2, 1, a, 2, b, 1, info )
129  END IF
130 *
131 * Print a summary line.
132 *
133  CALL alaesm( path, ok, nout )
134 *
135 * Enable PLASMA warnings/errors
136 *
137  CALL plasma_enable( plasma_warnings, info )
138  CALL plasma_enable( plasma_errors, info )
139 *
140  return
141 *
142 * End of CERRPO
143 *
144  END