1       SUBROUTINE CERRQR( PATH, NUNIT )
  2 *
  3 *  -- LAPACK test routine (version 3.3.0) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *     November 2010
  6 *
  7 *     .. Scalar Arguments ..
  8       CHARACTER*3        PATH
  9       INTEGER            NUNIT
 10 *     ..
 11 *
 12 *  Purpose
 13 *  =======
 14 *
 15 *  CERRQR tests the error exits for the COMPLEX routines
 16 *  that use the QR decomposition of a general matrix.
 17 *
 18 *  Arguments
 19 *  =========
 20 *
 21 *  PATH    (input) CHARACTER*3
 22 *          The LAPACK path name for the routines to be tested.
 23 *
 24 *  NUNIT   (input) INTEGER
 25 *          The unit number for output.
 26 *
 27 *  =====================================================================
 28 *
 29 *     .. Parameters ..
 30       INTEGER            NMAX
 31       PARAMETER          ( NMAX = 2 )
 32 *     ..
 33 *     .. Local Scalars ..
 34       INTEGER            I, INFO, J
 35 *     ..
 36 *     .. Local Arrays ..
 37       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
 38      $                   W( NMAX ), X( NMAX )
 39 *     ..
 40 *     .. External Subroutines ..
 41       EXTERNAL           ALAESM, CGEQR2, CGEQR2P, CGEQRF, CGEQRFP,
 42      $                   CGEQRS, CHKXER, CUNG2R, CUNGQR, CUNM2R,
 43      $                   CUNMQR
 44 *     ..
 45 *     .. Scalars in Common ..
 46       LOGICAL            LERR, OK
 47       CHARACTER*32       SRNAMT
 48       INTEGER            INFOT, NOUT
 49 *     ..
 50 *     .. Common blocks ..
 51       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 52       COMMON             / SRNAMC / SRNAMT
 53 *     ..
 54 *     .. Intrinsic Functions ..
 55       INTRINSIC          CMPLX, REAL
 56 *     ..
 57 *     .. Executable Statements ..
 58 *
 59       NOUT = NUNIT
 60       WRITE( NOUT, FMT = * )
 61 *
 62 *     Set the variables to innocuous values.
 63 *
 64       DO 20 J = 1, NMAX
 65          DO 10 I = 1, NMAX
 66             A( I, J ) = CMPLX1/ REAL( I+J ), -1/ REAL( I+J ) )
 67             AF( I, J ) = CMPLX1/ REAL( I+J ), -1/ REAL( I+J ) )
 68    10    CONTINUE
 69          B( J ) = 0.
 70          W( J ) = 0.
 71          X( J ) = 0.
 72    20 CONTINUE
 73       OK = .TRUE.
 74 *
 75 *     Error exits for QR factorization
 76 *
 77 *     CGEQRF
 78 *
 79       SRNAMT = 'CGEQRF'
 80       INFOT = 1
 81       CALL CGEQRF( -10, A, 1, B, W, 1, INFO )
 82       CALL CHKXER( 'CGEQRF', INFOT, NOUT, LERR, OK )
 83       INFOT = 2
 84       CALL CGEQRF( 0-1, A, 1, B, W, 1, INFO )
 85       CALL CHKXER( 'CGEQRF', INFOT, NOUT, LERR, OK )
 86       INFOT = 4
 87       CALL CGEQRF( 21, A, 1, B, W, 1, INFO )
 88       CALL CHKXER( 'CGEQRF', INFOT, NOUT, LERR, OK )
 89       INFOT = 7
 90       CALL CGEQRF( 12, A, 1, B, W, 1, INFO )
 91       CALL CHKXER( 'CGEQRF', INFOT, NOUT, LERR, OK )
 92 *
 93 *     CGEQRFP
 94 *
 95       SRNAMT = 'CGEQRFP'
 96       INFOT = 1
 97       CALL CGEQRFP( -10, A, 1, B, W, 1, INFO )
 98       CALL CHKXER( 'CGEQRFP', INFOT, NOUT, LERR, OK )
 99       INFOT = 2
