1       SUBROUTINE SERRRQ( PATH, NUNIT )
  2 *
  3 *  -- LAPACK test routine (version 3.1) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *     November 2006
  6 *
  7 *     .. Scalar Arguments ..
  8       CHARACTER*3        PATH
  9       INTEGER            NUNIT
 10 *     ..
 11 *
 12 *  Purpose
 13 *  =======
 14 *
 15 *  SERRRQ tests the error exits for the REAL routines
 16 *  that use the RQ 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, SGERQ2, SGERQF, SGERQS, SORGR2,
 42      $                   SORGRQ, SORMR2, SORMRQ
 43 *     ..
 44 *     .. Scalars in Common ..
 45       LOGICAL            LERR, OK
 46       CHARACTER*32       SRNAMT
 47       INTEGER            INFOT, NOUT
 48 *     ..
 49 *     .. Common blocks ..
 50       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 51       COMMON             / SRNAMC / SRNAMT
 52 *     ..
 53 *     .. Intrinsic Functions ..
 54       INTRINSIC          REAL
 55 *     ..
 56 *     .. Executable Statements ..
 57 *
 58       NOUT = NUNIT
 59       WRITE( NOUT, FMT = * )
 60 *
 61 *     Set the variables to innocuous values.
 62 *
 63       DO 20 J = 1, NMAX
 64          DO 10 I = 1, NMAX
 65             A( I, J ) = 1/ REAL( I+J )
 66             AF( I, J ) = 1/ REAL( I+J )
 67    10    CONTINUE
 68          B( J ) = 0.
 69          W( J ) = 0.
 70          X( J ) = 0.
 71    20 CONTINUE
 72       OK = .TRUE.
 73 *
 74 *     Error exits for RQ factorization
 75 *
 76 *     SGERQF
 77 *
 78       SRNAMT = 'SGERQF'
 79       INFOT = 1
 80       CALL SGERQF( -10, A, 1, B, W, 1, INFO )
 81       CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK )
 82       INFOT = 2
 83       CALL SGERQF( 0-1, A, 1, B, W, 1, INFO )
 84       CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK )
 85       INFOT = 4
 86       CALL SGERQF( 21, A, 1, B, W, 2, INFO )
 87       CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK )
 88       INFOT = 7
 89       CALL SGERQF( 21, A, 2, B, W, 1, INFO )
 90       CALL CHKXER( 'SGERQF', INFOT, NOUT, LERR, OK )
 91 *
 92 *     SGERQ2
 93 *
 94       SRNAMT = 'SGERQ2'
 95       INFOT = 1
 96       CALL SGERQ2( -10, A, 1, B, W, INFO )
 97       CALL CHKXER( 'SGERQ2', INFOT, NOUT, LERR, OK )
 98       INFOT = 2
 99       CALL SGERQ2( 0-1, A, 1, B, W, INFO )
