1       SUBROUTINE SERRQR( 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 *  SERRQR tests the error exits for the REAL 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       REAL               A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
 38      $                   W( NMAX ), X( NMAX )
 39 *     ..
 40 *     .. External Subroutines ..
 41       EXTERNAL           ALAESM, CHKXER, SGEQR2, SGEQR2P, SGEQRF,
 42      $                   SGEQRFP, SGEQRS, SORG2R, SORGQR, SORM2R,
 43      $                   SORMQR
 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          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 ) = 1/ REAL( I+J )
 67             AF( 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 *     SGEQRF
 78 *
 79       SRNAMT = 'SGEQRF'
 80       INFOT = 1
 81       CALL SGEQRF( -10, A, 1, B, W, 1, INFO )
 82       CALL CHKXER( 'SGEQRF', INFOT, NOUT, LERR, OK )
 83       INFOT = 2
 84       CALL SGEQRF( 0-1, A, 1, B, W, 1, INFO )
 85       CALL CHKXER( 'SGEQRF', INFOT, NOUT, LERR, OK )
 86       INFOT = 4
 87       CALL SGEQRF( 21, A, 1, B, W, 1, INFO )
 88       CALL CHKXER( 'SGEQRF', INFOT, NOUT, LERR, OK )
 89       INFOT = 7
 90       CALL SGEQRF( 12, A, 1, B, W, 1, INFO )
 91       CALL CHKXER( 'SGEQRF', INFOT, NOUT, LERR, OK )
 92 *
 93 *     SGEQRFP
 94 *
 95       SRNAMT = 'SGEQRFP'
 96       INFOT = 1
 97       CALL SGEQRFP( -10, A, 1, B, W, 1, INFO )
 98       CALL CHKXER( 'SGEQRFP', INFOT, NOUT, LERR, OK )
 99       INFOT = 2
100       CALL SGEQRFP( 0-1, A, 1, B, W, 1, INFO )
101       CALL CHKXER( 'SGEQRFP', INFOT, NOUT, LERR, OK )
102       INFOT = 4
103       CALL SGEQRFP( 21, A, 1, B, W, 1, INFO )
104       CALL CHKXER( 'SGEQRFP', INFOT, NOUT, LERR, OK )
105       INFOT = 7
106       CALL SGEQRFP( 12, A, 1, B, W, 1, INFO )
107       CALL CHKXER( 'SGEQRFP', INFOT, NOUT, LERR, OK )
108 *
109 *     SGEQR2
110 *
111       SRNAMT = 'SGEQR2'
112       INFOT = 1
113       CALL SGEQR2( -10, A, 1, B, W, INFO )
114       CALL CHKXER( 'SGEQR2', INFOT, NOUT, LERR, OK )
115       INFOT = 2
116       CALL SGEQR2( 0-1, A, 1, B, W, INFO )
117       CALL CHKXER( 'SGEQR2', INFOT, NOUT, LERR, OK )
118       INFOT = 4
119       CALL SGEQR2( 21, A, 1, B, W, INFO )
120       CALL CHKXER( 'SGEQR2', INFOT, NOUT, LERR, OK )
121 *
122 *     SGEQR2P
123 *
124       SRNAMT = 'SGEQR2P'
125       INFOT = 1
126       CALL SGEQR2P( -10, A, 1, B, W, INFO )
127       CALL CHKXER( 'SGEQR2P', INFOT, NOUT, LERR, OK )
128       INFOT = 2
129       CALL SGEQR2P( 0-1, A, 1, B, W, INFO )
130       CALL CHKXER( 'SGEQR2P', INFOT, NOUT, LERR, OK )
131       INFOT = 4
132       CALL SGEQR2P( 21, A, 1, B, W, INFO )
133       CALL CHKXER( 'SGEQR2P', INFOT, NOUT, LERR, OK )
134 *
135 *     SGEQRS
136 *
137       SRNAMT = 'SGEQRS'
138       INFOT = 1
139       CALL SGEQRS( -100, A, 1, X, B, 1, W, 1, INFO )
140       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
141       INFOT = 2
142       CALL SGEQRS( 0-10, A, 1, X, B, 1, W, 1, INFO )
143       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
144       INFOT = 2
145       CALL SGEQRS( 120, A, 2, X, B, 2, W, 1, INFO )
146       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
147       INFOT = 3
148       CALL SGEQRS( 00-1, A, 1, X, B, 1, W, 1, INFO )
149       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
150       INFOT = 5
151       CALL SGEQRS( 210, A, 1, X, B, 2, W, 1, INFO )
152       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
153       INFOT = 8
154       CALL SGEQRS( 210, A, 2, X, B, 1, W, 1, INFO )
155       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
156       INFOT = 10
157       CALL SGEQRS( 112, A, 1, X, B, 1, W, 1, INFO )
158       CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
159 *
160 *     SORGQR
161 *
162       SRNAMT = 'SORGQR'
163       INFOT = 1
164       CALL SORGQR( -100, A, 1, X, W, 1, INFO )
165       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
166       INFOT = 2
167       CALL SORGQR( 0-10, A, 1, X, W, 1, INFO )
168       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
169       INFOT = 2
170       CALL SORGQR( 120, A, 1, X, W, 2, INFO )
171       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
172       INFOT = 3
173       CALL SORGQR( 00-1, A, 1, X, W, 1, INFO )
174       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
175       INFOT = 3
176       CALL SORGQR( 112, A, 1, X, W, 1, INFO )
177       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
178       INFOT = 5
179       CALL SORGQR( 220, A, 1, X, W, 2, INFO )
180       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
181       INFOT = 8
182       CALL SORGQR( 220, A, 2, X, W, 1, INFO )
183       CALL CHKXER( 'SORGQR', INFOT, NOUT, LERR, OK )
184 *
185 *     SORG2R
186 *
187       SRNAMT = 'SORG2R'
188       INFOT = 1
189       CALL SORG2R( -100, A, 1, X, W, INFO )
190       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
191       INFOT = 2
192       CALL SORG2R( 0-10, A, 1, X, W, INFO )
193       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
194       INFOT = 2
195       CALL SORG2R( 120, A, 1, X, W, INFO )
196       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
197       INFOT = 3
198       CALL SORG2R( 00-1, A, 1, X, W, INFO )
199       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
200       INFOT = 3
201       CALL SORG2R( 212, A, 2, X, W, INFO )
202       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
203       INFOT = 5
204       CALL SORG2R( 210, A, 1, X, W, INFO )
205       CALL CHKXER( 'SORG2R', INFOT, NOUT, LERR, OK )
206 *
207 *     SORMQR
208 *
209       SRNAMT = 'SORMQR'
210       INFOT = 1
211       CALL SORMQR( '/''N'000, A, 1, X, AF, 1, W, 1, INFO )
212       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
213       INFOT = 2
214       CALL SORMQR( 'L''/'000, A, 1, X, AF, 1, W, 1, INFO )
215       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
216       INFOT = 3
217       CALL SORMQR( 'L''N'-100, A, 1, X, AF, 1, W, 1, INFO )
218       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
219       INFOT = 4
220       CALL SORMQR( 'L''N'0-10, A, 1, X, AF, 1, W, 1, INFO )
221       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
222       INFOT = 5
223       CALL SORMQR( 'L''N'00-1, A, 1, X, AF, 1, W, 1, INFO )
224       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
225       INFOT = 5
226       CALL SORMQR( 'L''N'011, A, 1, X, AF, 1, W, 1, INFO )
227       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
228       INFOT = 5
229       CALL SORMQR( 'R''N'101, A, 1, X, AF, 1, W, 1, INFO )
230       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
231       INFOT = 7
232       CALL SORMQR( 'L''N'210, A, 1, X, AF, 2, W, 1, INFO )
233       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
234       INFOT = 7
235       CALL SORMQR( 'R''N'120, A, 1, X, AF, 1, W, 1, INFO )
236       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
237       INFOT = 10
238       CALL SORMQR( 'L''N'210, A, 2, X, AF, 1, W, 1, INFO )
239       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
240       INFOT = 12
241       CALL SORMQR( 'L''N'120, A, 1, X, AF, 1, W, 1, INFO )
242       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
243       INFOT = 12
244       CALL SORMQR( 'R''N'210, A, 1, X, AF, 2, W, 1, INFO )
245       CALL CHKXER( 'SORMQR', INFOT, NOUT, LERR, OK )
246 *
247 *     SORM2R
248 *
249       SRNAMT = 'SORM2R'
250       INFOT = 1
251       CALL SORM2R( '/''N'000, A, 1, X, AF, 1, W, INFO )
252       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
253       INFOT = 2
254       CALL SORM2R( 'L''/'000, A, 1, X, AF, 1, W, INFO )
255       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
256       INFOT = 3
257       CALL SORM2R( 'L''N'-100, A, 1, X, AF, 1, W, INFO )
258       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
259       INFOT = 4
260       CALL SORM2R( 'L''N'0-10, A, 1, X, AF, 1, W, INFO )
261       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
262       INFOT = 5
263       CALL SORM2R( 'L''N'00-1, A, 1, X, AF, 1, W, INFO )
264       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
265       INFOT = 5
266       CALL SORM2R( 'L''N'011, A, 1, X, AF, 1, W, INFO )
267       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
268       INFOT = 5
269       CALL SORM2R( 'R''N'101, A, 1, X, AF, 1, W, INFO )
270       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
271       INFOT = 7
272       CALL SORM2R( 'L''N'210, A, 1, X, AF, 2, W, INFO )
273       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
274       INFOT = 7
275       CALL SORM2R( 'R''N'120, A, 1, X, AF, 1, W, INFO )
276       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
277       INFOT = 10
278       CALL SORM2R( 'L''N'210, A, 2, X, AF, 1, W, INFO )
279       CALL CHKXER( 'SORM2R', INFOT, NOUT, LERR, OK )
280 *
281 *     Print a summary line.
282 *
283       CALL ALAESM( PATH, OK, NOUT )
284 *
285       RETURN
286 *
287 *     End of SERRQR
288 *
289       END