100       CALL CGEQRFP( 0-1, A, 1, B, W, 1, INFO )
101       CALL CHKXER( 'CGEQRFP', INFOT, NOUT, LERR, OK )
102       INFOT = 4
103       CALL CGEQRFP( 21, A, 1, B, W, 1, INFO )
104       CALL CHKXER( 'CGEQRFP', INFOT, NOUT, LERR, OK )
105       INFOT = 7
106       CALL CGEQRFP( 12, A, 1, B, W, 1, INFO )
107       CALL CHKXER( 'CGEQRFP', INFOT, NOUT, LERR, OK )
108 *
109 *     CGEQR2
110 *
111       SRNAMT = 'CGEQR2'
112       INFOT = 1
113       CALL CGEQR2( -10, A, 1, B, W, INFO )
114       CALL CHKXER( 'CGEQR2', INFOT, NOUT, LERR, OK )
115       INFOT = 2
116       CALL CGEQR2( 0-1, A, 1, B, W, INFO )
117       CALL CHKXER( 'CGEQR2', INFOT, NOUT, LERR, OK )
118       INFOT = 4
119       CALL CGEQR2( 21, A, 1, B, W, INFO )
120       CALL CHKXER( 'CGEQR2', INFOT, NOUT, LERR, OK )
121 *
122 *     CGEQR2P
123 *
124       SRNAMT = 'CGEQR2P'
125       INFOT = 1
126       CALL CGEQR2P( -10, A, 1, B, W, INFO )
127       CALL CHKXER( 'CGEQR2P', INFOT, NOUT, LERR, OK )
128       INFOT = 2
129       CALL CGEQR2P( 0-1, A, 1, B, W, INFO )
130       CALL CHKXER( 'CGEQR2P', INFOT, NOUT, LERR, OK )
131       INFOT = 4
132       CALL CGEQR2P( 21, A, 1, B, W, INFO )
133       CALL CHKXER( 'CGEQR2P', INFOT, NOUT, LERR, OK )
134 *
135 *     CGEQRS
136 *
137       SRNAMT = 'CGEQRS'
138       INFOT = 1
139       CALL CGEQRS( -100, A, 1, X, B, 1, W, 1, INFO )
140       CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
141       INFOT = 2
142       CALL CGEQRS( 0-10, A, 1, X, B, 1, W, 1, INFO )
143       CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
144       INFOT = 2
145       CALL CGEQRS( 120, A, 2, X, B, 2, W, 1, INFO )
146       CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
147       INFOT = 3
148       CALL CGEQRS( 00-1, A, 1, X, B, 1, W, 1, INFO )
149       CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
150       INFOT = 5
151       CALL CGEQRS( 210, A, 1, X, B, 2, W, 1, INFO )
152       CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
153       INFOT = 8
154       CALL CGEQRS( 210, A, 2, X, B, 1, W, 1, INFO )
155       CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
156       INFOT = 10
157       CALL CGEQRS( 112, A, 1, X, B, 1, W, 1, INFO )
158       CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
159 *
160 *     CUNGQR
161 *
162       SRNAMT = 'CUNGQR'
163       INFOT = 1
164       CALL CUNGQR( -100, A, 1, X, W, 1, INFO )
165       CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK )
166       INFOT = 2
167       CALL CUNGQR( 0-10, A, 1, X, W, 1, INFO )
168       CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK )
169       INFOT = 2
170       CALL CUNGQR( 120, A, 1, X, W, 2, INFO )
171       CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK )
172       INFOT = 3
173       CALL CUNGQR( 00-1, A, 1, X, W, 1, INFO )
174       CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK )
175       INFOT = 3
176       CALL CUNGQR( 112, A, 1, X, W, 1, INFO )
177       CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK )
178       INFOT = 5
179       CALL CUNGQR( 220, A, 1, X, W, 2, INFO )
180       CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK )
181       INFOT = 8
182       CALL CUNGQR( 220, A, 2, X, W, 1, INFO )
183       CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK )
184 *
185 *     CUNG2R
186 *
187       SRNAMT = 'CUNG2R'
188       INFOT = 1
189       CALL CUNG2R( -100, A, 1, X, W, INFO )
190       CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK )
191       INFOT = 2
192       CALL CUNG2R( 0-10, A, 1, X, W, INFO )
193       CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK )
194       INFOT = 2
195       CALL CUNG2R( 120, A, 1, X, W, INFO )
196       CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK )
197       INFOT = 3
198       CALL CUNG2R( 00-1, A, 1, X, W, INFO )
199       CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK )
200       INFOT = 3
201       CALL CUNG2R( 212, A, 2, X, W, INFO )
202       CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK )
203       INFOT = 5
204       CALL CUNG2R( 210, A, 1, X, W, INFO )
205       CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK )
206 *
207 *     CUNMQR
208 *
209       SRNAMT = 'CUNMQR'
210       INFOT = 1
211       CALL CUNMQR( '/''N'000, A, 1, X, AF, 1, W, 1, INFO )
212       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
213       INFOT = 2
214       CALL CUNMQR( 'L''/'000, A, 1, X, AF, 1, W, 1, INFO )
215       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
216       INFOT = 3
217       CALL CUNMQR( 'L''N'-100, A, 1, X, AF, 1, W, 1, INFO )
218       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
219       INFOT = 4
220       CALL CUNMQR( 'L''N'0-10, A, 1, X, AF, 1, W, 1, INFO )
221       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
222       INFOT = 5
223       CALL CUNMQR( 'L''N'00-1, A, 1, X, AF, 1, W, 1, INFO )
224       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
225       INFOT = 5
226       CALL CUNMQR( 'L''N'011, A, 1, X, AF, 1, W, 1, INFO )
227       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
228       INFOT = 5
229       CALL CUNMQR( 'R''N'101, A, 1, X, AF, 1, W, 1, INFO )
230       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
231       INFOT = 7
232       CALL CUNMQR( 'L''N'210, A, 1, X, AF, 2, W, 1, INFO )
233       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
234       INFOT = 7
235       CALL CUNMQR( 'R''N'120, A, 1, X, AF, 1, W, 1, INFO )
236       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
237       INFOT = 10
238       CALL CUNMQR( 'L''N'210, A, 2, X, AF, 1, W, 1, INFO )
239       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
240       INFOT = 12
241       CALL CUNMQR( 'L''N'120, A, 1, X, AF, 1, W, 1, INFO )
242       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
243       INFOT = 12
244       CALL CUNMQR( 'R''N'210, A, 1, X, AF, 2, W, 1, INFO )
245       CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK )
246 *
247 *     CUNM2R
248 *
249       SRNAMT = 'CUNM2R'
250       INFOT = 1
251       CALL CUNM2R( '/''N'000, A, 1, X, AF, 1, W, INFO )
252       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
253       INFOT = 2
254       CALL CUNM2R( 'L''/'000, A, 1, X, AF, 1, W, INFO )
255       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
256       INFOT = 3
257       CALL CUNM2R( 'L''N'-100, A, 1, X, AF, 1, W, INFO )
258       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
259       INFOT = 4
260       CALL CUNM2R( 'L''N'0-10, A, 1, X, AF, 1, W, INFO )
261       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
262       INFOT = 5
263       CALL CUNM2R( 'L''N'00-1, A, 1, X, AF, 1, W, INFO )
264       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
265       INFOT = 5
266       CALL CUNM2R( 'L''N'011, A, 1, X, AF, 1, W, INFO )
267       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
268       INFOT = 5
269       CALL CUNM2R( 'R''N'101, A, 1, X, AF, 1, W, INFO )
270       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
271       INFOT = 7
272       CALL CUNM2R( 'L''N'210, A, 1, X, AF, 2, W, INFO )
273       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
274       INFOT = 7
275       CALL CUNM2R( 'R''N'120, A, 1, X, AF, 1, W, INFO )
276       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
277       INFOT = 10
278       CALL CUNM2R( 'L''N'210, A, 2, X, AF, 1, W, INFO )
279       CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK )
280 *
281 *     Print a summary line.
282 *
283       CALL ALAESM( PATH, OK, NOUT )
284 *
285       RETURN
286 *
287 *     End of CERRQR
288 *
289       END