100       CALL CHKXER( 'SGERQ2', INFOT, NOUT, LERR, OK )
101       INFOT = 4
102       CALL SGERQ2( 21, A, 1, B, W, INFO )
103       CALL CHKXER( 'SGERQ2', INFOT, NOUT, LERR, OK )
104 *
105 *     SGERQS
106 *
107       SRNAMT = 'SGERQS'
108       INFOT = 1
109       CALL SGERQS( -100, A, 1, X, B, 1, W, 1, INFO )
110       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
111       INFOT = 2
112       CALL SGERQS( 0-10, A, 1, X, B, 1, W, 1, INFO )
113       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
114       INFOT = 2
115       CALL SGERQS( 210, A, 2, X, B, 1, W, 1, INFO )
116       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
117       INFOT = 3
118       CALL SGERQS( 00-1, A, 1, X, B, 1, W, 1, INFO )
119       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
120       INFOT = 5
121       CALL SGERQS( 220, A, 1, X, B, 2, W, 1, INFO )
122       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
123       INFOT = 8
124       CALL SGERQS( 220, A, 2, X, B, 1, W, 1, INFO )
125       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
126       INFOT = 10
127       CALL SGERQS( 112, A, 1, X, B, 1, W, 1, INFO )
128       CALL CHKXER( 'SGERQS', INFOT, NOUT, LERR, OK )
129 *
130 *     SORGRQ
131 *
132       SRNAMT = 'SORGRQ'
133       INFOT = 1
134       CALL SORGRQ( -100, A, 1, X, W, 1, INFO )
135       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
136       INFOT = 2
137       CALL SORGRQ( 0-10, A, 1, X, W, 1, INFO )
138       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
139       INFOT = 2
140       CALL SORGRQ( 210, A, 2, X, W, 2, INFO )
141       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
142       INFOT = 3
143       CALL SORGRQ( 00-1, A, 1, X, W, 1, INFO )
144       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
145       INFOT = 3
146       CALL SORGRQ( 122, A, 1, X, W, 1, INFO )
147       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
148       INFOT = 5
149       CALL SORGRQ( 220, A, 1, X, W, 2, INFO )
150       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
151       INFOT = 8
152       CALL SORGRQ( 220, A, 2, X, W, 1, INFO )
153       CALL CHKXER( 'SORGRQ', INFOT, NOUT, LERR, OK )
154 *
155 *     SORGR2
156 *
157       SRNAMT = 'SORGR2'
158       INFOT = 1
159       CALL SORGR2( -100, A, 1, X, W, INFO )
160       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
161       INFOT = 2
162       CALL SORGR2( 0-10, A, 1, X, W, INFO )
163       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
164       INFOT = 2
165       CALL SORGR2( 210, A, 2, X, W, INFO )
166       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
167       INFOT = 3
168       CALL SORGR2( 00-1, A, 1, X, W, INFO )
169       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
170       INFOT = 3
171       CALL SORGR2( 122, A, 2, X, W, INFO )
172       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
173       INFOT = 5
174       CALL SORGR2( 220, A, 1, X, W, INFO )
175       CALL CHKXER( 'SORGR2', INFOT, NOUT, LERR, OK )
176 *
177 *     SORMRQ
178 *
179       SRNAMT = 'SORMRQ'
180       INFOT = 1
181       CALL SORMRQ( '/''N'000, A, 1, X, AF, 1, W, 1, INFO )
182       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
183       INFOT = 2
184       CALL SORMRQ( 'L''/'000, A, 1, X, AF, 1, W, 1, INFO )
185       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
186       INFOT = 3
187       CALL SORMRQ( 'L''N'-100, A, 1, X, AF, 1, W, 1, INFO )
188       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
189       INFOT = 4
190       CALL SORMRQ( 'L''N'0-10, A, 1, X, AF, 1, W, 1, INFO )
191       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
192       INFOT = 5
193       CALL SORMRQ( 'L''N'00-1, A, 1, X, AF, 1, W, 1, INFO )
194       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
195       INFOT = 5
196       CALL SORMRQ( 'L''N'011, A, 1, X, AF, 1, W, 1, INFO )
197       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
198       INFOT = 5
199       CALL SORMRQ( 'R''N'101, A, 1, X, AF, 1, W, 1, INFO )
200       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
201       INFOT = 7
202       CALL SORMRQ( 'L''N'212, A, 1, X, AF, 2, W, 1, INFO )
203       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
204       INFOT = 7
205       CALL SORMRQ( 'R''N'122, A, 1, X, AF, 1, W, 1, INFO )
206       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
207       INFOT = 10
208       CALL SORMRQ( 'L''N'210, A, 1, X, AF, 1, W, 1, INFO )
209       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
210       INFOT = 12
211       CALL SORMRQ( 'L''N'120, A, 1, X, AF, 1, W, 1, INFO )
212       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
213       INFOT = 12
214       CALL SORMRQ( 'R''N'210, A, 1, X, AF, 2, W, 1, INFO )
215       CALL CHKXER( 'SORMRQ', INFOT, NOUT, LERR, OK )
216 *
217 *     SORMR2
218 *
219       SRNAMT = 'SORMR2'
220       INFOT = 1
221       CALL SORMR2( '/''N'000, A, 1, X, AF, 1, W, INFO )
222       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
223       INFOT = 2
224       CALL SORMR2( 'L''/'000, A, 1, X, AF, 1, W, INFO )
225       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
226       INFOT = 3
227       CALL SORMR2( 'L''N'-100, A, 1, X, AF, 1, W, INFO )
228       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
229       INFOT = 4
230       CALL SORMR2( 'L''N'0-10, A, 1, X, AF, 1, W, INFO )
231       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
232       INFOT = 5
233       CALL SORMR2( 'L''N'00-1, A, 1, X, AF, 1, W, INFO )
234       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
235       INFOT = 5
236       CALL SORMR2( 'L''N'011, A, 1, X, AF, 1, W, INFO )
237       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
238       INFOT = 5
239       CALL SORMR2( 'R''N'101, A, 1, X, AF, 1, W, INFO )
240       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
241       INFOT = 7
242       CALL SORMR2( 'L''N'212, A, 1, X, AF, 2, W, INFO )
243       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
244       INFOT = 7
245       CALL SORMR2( 'R''N'122, A, 1, X, AF, 1, W, INFO )
246       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
247       INFOT = 10
248       CALL SORMR2( 'L''N'210, A, 1, X, AF, 1, W, INFO )
249       CALL CHKXER( 'SORMR2', INFOT, NOUT, LERR, OK )
250 *
251 *     Print a summary line.
252 *
253       CALL ALAESM( PATH, OK, NOUT )
254 *
255       RETURN
256 *
257 *     End of SERRRQ
258 *
259       END