LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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
cgeqrs
subroutine cgeqrs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
CGEQRS
Definition: cgeqrs.f:123
cgeqr2
subroutine cgeqr2(M, N, A, LDA, TAU, WORK, INFO)
CGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...
Definition: cgeqr2.f:123
cerrqr
subroutine cerrqr(PATH, NUNIT)
CERRQR
Definition: cerrqr.f:57
cunm2r
subroutine cunm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
CUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf...
Definition: cunm2r.f:161
cung2r
subroutine cung2r(M, N, K, A, LDA, TAU, WORK, INFO)
CUNG2R
Definition: cung2r.f:116
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
cunmqr
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
Definition: cunmqr.f:170
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
cgeqrf
subroutine cgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRF
Definition: cgeqrf.f:138
cgeqr2p
subroutine cgeqr2p(M, N, A, LDA, TAU, WORK, INFO)
CGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elem...
Definition: cgeqr2p.f:126
cungqr
subroutine cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR
Definition: cungqr.f:130
cgeqrfp
subroutine cgeqrfp(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRFP
Definition: cgeqrfp.f:141