LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zerrrfp.f
Go to the documentation of this file.
1 *> \brief \b ZERRRFP
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 ZERRRFP( NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NUNIT
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> ZERRRFP tests the error exits for the COMPLEX*16 driver routines
24 *> for solving linear systems of equations.
25 *>
26 *> ZDRVRFP tests the COMPLEX*16 LAPACK RFP routines:
27 *> ZTFSM, ZTFTRI, ZHFRK, ZTFTTP, ZTFTTR, ZPFTRF, ZPFTRS, ZTPTTF,
28 *> ZTPTTR, ZTRTTF, and ZTRTTP
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 complex16_lin
51 *
52 * =====================================================================
53  SUBROUTINE zerrrfp( 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  DOUBLE PRECISION alpha, beta
70  COMPLEX*16 calpha
71 * ..
72 * .. Local Arrays ..
73  COMPLEX*16 a( 1, 1), b( 1, 1)
74 * ..
75 * .. External Subroutines ..
76  EXTERNAL chkxer, ztfsm, ztftri, zhfrk, ztfttp, ztfttr,
77  + zpftri, zpftrf, zpftrs, ztpttf, ztpttr, ztrttf,
78  + ztrttp
79 * ..
80 * .. Scalars in Common ..
81  LOGICAL lerr, ok
82  CHARACTER*32 srnamt
83  INTEGER infot, nout
84 * ..
85 * .. Intrinsic Functions ..
86  INTRINSIC dcmplx
87 * ..
88 * .. Common blocks ..
89  common / infoc / infot, nout, ok, lerr
90  common / srnamc / srnamt
91 * ..
92 * .. Executable Statements ..
93 *
94  nout = nunit
95  ok = .true.
96  a( 1, 1 ) = dcmplx( 1.0d0 , 1.0d0 )
97  b( 1, 1 ) = dcmplx( 1.0d0 , 1.0d0 )
98  alpha = 1.0d0
99  calpha = dcmplx( 1.0d0 , 1.0d0 )
100  beta = 1.0d0
101 *
102  srnamt = 'ZPFTRF'
103  infot = 1
104  CALL zpftrf( '/', 'U', 0, a, info )
105  CALL chkxer( 'ZPFTRF', infot, nout, lerr, ok )
106  infot = 2
107  CALL zpftrf( 'N', '/', 0, a, info )
108  CALL chkxer( 'ZPFTRF', infot, nout, lerr, ok )
109  infot = 3
110  CALL zpftrf( 'N', 'U', -1, a, info )
111  CALL chkxer( 'ZPFTRF', infot, nout, lerr, ok )
112 *
113  srnamt = 'ZPFTRS'
114  infot = 1
115  CALL zpftrs( '/', 'U', 0, 0, a, b, 1, info )
116  CALL chkxer( 'ZPFTRS', infot, nout, lerr, ok )
117  infot = 2
118  CALL zpftrs( 'N', '/', 0, 0, a, b, 1, info )
119  CALL chkxer( 'ZPFTRS', infot, nout, lerr, ok )
120  infot = 3
121  CALL zpftrs( 'N', 'U', -1, 0, a, b, 1, info )
122  CALL chkxer( 'ZPFTRS', infot, nout, lerr, ok )
123  infot = 4
124  CALL zpftrs( 'N', 'U', 0, -1, a, b, 1, info )
125  CALL chkxer( 'ZPFTRS', infot, nout, lerr, ok )
126  infot = 7
127  CALL zpftrs( 'N', 'U', 0, 0, a, b, 0, info )
128  CALL chkxer( 'ZPFTRS', infot, nout, lerr, ok )
129 *
130  srnamt = 'ZPFTRI'
131  infot = 1
132  CALL zpftri( '/', 'U', 0, a, info )
133  CALL chkxer( 'ZPFTRI', infot, nout, lerr, ok )
134  infot = 2
135  CALL zpftri( 'N', '/', 0, a, info )
136  CALL chkxer( 'ZPFTRI', infot, nout, lerr, ok )
137  infot = 3
138  CALL zpftri( 'N', 'U', -1, a, info )
139  CALL chkxer( 'ZPFTRI', infot, nout, lerr, ok )
140 *
141  srnamt = 'ZTFSM '
142  infot = 1
143  CALL ztfsm( '/', 'L', 'U', 'C', 'U', 0, 0, calpha, a, b, 1 )
144  CALL chkxer( 'ZTFSM ', infot, nout, lerr, ok )
145  infot = 2
146  CALL ztfsm( 'N', '/', 'U', 'C', 'U', 0, 0, calpha, a, b, 1 )
147  CALL chkxer( 'ZTFSM ', infot, nout, lerr, ok )
148  infot = 3
149  CALL ztfsm( 'N', 'L', '/', 'C', 'U', 0, 0, calpha, a, b, 1 )
150  CALL chkxer( 'ZTFSM ', infot, nout, lerr, ok )
151  infot = 4
152  CALL ztfsm( 'N', 'L', 'U', '/', 'U', 0, 0, calpha, a, b, 1 )
153  CALL chkxer( 'ZTFSM ', infot, nout, lerr, ok )
154  infot = 5
155  CALL ztfsm( 'N', 'L', 'U', 'C', '/', 0, 0, calpha, a, b, 1 )
156  CALL chkxer( 'ZTFSM ', infot, nout, lerr, ok )
157  infot = 6
158  CALL ztfsm( 'N', 'L', 'U', 'C', 'U', -1, 0, calpha, a, b, 1 )
159  CALL chkxer( 'ZTFSM ', infot, nout, lerr, ok )
160  infot = 7
161  CALL ztfsm( 'N', 'L', 'U', 'C', 'U', 0, -1, calpha, a, b, 1 )
162  CALL chkxer( 'ZTFSM ', infot, nout, lerr, ok )
163  infot = 11
164  CALL ztfsm( 'N', 'L', 'U', 'C', 'U', 0, 0, calpha, a, b, 0 )
165  CALL chkxer( 'ZTFSM ', infot, nout, lerr, ok )
166 *
167  srnamt = 'ZTFTRI'
168  infot = 1
169  CALL ztftri( '/', 'L', 'N', 0, a, info )
170  CALL chkxer( 'ZTFTRI', infot, nout, lerr, ok )
171  infot = 2
172  CALL ztftri( 'N', '/', 'N', 0, a, info )
173  CALL chkxer( 'ZTFTRI', infot, nout, lerr, ok )
174  infot = 3
175  CALL ztftri( 'N', 'L', '/', 0, a, info )
176  CALL chkxer( 'ZTFTRI', infot, nout, lerr, ok )
177  infot = 4
178  CALL ztftri( 'N', 'L', 'N', -1, a, info )
179  CALL chkxer( 'ZTFTRI', infot, nout, lerr, ok )
180 *
181  srnamt = 'ZTFTTR'
182  infot = 1
183  CALL ztfttr( '/', 'U', 0, a, b, 1, info )
184  CALL chkxer( 'ZTFTTR', infot, nout, lerr, ok )
185  infot = 2
186  CALL ztfttr( 'N', '/', 0, a, b, 1, info )
187  CALL chkxer( 'ZTFTTR', infot, nout, lerr, ok )
188  infot = 3
189  CALL ztfttr( 'N', 'U', -1, a, b, 1, info )
190  CALL chkxer( 'ZTFTTR', infot, nout, lerr, ok )
191  infot = 6
192  CALL ztfttr( 'N', 'U', 0, a, b, 0, info )
193  CALL chkxer( 'ZTFTTR', infot, nout, lerr, ok )
194 *
195  srnamt = 'ZTRTTF'
196  infot = 1
197  CALL ztrttf( '/', 'U', 0, a, 1, b, info )
198  CALL chkxer( 'ZTRTTF', infot, nout, lerr, ok )
199  infot = 2
200  CALL ztrttf( 'N', '/', 0, a, 1, b, info )
201  CALL chkxer( 'ZTRTTF', infot, nout, lerr, ok )
202  infot = 3
203  CALL ztrttf( 'N', 'U', -1, a, 1, b, info )
204  CALL chkxer( 'ZTRTTF', infot, nout, lerr, ok )
205  infot = 5
206  CALL ztrttf( 'N', 'U', 0, a, 0, b, info )
207  CALL chkxer( 'ZTRTTF', infot, nout, lerr, ok )
208 *
209  srnamt = 'ZTFTTP'
210  infot = 1
211  CALL ztfttp( '/', 'U', 0, a, b, info )
212  CALL chkxer( 'ZTFTTP', infot, nout, lerr, ok )
213  infot = 2
214  CALL ztfttp( 'N', '/', 0, a, b, info )
215  CALL chkxer( 'ZTFTTP', infot, nout, lerr, ok )
216  infot = 3
217  CALL ztfttp( 'N', 'U', -1, a, b, info )
218  CALL chkxer( 'ZTFTTP', infot, nout, lerr, ok )
219 *
220  srnamt = 'ZTPTTF'
221  infot = 1
222  CALL ztpttf( '/', 'U', 0, a, b, info )
223  CALL chkxer( 'ZTPTTF', infot, nout, lerr, ok )
224  infot = 2
225  CALL ztpttf( 'N', '/', 0, a, b, info )
226  CALL chkxer( 'ZTPTTF', infot, nout, lerr, ok )
227  infot = 3
228  CALL ztpttf( 'N', 'U', -1, a, b, info )
229  CALL chkxer( 'ZTPTTF', infot, nout, lerr, ok )
230 *
231  srnamt = 'ZTRTTP'
232  infot = 1
233  CALL ztrttp( '/', 0, a, 1, b, info )
234  CALL chkxer( 'ZTRTTP', infot, nout, lerr, ok )
235  infot = 2
236  CALL ztrttp( 'U', -1, a, 1, b, info )
237  CALL chkxer( 'ZTRTTP', infot, nout, lerr, ok )
238  infot = 4
239  CALL ztrttp( 'U', 0, a, 0, b, info )
240  CALL chkxer( 'ZTRTTP', infot, nout, lerr, ok )
241 *
242  srnamt = 'ZTPTTR'
243  infot = 1
244  CALL ztpttr( '/', 0, a, b, 1, info )
245  CALL chkxer( 'ZTPTTR', infot, nout, lerr, ok )
246  infot = 2
247  CALL ztpttr( 'U', -1, a, b, 1, info )
248  CALL chkxer( 'ZTPTTR', infot, nout, lerr, ok )
249  infot = 5
250  CALL ztpttr( 'U', 0, a, b, 0, info )
251  CALL chkxer( 'ZTPTTR', infot, nout, lerr, ok )
252 *
253  srnamt = 'ZHFRK '
254  infot = 1
255  CALL zhfrk( '/', 'U', 'N', 0, 0, alpha, a, 1, beta, b )
256  CALL chkxer( 'ZHFRK ', infot, nout, lerr, ok )
257  infot = 2
258  CALL zhfrk( 'N', '/', 'N', 0, 0, alpha, a, 1, beta, b )
259  CALL chkxer( 'ZHFRK ', infot, nout, lerr, ok )
260  infot = 3
261  CALL zhfrk( 'N', 'U', '/', 0, 0, alpha, a, 1, beta, b )
262  CALL chkxer( 'ZHFRK ', infot, nout, lerr, ok )
263  infot = 4
264  CALL zhfrk( 'N', 'U', 'N', -1, 0, alpha, a, 1, beta, b )
265  CALL chkxer( 'ZHFRK ', infot, nout, lerr, ok )
266  infot = 5
267  CALL zhfrk( 'N', 'U', 'N', 0, -1, alpha, a, 1, beta, b )
268  CALL chkxer( 'ZHFRK ', infot, nout, lerr, ok )
269  infot = 8
270  CALL zhfrk( 'N', 'U', 'N', 0, 0, alpha, a, 0, beta, b )
271  CALL chkxer( 'ZHFRK ', infot, nout, lerr, ok )
272 *
273 * Print a summary line.
274 *
275  IF( ok ) THEN
276  WRITE( nout, fmt = 9999 )
277  ELSE
278  WRITE( nout, fmt = 9998 )
279  END IF
280 *
281  9999 format( 1x, 'COMPLEX*16 RFP routines passed the tests of the ',
282  $ 'error exits' )
283  9998 format( ' *** RFP routines failed the tests of the error ',
284  $ 'exits ***' )
285  return
286 *
287 * End of ZERRRFP
288 *
289  END