LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cerrqr.f
Go to the documentation of this file.
1 *> \brief \b CERRQR
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 CERRQR( 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 *> CERRQR tests the error exits for the COMPLEX 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 complex_lin
54 *
55 * =====================================================================
56  SUBROUTINE cerrqr( 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 a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
79  $ w( nmax ), x( nmax )
80 * ..
81 * .. External Subroutines ..
82  EXTERNAL alaesm, cgeqr2, cgeqr2p, cgeqrf, cgeqrfp,
83  $ cgeqrs, chkxer, cung2r, cungqr, cunm2r,
84  $ cunmqr
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 cmplx, real
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 ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
108  af( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
109  10 continue
110  b( j ) = 0.
111  w( j ) = 0.
112  x( j ) = 0.
113  20 continue
114  ok = .true.
115 *
116 * Error exits for QR factorization
117 *
118 * CGEQRF
119 *
120  srnamt = 'CGEQRF'
121  infot = 1
122  CALL cgeqrf( -1, 0, a, 1, b, w, 1, info )
123  CALL chkxer( 'CGEQRF', infot, nout, lerr, ok )
124  infot = 2
125  CALL cgeqrf( 0, -1, a, 1, b, w, 1, info )
126  CALL chkxer( 'CGEQRF', infot, nout, lerr, ok )
127  infot = 4
128  CALL cgeqrf( 2, 1, a, 1, b, w, 1, info )
129  CALL chkxer( 'CGEQRF', infot, nout, lerr, ok )
130  infot = 7
131  CALL cgeqrf( 1, 2, a, 1, b, w, 1, info )
132  CALL chkxer( 'CGEQRF', infot, nout, lerr, ok )
133 *
134 * CGEQRFP
135 *
136  srnamt = 'CGEQRFP'
137  infot = 1
138  CALL cgeqrfp( -1, 0, a, 1, b, w, 1, info )
139  CALL chkxer( 'CGEQRFP', infot, nout, lerr, ok )
140  infot = 2
141  CALL cgeqrfp( 0, -1, a, 1, b, w, 1, info )
142  CALL chkxer( 'CGEQRFP', infot, nout, lerr, ok )
143  infot = 4
144  CALL cgeqrfp( 2, 1, a, 1, b, w, 1, info )
145  CALL chkxer( 'CGEQRFP', infot, nout, lerr, ok )
146  infot = 7
147  CALL cgeqrfp( 1, 2, a, 1, b, w, 1, info )
148  CALL chkxer( 'CGEQRFP', infot, nout, lerr, ok )
149 *
150 * CGEQR2
151 *
152  srnamt = 'CGEQR2'
153  infot = 1
154  CALL cgeqr2( -1, 0, a, 1, b, w, info )
155  CALL chkxer( 'CGEQR2', infot, nout, lerr, ok )
156  infot = 2
157  CALL cgeqr2( 0, -1, a, 1, b, w, info )
158  CALL chkxer( 'CGEQR2', infot, nout, lerr, ok )
159  infot = 4
160  CALL cgeqr2( 2, 1, a, 1, b, w, info )
161  CALL chkxer( 'CGEQR2', infot, nout, lerr, ok )
162 *
163 * CGEQR2P
164 *
165  srnamt = 'CGEQR2P'
166  infot = 1
167  CALL cgeqr2p( -1, 0, a, 1, b, w, info )
168  CALL chkxer( 'CGEQR2P', infot, nout, lerr, ok )
169  infot = 2
170  CALL cgeqr2p( 0, -1, a, 1, b, w, info )
171  CALL chkxer( 'CGEQR2P', infot, nout, lerr, ok )
172  infot = 4
173  CALL cgeqr2p( 2, 1, a, 1, b, w, info )
174  CALL chkxer( 'CGEQR2P', infot, nout, lerr, ok )
175 *
176 * CGEQRS
177 *
178  srnamt = 'CGEQRS'
179  infot = 1
180  CALL cgeqrs( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
181  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
182  infot = 2
183  CALL cgeqrs( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
184  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
185  infot = 2
186  CALL cgeqrs( 1, 2, 0, a, 2, x, b, 2, w, 1, info )
187  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
188  infot = 3
189  CALL cgeqrs( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
190  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
191  infot = 5
192  CALL cgeqrs( 2, 1, 0, a, 1, x, b, 2, w, 1, info )
193  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
194  infot = 8
195  CALL cgeqrs( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
196  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
197  infot = 10
198  CALL cgeqrs( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
199  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
200 *
201 * CUNGQR
202 *
203  srnamt = 'CUNGQR'
204  infot = 1
205  CALL cungqr( -1, 0, 0, a, 1, x, w, 1, info )
206  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
207  infot = 2
208  CALL cungqr( 0, -1, 0, a, 1, x, w, 1, info )
209  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
210  infot = 2
211  CALL cungqr( 1, 2, 0, a, 1, x, w, 2, info )
212  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
213  infot = 3
214  CALL cungqr( 0, 0, -1, a, 1, x, w, 1, info )
215  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
216  infot = 3
217  CALL cungqr( 1, 1, 2, a, 1, x, w, 1, info )
218  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
219  infot = 5
220  CALL cungqr( 2, 2, 0, a, 1, x, w, 2, info )
221  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
222  infot = 8
223  CALL cungqr( 2, 2, 0, a, 2, x, w, 1, info )
224  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
225 *
226 * CUNG2R
227 *
228  srnamt = 'CUNG2R'
229  infot = 1
230  CALL cung2r( -1, 0, 0, a, 1, x, w, info )
231  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
232  infot = 2
233  CALL cung2r( 0, -1, 0, a, 1, x, w, info )
234  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
235  infot = 2
236  CALL cung2r( 1, 2, 0, a, 1, x, w, info )
237  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
238  infot = 3
239  CALL cung2r( 0, 0, -1, a, 1, x, w, info )
240  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
241  infot = 3
242  CALL cung2r( 2, 1, 2, a, 2, x, w, info )
243  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
244  infot = 5
245  CALL cung2r( 2, 1, 0, a, 1, x, w, info )
246  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
247 *
248 * CUNMQR
249 *
250  srnamt = 'CUNMQR'
251  infot = 1
252  CALL cunmqr( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
253  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
254  infot = 2
255  CALL cunmqr( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
256  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
257  infot = 3
258  CALL cunmqr( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
259  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
260  infot = 4
261  CALL cunmqr( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
262  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
263  infot = 5
264  CALL cunmqr( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
265  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
266  infot = 5
267  CALL cunmqr( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
268  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
269  infot = 5
270  CALL cunmqr( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
271  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
272  infot = 7
273  CALL cunmqr( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
274  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
275  infot = 7
276  CALL cunmqr( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
277  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
278  infot = 10
279  CALL cunmqr( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, 1, info )
280  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
281  infot = 12
282  CALL cunmqr( 'L', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
283  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
284  infot = 12
285  CALL cunmqr( 'R', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
286  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
287 *
288 * CUNM2R
289 *
290  srnamt = 'CUNM2R'
291  infot = 1
292  CALL cunm2r( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, info )
293  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
294  infot = 2
295  CALL cunm2r( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, info )
296  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
297  infot = 3
298  CALL cunm2r( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, info )
299  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
300  infot = 4
301  CALL cunm2r( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, info )
302  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
303  infot = 5
304  CALL cunm2r( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, info )
305  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
306  infot = 5
307  CALL cunm2r( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, info )
308  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
309  infot = 5
310  CALL cunm2r( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, info )
311  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
312  infot = 7
313  CALL cunm2r( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, info )
314  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
315  infot = 7
316  CALL cunm2r( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, info )
317  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
318  infot = 10
319  CALL cunm2r( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, info )
320  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
321 *
322 * Print a summary line.
323 *
324  CALL alaesm( path, ok, nout )
325 *
326  return
327 *
328 * End of CERRQR
329 *
330  END