LAPACK  3.10.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 *> \ingroup complex_lin
52 *
53 * =====================================================================
54  SUBROUTINE cerrqr( PATH, NUNIT )
55 *
56 * -- LAPACK test routine --
57 * -- LAPACK is a software package provided by Univ. of Tennessee, --
58 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59 *
60 * .. Scalar Arguments ..
61  CHARACTER*3 PATH
62  INTEGER NUNIT
63 * ..
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68  INTEGER NMAX
69  parameter( nmax = 2 )
70 * ..
71 * .. Local Scalars ..
72  INTEGER I, INFO, J
73 * ..
74 * .. Local Arrays ..
75  COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
76  $ W( NMAX ), X( NMAX )
77 * ..
78 * .. External Subroutines ..
79  EXTERNAL alaesm, cgeqr2, cgeqr2p, cgeqrf, cgeqrfp,
81  $ cunmqr
82 * ..
83 * .. Scalars in Common ..
84  LOGICAL LERR, OK
85  CHARACTER*32 SRNAMT
86  INTEGER INFOT, NOUT
87 * ..
88 * .. Common blocks ..
89  COMMON / infoc / infot, nout, ok, lerr
90  COMMON / srnamc / srnamt
91 * ..
92 * .. Intrinsic Functions ..
93  INTRINSIC cmplx, real
94 * ..
95 * .. Executable Statements ..
96 *
97  nout = nunit
98  WRITE( nout, fmt = * )
99 *
100 * Set the variables to innocuous values.
101 *
102  DO 20 j = 1, nmax
103  DO 10 i = 1, nmax
104  a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
105  af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
106  10 CONTINUE
107  b( j ) = 0.
108  w( j ) = 0.
109  x( j ) = 0.
110  20 CONTINUE
111  ok = .true.
112 *
113 * Error exits for QR factorization
114 *
115 * CGEQRF
116 *
117  srnamt = 'CGEQRF'
118  infot = 1
119  CALL cgeqrf( -1, 0, a, 1, b, w, 1, info )
120  CALL chkxer( 'CGEQRF', infot, nout, lerr, ok )
121  infot = 2
122  CALL cgeqrf( 0, -1, a, 1, b, w, 1, info )
123  CALL chkxer( 'CGEQRF', infot, nout, lerr, ok )
124  infot = 4
125  CALL cgeqrf( 2, 1, a, 1, b, w, 1, info )
126  CALL chkxer( 'CGEQRF', infot, nout, lerr, ok )
127  infot = 7
128  CALL cgeqrf( 1, 2, a, 1, b, w, 1, info )
129  CALL chkxer( 'CGEQRF', infot, nout, lerr, ok )
130 *
131 * CGEQRFP
132 *
133  srnamt = 'CGEQRFP'
134  infot = 1
135  CALL cgeqrfp( -1, 0, a, 1, b, w, 1, info )
136  CALL chkxer( 'CGEQRFP', infot, nout, lerr, ok )
137  infot = 2
138  CALL cgeqrfp( 0, -1, a, 1, b, w, 1, info )
139  CALL chkxer( 'CGEQRFP', infot, nout, lerr, ok )
140  infot = 4
141  CALL cgeqrfp( 2, 1, a, 1, b, w, 1, info )
142  CALL chkxer( 'CGEQRFP', infot, nout, lerr, ok )
143  infot = 7
144  CALL cgeqrfp( 1, 2, a, 1, b, w, 1, info )
145  CALL chkxer( 'CGEQRFP', infot, nout, lerr, ok )
146 *
147 * CGEQR2
148 *
149  srnamt = 'CGEQR2'
150  infot = 1
151  CALL cgeqr2( -1, 0, a, 1, b, w, info )
152  CALL chkxer( 'CGEQR2', infot, nout, lerr, ok )
153  infot = 2
154  CALL cgeqr2( 0, -1, a, 1, b, w, info )
155  CALL chkxer( 'CGEQR2', infot, nout, lerr, ok )
156  infot = 4
157  CALL cgeqr2( 2, 1, a, 1, b, w, info )
158  CALL chkxer( 'CGEQR2', infot, nout, lerr, ok )
159 *
160 * CGEQR2P
161 *
162  srnamt = 'CGEQR2P'
163  infot = 1
164  CALL cgeqr2p( -1, 0, a, 1, b, w, info )
165  CALL chkxer( 'CGEQR2P', infot, nout, lerr, ok )
166  infot = 2
167  CALL cgeqr2p( 0, -1, a, 1, b, w, info )
168  CALL chkxer( 'CGEQR2P', infot, nout, lerr, ok )
169  infot = 4
170  CALL cgeqr2p( 2, 1, a, 1, b, w, info )
171  CALL chkxer( 'CGEQR2P', infot, nout, lerr, ok )
172 *
173 * CGEQRS
174 *
175  srnamt = 'CGEQRS'
176  infot = 1
177  CALL cgeqrs( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
178  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
179  infot = 2
180  CALL cgeqrs( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
181  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
182  infot = 2
183  CALL cgeqrs( 1, 2, 0, a, 2, x, b, 2, w, 1, info )
184  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
185  infot = 3
186  CALL cgeqrs( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
187  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
188  infot = 5
189  CALL cgeqrs( 2, 1, 0, a, 1, x, b, 2, w, 1, info )
190  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
191  infot = 8
192  CALL cgeqrs( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
193  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
194  infot = 10
195  CALL cgeqrs( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
196  CALL chkxer( 'CGEQRS', infot, nout, lerr, ok )
197 *
198 * CUNGQR
199 *
200  srnamt = 'CUNGQR'
201  infot = 1
202  CALL cungqr( -1, 0, 0, a, 1, x, w, 1, info )
203  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
204  infot = 2
205  CALL cungqr( 0, -1, 0, a, 1, x, w, 1, info )
206  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
207  infot = 2
208  CALL cungqr( 1, 2, 0, a, 1, x, w, 2, info )
209  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
210  infot = 3
211  CALL cungqr( 0, 0, -1, a, 1, x, w, 1, info )
212  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
213  infot = 3
214  CALL cungqr( 1, 1, 2, a, 1, x, w, 1, info )
215  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
216  infot = 5
217  CALL cungqr( 2, 2, 0, a, 1, x, w, 2, info )
218  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
219  infot = 8
220  CALL cungqr( 2, 2, 0, a, 2, x, w, 1, info )
221  CALL chkxer( 'CUNGQR', infot, nout, lerr, ok )
222 *
223 * CUNG2R
224 *
225  srnamt = 'CUNG2R'
226  infot = 1
227  CALL cung2r( -1, 0, 0, a, 1, x, w, info )
228  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
229  infot = 2
230  CALL cung2r( 0, -1, 0, a, 1, x, w, info )
231  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
232  infot = 2
233  CALL cung2r( 1, 2, 0, a, 1, x, w, info )
234  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
235  infot = 3
236  CALL cung2r( 0, 0, -1, a, 1, x, w, info )
237  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
238  infot = 3
239  CALL cung2r( 2, 1, 2, a, 2, x, w, info )
240  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
241  infot = 5
242  CALL cung2r( 2, 1, 0, a, 1, x, w, info )
243  CALL chkxer( 'CUNG2R', infot, nout, lerr, ok )
244 *
245 * CUNMQR
246 *
247  srnamt = 'CUNMQR'
248  infot = 1
249  CALL cunmqr( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
250  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
251  infot = 2
252  CALL cunmqr( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
253  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
254  infot = 3
255  CALL cunmqr( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
256  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
257  infot = 4
258  CALL cunmqr( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
259  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
260  infot = 5
261  CALL cunmqr( 'L', 'N', 0, 0, -1, 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, 1, 1, a, 1, x, af, 1, w, 1, info )
265  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
266  infot = 5
267  CALL cunmqr( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
268  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
269  infot = 7
270  CALL cunmqr( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
271  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
272  infot = 7
273  CALL cunmqr( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
274  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
275  infot = 10
276  CALL cunmqr( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, 1, info )
277  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
278  infot = 12
279  CALL cunmqr( 'L', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
280  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
281  infot = 12
282  CALL cunmqr( 'R', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
283  CALL chkxer( 'CUNMQR', infot, nout, lerr, ok )
284 *
285 * CUNM2R
286 *
287  srnamt = 'CUNM2R'
288  infot = 1
289  CALL cunm2r( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, info )
290  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
291  infot = 2
292  CALL cunm2r( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, info )
293  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
294  infot = 3
295  CALL cunm2r( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, info )
296  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
297  infot = 4
298  CALL cunm2r( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, info )
299  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
300  infot = 5
301  CALL cunm2r( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, info )
302  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
303  infot = 5
304  CALL cunm2r( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, info )
305  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
306  infot = 5
307  CALL cunm2r( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, info )
308  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
309  infot = 7
310  CALL cunm2r( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, info )
311  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
312  infot = 7
313  CALL cunm2r( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, info )
314  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
315  infot = 10
316  CALL cunm2r( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, info )
317  CALL chkxer( 'CUNM2R', infot, nout, lerr, ok )
318 *
319 * Print a summary line.
320 *
321  CALL alaesm( path, ok, nout )
322 *
323  RETURN
324 *
325 * End of CERRQR
326 *
327  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine cgeqrs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
CGEQRS
Definition: cgeqrs.f:121
subroutine cerrqr(PATH, NUNIT)
CERRQR
Definition: cerrqr.f:55
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:130
subroutine cgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRF
Definition: cgeqrf.f:146
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:134
subroutine cgeqrfp(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRFP
Definition: cgeqrfp.f:149
subroutine cung2r(M, N, K, A, LDA, TAU, WORK, INFO)
CUNG2R
Definition: cung2r.f:114
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
Definition: cunmqr.f:168
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:159
subroutine cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR
Definition: cungqr.f:128