LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zerrge.f
Go to the documentation of this file.
1 *> \brief \b ZERRGE
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 ZERRGE( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> ZERRGE tests the error exits for the COMPLEX*16 routines
25 *> for general matrices.
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 complex16_lin
54 *
55 * =====================================================================
56  SUBROUTINE zerrge( 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  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  DOUBLE PRECISION anrm, ccond, rcond
78 * ..
79 * .. Local Arrays ..
80  INTEGER ip( nmax )
81  DOUBLE PRECISION r( nmax ), r1( nmax ), r2( nmax )
82  COMPLEX*16 a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
83  $ w( 2*nmax ), x( nmax )
84 * ..
85 * .. External Functions ..
86  LOGICAL lsamen
87  EXTERNAL lsamen
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL alaesm, chkxer, zgbcon, zgbequ, zgbrfs, zgbtf2,
91  $ zgbtrf, zgbtrs, zgecon, zgeequ, zgerfs, zgetf2,
92  $ zgetrf, zgetri, zgetrs
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 dble, dcmplx
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 ) = dcmplx( 1.d0 / dble( i+j ),
117  $ -1.d0 / dble( i+j ) )
118  af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
119  $ -1.d0 / dble( i+j ) )
120  10 continue
121  b( j ) = 0.d0
122  r1( j ) = 0.d0
123  r2( j ) = 0.d0
124  w( j ) = 0.d0
125  x( j ) = 0.d0
126  ip( j ) = j
127  20 continue
128  ok = .true.
129 *
130 * Test error exits of the routines that use the LU decomposition
131 * of a general matrix.
132 *
133  IF( lsamen( 2, c2, 'GE' ) ) THEN
134 *
135 * ZGETRF
136 *
137  srnamt = 'ZGETRF'
138  infot = 1
139  CALL zgetrf( -1, 0, a, 1, ip, info )
140  CALL chkxer( 'ZGETRF', infot, nout, lerr, ok )
141  infot = 2
142  CALL zgetrf( 0, -1, a, 1, ip, info )
143  CALL chkxer( 'ZGETRF', infot, nout, lerr, ok )
144  infot = 4
145  CALL zgetrf( 2, 1, a, 1, ip, info )
146  CALL chkxer( 'ZGETRF', infot, nout, lerr, ok )
147 *
148 * ZGETF2
149 *
150  srnamt = 'ZGETF2'
151  infot = 1
152  CALL zgetf2( -1, 0, a, 1, ip, info )
153  CALL chkxer( 'ZGETF2', infot, nout, lerr, ok )
154  infot = 2
155  CALL zgetf2( 0, -1, a, 1, ip, info )
156  CALL chkxer( 'ZGETF2', infot, nout, lerr, ok )
157  infot = 4
158  CALL zgetf2( 2, 1, a, 1, ip, info )
159  CALL chkxer( 'ZGETF2', infot, nout, lerr, ok )
160 *
161 * ZGETRI
162 *
163  srnamt = 'ZGETRI'
164  infot = 1
165  CALL zgetri( -1, a, 1, ip, w, 1, info )
166  CALL chkxer( 'ZGETRI', infot, nout, lerr, ok )
167  infot = 3
168  CALL zgetri( 2, a, 1, ip, w, 2, info )
169  CALL chkxer( 'ZGETRI', infot, nout, lerr, ok )
170  infot = 6
171  CALL zgetri( 2, a, 2, ip, w, 1, info )
172  CALL chkxer( 'ZGETRI', infot, nout, lerr, ok )
173 *
174 * ZGETRS
175 *
176  srnamt = 'ZGETRS'
177  infot = 1
178  CALL zgetrs( '/', 0, 0, a, 1, ip, b, 1, info )
179  CALL chkxer( 'ZGETRS', infot, nout, lerr, ok )
180  infot = 2
181  CALL zgetrs( 'N', -1, 0, a, 1, ip, b, 1, info )
182  CALL chkxer( 'ZGETRS', infot, nout, lerr, ok )
183  infot = 3
184  CALL zgetrs( 'N', 0, -1, a, 1, ip, b, 1, info )
185  CALL chkxer( 'ZGETRS', infot, nout, lerr, ok )
186  infot = 5
187  CALL zgetrs( 'N', 2, 1, a, 1, ip, b, 2, info )
188  CALL chkxer( 'ZGETRS', infot, nout, lerr, ok )
189  infot = 8
190  CALL zgetrs( 'N', 2, 1, a, 2, ip, b, 1, info )
191  CALL chkxer( 'ZGETRS', infot, nout, lerr, ok )
192 *
193 * ZGERFS
194 *
195  srnamt = 'ZGERFS'
196  infot = 1
197  CALL zgerfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
198  $ r, info )
199  CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
200  infot = 2
201  CALL zgerfs( 'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
202  $ w, r, info )
203  CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
204  infot = 3
205  CALL zgerfs( 'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
206  $ w, r, info )
207  CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
208  infot = 5
209  CALL zgerfs( 'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
210  $ r, info )
211  CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
212  infot = 7
213  CALL zgerfs( 'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
214  $ r, info )
215  CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
216  infot = 10
217  CALL zgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
218  $ r, info )
219  CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
220  infot = 12
221  CALL zgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
222  $ r, info )
223  CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
224 *
225 * ZGECON
226 *
227  srnamt = 'ZGECON'
228  infot = 1
229  CALL zgecon( '/', 0, a, 1, anrm, rcond, w, r, info )
230  CALL chkxer( 'ZGECON', infot, nout, lerr, ok )
231  infot = 2
232  CALL zgecon( '1', -1, a, 1, anrm, rcond, w, r, info )
233  CALL chkxer( 'ZGECON', infot, nout, lerr, ok )
234  infot = 4
235  CALL zgecon( '1', 2, a, 1, anrm, rcond, w, r, info )
236  CALL chkxer( 'ZGECON', infot, nout, lerr, ok )
237 *
238 * ZGEEQU
239 *
240  srnamt = 'ZGEEQU'
241  infot = 1
242  CALL zgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
243  CALL chkxer( 'ZGEEQU', infot, nout, lerr, ok )
244  infot = 2
245  CALL zgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
246  CALL chkxer( 'ZGEEQU', infot, nout, lerr, ok )
247  infot = 4
248  CALL zgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
249  CALL chkxer( 'ZGEEQU', infot, nout, lerr, ok )
250 *
251 * Test error exits of the routines that use the LU decomposition
252 * of a general band matrix.
253 *
254  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
255 *
256 * ZGBTRF
257 *
258  srnamt = 'ZGBTRF'
259  infot = 1
260  CALL zgbtrf( -1, 0, 0, 0, a, 1, ip, info )
261  CALL chkxer( 'ZGBTRF', infot, nout, lerr, ok )
262  infot = 2
263  CALL zgbtrf( 0, -1, 0, 0, a, 1, ip, info )
264  CALL chkxer( 'ZGBTRF', infot, nout, lerr, ok )
265  infot = 3
266  CALL zgbtrf( 1, 1, -1, 0, a, 1, ip, info )
267  CALL chkxer( 'ZGBTRF', infot, nout, lerr, ok )
268  infot = 4
269  CALL zgbtrf( 1, 1, 0, -1, a, 1, ip, info )
270  CALL chkxer( 'ZGBTRF', infot, nout, lerr, ok )
271  infot = 6
272  CALL zgbtrf( 2, 2, 1, 1, a, 3, ip, info )
273  CALL chkxer( 'ZGBTRF', infot, nout, lerr, ok )
274 *
275 * ZGBTF2
276 *
277  srnamt = 'ZGBTF2'
278  infot = 1
279  CALL zgbtf2( -1, 0, 0, 0, a, 1, ip, info )
280  CALL chkxer( 'ZGBTF2', infot, nout, lerr, ok )
281  infot = 2
282  CALL zgbtf2( 0, -1, 0, 0, a, 1, ip, info )
283  CALL chkxer( 'ZGBTF2', infot, nout, lerr, ok )
284  infot = 3
285  CALL zgbtf2( 1, 1, -1, 0, a, 1, ip, info )
286  CALL chkxer( 'ZGBTF2', infot, nout, lerr, ok )
287  infot = 4
288  CALL zgbtf2( 1, 1, 0, -1, a, 1, ip, info )
289  CALL chkxer( 'ZGBTF2', infot, nout, lerr, ok )
290  infot = 6
291  CALL zgbtf2( 2, 2, 1, 1, a, 3, ip, info )
292  CALL chkxer( 'ZGBTF2', infot, nout, lerr, ok )
293 *
294 * ZGBTRS
295 *
296  srnamt = 'ZGBTRS'
297  infot = 1
298  CALL zgbtrs( '/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
299  CALL chkxer( 'ZGBTRS', infot, nout, lerr, ok )
300  infot = 2
301  CALL zgbtrs( 'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
302  CALL chkxer( 'ZGBTRS', infot, nout, lerr, ok )
303  infot = 3
304  CALL zgbtrs( 'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
305  CALL chkxer( 'ZGBTRS', infot, nout, lerr, ok )
306  infot = 4
307  CALL zgbtrs( 'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
308  CALL chkxer( 'ZGBTRS', infot, nout, lerr, ok )
309  infot = 5
310  CALL zgbtrs( 'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
311  CALL chkxer( 'ZGBTRS', infot, nout, lerr, ok )
312  infot = 7
313  CALL zgbtrs( 'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
314  CALL chkxer( 'ZGBTRS', infot, nout, lerr, ok )
315  infot = 10
316  CALL zgbtrs( 'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
317  CALL chkxer( 'ZGBTRS', infot, nout, lerr, ok )
318 *
319 * ZGBRFS
320 *
321  srnamt = 'ZGBRFS'
322  infot = 1
323  CALL zgbrfs( '/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
324  $ r2, w, r, info )
325  CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
326  infot = 2
327  CALL zgbrfs( 'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
328  $ r2, w, r, info )
329  CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
330  infot = 3
331  CALL zgbrfs( 'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
332  $ r2, w, r, info )
333  CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
334  infot = 4
335  CALL zgbrfs( 'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
336  $ r2, w, r, info )
337  CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
338  infot = 5
339  CALL zgbrfs( 'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
340  $ r2, w, r, info )
341  CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
342  infot = 7
343  CALL zgbrfs( 'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
344  $ r2, w, r, info )
345  CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
346  infot = 9
347  CALL zgbrfs( 'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
348  $ r2, w, r, info )
349  CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
350  infot = 12
351  CALL zgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
352  $ r2, w, r, info )
353  CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
354  infot = 14
355  CALL zgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
356  $ r2, w, r, info )
357  CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
358 *
359 * ZGBCON
360 *
361  srnamt = 'ZGBCON'
362  infot = 1
363  CALL zgbcon( '/', 0, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
364  CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
365  infot = 2
366  CALL zgbcon( '1', -1, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
367  CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
368  infot = 3
369  CALL zgbcon( '1', 1, -1, 0, a, 1, ip, anrm, rcond, w, r, info )
370  CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
371  infot = 4
372  CALL zgbcon( '1', 1, 0, -1, a, 1, ip, anrm, rcond, w, r, info )
373  CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
374  infot = 6
375  CALL zgbcon( '1', 2, 1, 1, a, 3, ip, anrm, rcond, w, r, info )
376  CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
377 *
378 * ZGBEQU
379 *
380  srnamt = 'ZGBEQU'
381  infot = 1
382  CALL zgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
383  $ info )
384  CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
385  infot = 2
386  CALL zgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
387  $ info )
388  CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
389  infot = 3
390  CALL zgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
391  $ info )
392  CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
393  infot = 4
394  CALL zgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
395  $ info )
396  CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
397  infot = 6
398  CALL zgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
399  $ info )
400  CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
401  END IF
402 *
403 * Print a summary line.
404 *
405  CALL alaesm( path, ok, nout )
406 *
407  return
408 *
409 * End of ZERRGE
410 *
411  END