LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cerrps.f
Go to the documentation of this file.
1 *> \brief \b CERRPS
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 CERRPS( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NUNIT
15 * CHARACTER*3 PATH
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> CERRPS tests the error exits for the COMPLEX routines
25 *> for CPSTRF..
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 November 2011
52 *
53 *> \ingroup complex_lin
54 *
55 * =====================================================================
56  SUBROUTINE cerrps( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.4.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 * November 2011
62 *
63 * .. Scalar Arguments ..
64  INTEGER nunit
65  CHARACTER*3 path
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER nmax
72  parameter( nmax = 4 )
73 * ..
74 * .. Local Scalars ..
75  INTEGER i, info, j, rank
76 * ..
77 * .. Local Arrays ..
78  COMPLEX a( nmax, nmax )
79  REAL rwork( 2*nmax )
80  INTEGER piv( nmax )
81 * ..
82 * .. External Subroutines ..
83  EXTERNAL alaesm, chkxer, cpstf2, cpstrf
84 * ..
85 * .. Scalars in Common ..
86  INTEGER infot, nout
87  LOGICAL lerr, ok
88  CHARACTER*32 srnamt
89 * ..
90 * .. Common blocks ..
91  common / infoc / infot, nout, ok, lerr
92  common / srnamc / srnamt
93 * ..
94 * .. Intrinsic Functions ..
95  INTRINSIC real
96 * ..
97 * .. Executable Statements ..
98 *
99  nout = nunit
100  WRITE( nout, fmt = * )
101 *
102 * Set the variables to innocuous values.
103 *
104  DO 110 j = 1, nmax
105  DO 100 i = 1, nmax
106  a( i, j ) = 1.0 / REAL( i+j )
107 *
108  100 continue
109  piv( j ) = j
110  rwork( j ) = 0.
111  rwork( nmax+j ) = 0.
112 *
113  110 continue
114  ok = .true.
115 *
116 *
117 * Test error exits of the routines that use the Cholesky
118 * decomposition of an Hermitian positive semidefinite matrix.
119 *
120 * CPSTRF
121 *
122  srnamt = 'CPSTRF'
123  infot = 1
124  CALL cpstrf( '/', 0, a, 1, piv, rank, -1.0, rwork, info )
125  CALL chkxer( 'CPSTRF', infot, nout, lerr, ok )
126  infot = 2
127  CALL cpstrf( 'U', -1, a, 1, piv, rank, -1.0, rwork, info )
128  CALL chkxer( 'CPSTRF', infot, nout, lerr, ok )
129  infot = 4
130  CALL cpstrf( 'U', 2, a, 1, piv, rank, -1.0, rwork, info )
131  CALL chkxer( 'CPSTRF', infot, nout, lerr, ok )
132 *
133 * CPSTF2
134 *
135  srnamt = 'CPSTF2'
136  infot = 1
137  CALL cpstf2( '/', 0, a, 1, piv, rank, -1.0, rwork, info )
138  CALL chkxer( 'CPSTF2', infot, nout, lerr, ok )
139  infot = 2
140  CALL cpstf2( 'U', -1, a, 1, piv, rank, -1.0, rwork, info )
141  CALL chkxer( 'CPSTF2', infot, nout, lerr, ok )
142  infot = 4
143  CALL cpstf2( 'U', 2, a, 1, piv, rank, -1.0, rwork, info )
144  CALL chkxer( 'CPSTF2', infot, nout, lerr, ok )
145 *
146 *
147 * Print a summary line.
148 *
149  CALL alaesm( path, ok, nout )
150 *
151  return
152 *
153 * End of CERRPS
154 *
155  END