LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zerrqr.f
Go to the documentation of this file.
1 *> \brief \b ZERRQR
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 ZERRQR( 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 *> ZERRQR tests the error exits for the COMPLEX*16 routines
25 *> that use the QR decomposition of a general matrix.
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 zerrqr( 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 = 2 )
73 * ..
74 * .. Local Scalars ..
75  INTEGER i, info, j
76 * ..
77 * .. Local Arrays ..
78  COMPLEX*16 a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
79  $ w( nmax ), x( nmax )
80 * ..
81 * .. External Subroutines ..
82  EXTERNAL alaesm, chkxer, zgeqr2, zgeqr2p, zgeqrf,
83  $ zgeqrfp, zgeqrs, zung2r, zungqr, zunm2r,
84  $ zunmqr
85 * ..
86 * .. Scalars in Common ..
87  LOGICAL lerr, ok
88  CHARACTER*32 srnamt
89  INTEGER infot, nout
90 * ..
91 * .. Common blocks ..
92  common / infoc / infot, nout, ok, lerr
93  common / srnamc / srnamt
94 * ..
95 * .. Intrinsic Functions ..
96  INTRINSIC dble, dcmplx
97 * ..
98 * .. Executable Statements ..
99 *
100  nout = nunit
101  WRITE( nout, fmt = * )
102 *
103 * Set the variables to innocuous values.
104 *
105  DO 20 j = 1, nmax
106  DO 10 i = 1, nmax
107  a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
108  $ -1.d0 / dble( i+j ) )
109  af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
110  $ -1.d0 / dble( i+j ) )
111  10 continue
112  b( j ) = 0.d0
113  w( j ) = 0.d0
114  x( j ) = 0.d0
115  20 continue
116  ok = .true.
117 *
118 * Error exits for QR factorization
119 *
120 * ZGEQRF
121 *
122  srnamt = 'ZGEQRF'
123  infot = 1
124  CALL zgeqrf( -1, 0, a, 1, b, w, 1, info )
125  CALL chkxer( 'ZGEQRF', infot, nout, lerr, ok )
126  infot = 2
127  CALL zgeqrf( 0, -1, a, 1, b, w, 1, info )
128  CALL chkxer( 'ZGEQRF', infot, nout, lerr, ok )
129  infot = 4
130  CALL zgeqrf( 2, 1, a, 1, b, w, 1, info )
131  CALL chkxer( 'ZGEQRF', infot, nout, lerr, ok )
132  infot = 7
133  CALL zgeqrf( 1, 2, a, 1, b, w, 1, info )
134  CALL chkxer( 'ZGEQRF', infot, nout, lerr, ok )
135 *
136 * ZGEQRFP
137 *
138  srnamt = 'ZGEQRFP'
139  infot = 1
140  CALL zgeqrfp( -1, 0, a, 1, b, w, 1, info )
141  CALL chkxer( 'ZGEQRFP', infot, nout, lerr, ok )
142  infot = 2
143  CALL zgeqrfp( 0, -1, a, 1, b, w, 1, info )
144  CALL chkxer( 'ZGEQRFP', infot, nout, lerr, ok )
145  infot = 4
146  CALL zgeqrfp( 2, 1, a, 1, b, w, 1, info )
147  CALL chkxer( 'ZGEQRFP', infot, nout, lerr, ok )
148  infot = 7
149  CALL zgeqrfp( 1, 2, a, 1, b, w, 1, info )
150  CALL chkxer( 'ZGEQRFP', infot, nout, lerr, ok )
151 *
152 * ZGEQR2
153 *
154  srnamt = 'ZGEQR2'
155  infot = 1
156  CALL zgeqr2( -1, 0, a, 1, b, w, info )
157  CALL chkxer( 'ZGEQR2', infot, nout, lerr, ok )
158  infot = 2
159  CALL zgeqr2( 0, -1, a, 1, b, w, info )
160  CALL chkxer( 'ZGEQR2', infot, nout, lerr, ok )
161  infot = 4
162  CALL zgeqr2( 2, 1, a, 1, b, w, info )
163  CALL chkxer( 'ZGEQR2', infot, nout, lerr, ok )
164 *
165 * ZGEQR2P
166 *
167  srnamt = 'ZGEQR2P'
168  infot = 1
169  CALL zgeqr2p( -1, 0, a, 1, b, w, info )
170  CALL chkxer( 'ZGEQR2P', infot, nout, lerr, ok )
171  infot = 2
172  CALL zgeqr2p( 0, -1, a, 1, b, w, info )
173  CALL chkxer( 'ZGEQR2P', infot, nout, lerr, ok )
174  infot = 4
175  CALL zgeqr2p( 2, 1, a, 1, b, w, info )
176  CALL chkxer( 'ZGEQR2P', infot, nout, lerr, ok )
177 *
178 * ZGEQRS
179 *
180  srnamt = 'ZGEQRS'
181  infot = 1
182  CALL zgeqrs( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
183  CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
184  infot = 2
185  CALL zgeqrs( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
186  CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
187  infot = 2
188  CALL zgeqrs( 1, 2, 0, a, 2, x, b, 2, w, 1, info )
189  CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
190  infot = 3
191  CALL zgeqrs( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
192  CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
193  infot = 5
194  CALL zgeqrs( 2, 1, 0, a, 1, x, b, 2, w, 1, info )
195  CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
196  infot = 8
197  CALL zgeqrs( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
198  CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
199  infot = 10
200  CALL zgeqrs( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
201  CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
202 *
203 * ZUNGQR
204 *
205  srnamt = 'ZUNGQR'
206  infot = 1
207  CALL zungqr( -1, 0, 0, a, 1, x, w, 1, info )
208  CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
209  infot = 2
210  CALL zungqr( 0, -1, 0, a, 1, x, w, 1, info )
211  CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
212  infot = 2
213  CALL zungqr( 1, 2, 0, a, 1, x, w, 2, info )
214  CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
215  infot = 3
216  CALL zungqr( 0, 0, -1, a, 1, x, w, 1, info )
217  CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
218  infot = 3
219  CALL zungqr( 1, 1, 2, a, 1, x, w, 1, info )
220  CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
221  infot = 5
222  CALL zungqr( 2, 2, 0, a, 1, x, w, 2, info )
223  CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
224  infot = 8
225  CALL zungqr( 2, 2, 0, a, 2, x, w, 1, info )
226  CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
227 *
228 * ZUNG2R
229 *
230  srnamt = 'ZUNG2R'
231  infot = 1
232  CALL zung2r( -1, 0, 0, a, 1, x, w, info )
233  CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
234  infot = 2
235  CALL zung2r( 0, -1, 0, a, 1, x, w, info )
236  CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
237  infot = 2
238  CALL zung2r( 1, 2, 0, a, 1, x, w, info )
239  CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
240  infot = 3
241  CALL zung2r( 0, 0, -1, a, 1, x, w, info )
242  CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
243  infot = 3
244  CALL zung2r( 2, 1, 2, a, 2, x, w, info )
245  CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
246  infot = 5
247  CALL zung2r( 2, 1, 0, a, 1, x, w, info )
248  CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
249 *
250 * ZUNMQR
251 *
252  srnamt = 'ZUNMQR'
253  infot = 1
254  CALL zunmqr( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
255  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
256  infot = 2
257  CALL zunmqr( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
258  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
259  infot = 3
260  CALL zunmqr( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
261  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
262  infot = 4
263  CALL zunmqr( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
264  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
265  infot = 5
266  CALL zunmqr( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
267  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
268  infot = 5
269  CALL zunmqr( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
270  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
271  infot = 5
272  CALL zunmqr( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
273  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
274  infot = 7
275  CALL zunmqr( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
276  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
277  infot = 7
278  CALL zunmqr( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
279  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
280  infot = 10
281  CALL zunmqr( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, 1, info )
282  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
283  infot = 12
284  CALL zunmqr( 'L', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
285  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
286  infot = 12
287  CALL zunmqr( 'R', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
288  CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
289 *
290 * ZUNM2R
291 *
292  srnamt = 'ZUNM2R'
293  infot = 1
294  CALL zunm2r( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, info )
295  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
296  infot = 2
297  CALL zunm2r( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, info )
298  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
299  infot = 3
300  CALL zunm2r( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, info )
301  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
302  infot = 4
303  CALL zunm2r( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, info )
304  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
305  infot = 5
306  CALL zunm2r( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, info )
307  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
308  infot = 5
309  CALL zunm2r( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, info )
310  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
311  infot = 5
312  CALL zunm2r( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, info )
313  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
314  infot = 7
315  CALL zunm2r( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, info )
316  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
317  infot = 7
318  CALL zunm2r( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, info )
319  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
320  infot = 10
321  CALL zunm2r( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, info )
322  CALL chkxer( 'ZUNM2R', infot, nout, lerr, ok )
323 *
324 * Print a summary line.
325 *
326  CALL alaesm( path, ok, nout )
327 *
328  return
329 *
330 * End of ZERRQR
331 *
332  END