LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cerrrfp.f
Go to the documentation of this file.
1 *> \brief \b CERRRFP
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 CERRRFP( NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NUNIT
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> CERRRFP tests the error exits for the COMPLEX driver routines
24 *> for solving linear systems of equations.
25 *>
26 *> CDRVRFP tests the COMPLEX LAPACK RFP routines:
27 *> CTFSM, CTFTRI, CHFRK, CTFTTP, CTFTTR, CPFTRF, CPFTRS, CTPTTF,
28 *> CTPTTR, CTRTTF, and CTRTTP
29 *> \endverbatim
30 *
31 * Arguments:
32 * ==========
33 *
34 *> \param[in] NUNIT
35 *> \verbatim
36 *> NUNIT is INTEGER
37 *> The unit number for output.
38 *> \endverbatim
39 *
40 * Authors:
41 * ========
42 *
43 *> \author Univ. of Tennessee
44 *> \author Univ. of California Berkeley
45 *> \author Univ. of Colorado Denver
46 *> \author NAG Ltd.
47 *
48 *> \date November 2011
49 *
50 *> \ingroup complex_lin
51 *
52 * =====================================================================
53  SUBROUTINE cerrrfp( NUNIT )
54 *
55 * -- LAPACK test routine (version 3.4.0) --
56 * -- LAPACK is a software package provided by Univ. of Tennessee, --
57 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
58 * November 2011
59 *
60 * .. Scalar Arguments ..
61  INTEGER nunit
62 * ..
63 *
64 * =====================================================================
65 *
66 * ..
67 * .. Local Scalars ..
68  INTEGER info
69  COMPLEX alpha, beta
70 * ..
71 * .. Local Arrays ..
72  COMPLEX a( 1, 1), b( 1, 1)
73 * ..
74 * .. External Subroutines ..
75  EXTERNAL chkxer, ctfsm, ctftri, chfrk, ctfttp, ctfttr,
76  + cpftri, cpftrf, cpftrs, ctpttf, ctpttr, ctrttf,
77  + ctrttp
78 * ..
79 * .. Scalars in Common ..
80  LOGICAL lerr, ok
81  CHARACTER*32 srnamt
82  INTEGER infot, nout
83 * ..
84 * .. Intrinsic Functions ..
85  INTRINSIC cmplx
86 * ..
87 * .. Common blocks ..
88  common / infoc / infot, nout, ok, lerr
89  common / srnamc / srnamt
90 * ..
91 * .. Executable Statements ..
92 *
93  nout = nunit
94  ok = .true.
95  a( 1, 1 ) = cmplx( 1.d0 , 1.d0 )
96  b( 1, 1 ) = cmplx( 1.d0 , 1.d0 )
97  alpha = cmplx( 1.d0 , 1.d0 )
98  beta = cmplx( 1.d0 , 1.d0 )
99 *
100  srnamt = 'CPFTRF'
101  infot = 1
102  CALL cpftrf( '/', 'U', 0, a, info )
103  CALL chkxer( 'CPFTRF', infot, nout, lerr, ok )
104  infot = 2
105  CALL cpftrf( 'N', '/', 0, a, info )
106  CALL chkxer( 'CPFTRF', infot, nout, lerr, ok )
107  infot = 3
108  CALL cpftrf( 'N', 'U', -1, a, info )
109  CALL chkxer( 'CPFTRF', infot, nout, lerr, ok )
110 *
111  srnamt = 'CPFTRS'
112  infot = 1
113  CALL cpftrs( '/', 'U', 0, 0, a, b, 1, info )
114  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
115  infot = 2
116  CALL cpftrs( 'N', '/', 0, 0, a, b, 1, info )
117  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
118  infot = 3
119  CALL cpftrs( 'N', 'U', -1, 0, a, b, 1, info )
120  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
121  infot = 4
122  CALL cpftrs( 'N', 'U', 0, -1, a, b, 1, info )
123  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
124  infot = 7
125  CALL cpftrs( 'N', 'U', 0, 0, a, b, 0, info )
126  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
127 *
128  srnamt = 'CPFTRI'
129  infot = 1
130  CALL cpftri( '/', 'U', 0, a, info )
131  CALL chkxer( 'CPFTRI', infot, nout, lerr, ok )
132  infot = 2
133  CALL cpftri( 'N', '/', 0, a, info )
134  CALL chkxer( 'CPFTRI', infot, nout, lerr, ok )
135  infot = 3
136  CALL cpftri( 'N', 'U', -1, a, info )
137  CALL chkxer( 'CPFTRI', infot, nout, lerr, ok )
138 *
139  srnamt = 'CTFSM '
140  infot = 1
141  CALL ctfsm( '/', 'L', 'U', 'C', 'U', 0, 0, alpha, a, b, 1 )
142  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
143  infot = 2
144  CALL ctfsm( 'N', '/', 'U', 'C', 'U', 0, 0, alpha, a, b, 1 )
145  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
146  infot = 3
147  CALL ctfsm( 'N', 'L', '/', 'C', 'U', 0, 0, alpha, a, b, 1 )
148  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
149  infot = 4
150  CALL ctfsm( 'N', 'L', 'U', '/', 'U', 0, 0, alpha, a, b, 1 )
151  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
152  infot = 5
153  CALL ctfsm( 'N', 'L', 'U', 'C', '/', 0, 0, alpha, a, b, 1 )
154  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
155  infot = 6
156  CALL ctfsm( 'N', 'L', 'U', 'C', 'U', -1, 0, alpha, a, b, 1 )
157  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
158  infot = 7
159  CALL ctfsm( 'N', 'L', 'U', 'C', 'U', 0, -1, alpha, a, b, 1 )
160  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
161  infot = 11
162  CALL ctfsm( 'N', 'L', 'U', 'C', 'U', 0, 0, alpha, a, b, 0 )
163  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
164 *
165  srnamt = 'CTFTRI'
166  infot = 1
167  CALL ctftri( '/', 'L', 'N', 0, a, info )
168  CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
169  infot = 2
170  CALL ctftri( 'N', '/', 'N', 0, a, info )
171  CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
172  infot = 3
173  CALL ctftri( 'N', 'L', '/', 0, a, info )
174  CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
175  infot = 4
176  CALL ctftri( 'N', 'L', 'N', -1, a, info )
177  CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
178 *
179  srnamt = 'CTFTTR'
180  infot = 1
181  CALL ctfttr( '/', 'U', 0, a, b, 1, info )
182  CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
183  infot = 2
184  CALL ctfttr( 'N', '/', 0, a, b, 1, info )
185  CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
186  infot = 3
187  CALL ctfttr( 'N', 'U', -1, a, b, 1, info )
188  CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
189  infot = 6
190  CALL ctfttr( 'N', 'U', 0, a, b, 0, info )
191  CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
192 *
193  srnamt = 'CTRTTF'
194  infot = 1
195  CALL ctrttf( '/', 'U', 0, a, 1, b, info )
196  CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
197  infot = 2
198  CALL ctrttf( 'N', '/', 0, a, 1, b, info )
199  CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
200  infot = 3
201  CALL ctrttf( 'N', 'U', -1, a, 1, b, info )
202  CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
203  infot = 5
204  CALL ctrttf( 'N', 'U', 0, a, 0, b, info )
205  CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
206 *
207  srnamt = 'CTFTTP'
208  infot = 1
209  CALL ctfttp( '/', 'U', 0, a, b, info )
210  CALL chkxer( 'CTFTTP', infot, nout, lerr, ok )
211  infot = 2
212  CALL ctfttp( 'N', '/', 0, a, b, info )
213  CALL chkxer( 'CTFTTP', infot, nout, lerr, ok )
214  infot = 3
215  CALL ctfttp( 'N', 'U', -1, a, b, info )
216  CALL chkxer( 'CTFTTP', infot, nout, lerr, ok )
217 *
218  srnamt = 'CTPTTF'
219  infot = 1
220  CALL ctpttf( '/', 'U', 0, a, b, info )
221  CALL chkxer( 'CTPTTF', infot, nout, lerr, ok )
222  infot = 2
223  CALL ctpttf( 'N', '/', 0, a, b, info )
224  CALL chkxer( 'CTPTTF', infot, nout, lerr, ok )
225  infot = 3
226  CALL ctpttf( 'N', 'U', -1, a, b, info )
227  CALL chkxer( 'CTPTTF', infot, nout, lerr, ok )
228 *
229  srnamt = 'CTRTTP'
230  infot = 1
231  CALL ctrttp( '/', 0, a, 1, b, info )
232  CALL chkxer( 'CTRTTP', infot, nout, lerr, ok )
233  infot = 2
234  CALL ctrttp( 'U', -1, a, 1, b, info )
235  CALL chkxer( 'CTRTTP', infot, nout, lerr, ok )
236  infot = 4
237  CALL ctrttp( 'U', 0, a, 0, b, info )
238  CALL chkxer( 'CTRTTP', infot, nout, lerr, ok )
239 *
240  srnamt = 'CTPTTR'
241  infot = 1
242  CALL ctpttr( '/', 0, a, b, 1, info )
243  CALL chkxer( 'CTPTTR', infot, nout, lerr, ok )
244  infot = 2
245  CALL ctpttr( 'U', -1, a, b, 1, info )
246  CALL chkxer( 'CTPTTR', infot, nout, lerr, ok )
247  infot = 5
248  CALL ctpttr( 'U', 0, a, b, 0, info )
249  CALL chkxer( 'CTPTTR', infot, nout, lerr, ok )
250 *
251  srnamt = 'CHFRK '
252  infot = 1
253  CALL chfrk( '/', 'U', 'N', 0, 0, alpha, a, 1, beta, b )
254  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
255  infot = 2
256  CALL chfrk( 'N', '/', 'N', 0, 0, alpha, a, 1, beta, b )
257  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
258  infot = 3
259  CALL chfrk( 'N', 'U', '/', 0, 0, alpha, a, 1, beta, b )
260  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
261  infot = 4
262  CALL chfrk( 'N', 'U', 'N', -1, 0, alpha, a, 1, beta, b )
263  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
264  infot = 5
265  CALL chfrk( 'N', 'U', 'N', 0, -1, alpha, a, 1, beta, b )
266  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
267  infot = 8
268  CALL chfrk( 'N', 'U', 'N', 0, 0, alpha, a, 0, beta, b )
269  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
270 *
271 * Print a summary line.
272 *
273  IF( ok ) THEN
274  WRITE( nout, fmt = 9999 )
275  ELSE
276  WRITE( nout, fmt = 9998 )
277  END IF
278 *
279  9999 format( 1x, 'COMPLEX RFP routines passed the tests of the ',
280  $ 'error exits' )
281  9998 format( ' *** RFP routines failed the tests of the error ',
282  $ 'exits ***' )
283  return
284 *
285 * End of CERRRFP
286 *
287  END