Home
Browse Files
  1       SUBROUTINE ZERRRQ( 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 *  ZERRRQ tests the error exits for the COMPLEX*16 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       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
 38      $                   W( NMAX ), X( NMAX )
 39 *     ..
 40 *     .. External Subroutines ..
 41       EXTERNAL           ALAESM, CHKXER, ZGERQ2, ZGERQF, ZGERQS, ZUNGR2,
 42      $                   ZUNGRQ, ZUNMR2, ZUNMRQ
 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          DBLE, DCMPLX
 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 ) = DCMPLX( 1.D0 / DBLE( I+J ),
 66      $                  -1.D0 / DBLE( I+J ) )
 67             AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
 68      $                   -1.D0 / DBLE( I+J ) )
 69    10    CONTINUE
 70          B( J ) = 0.D0
 71          W( J ) = 0.D0
 72          X( J ) = 0.D0
 73    20 CONTINUE
 74       OK = .TRUE.
 75 *
 76 *     Error exits for RQ factorization
 77 *
 78 *     ZGERQF
 79 *
 80       SRNAMT = 'ZGERQF'
 81       INFOT = 1
 82       CALL ZGERQF( -1, 0, A, 1, B, W, 1, INFO )
 83       CALL CHKXER( 'ZGERQF', INFOT, NOUT, LERR, OK )
 84       INFOT = 2
 85       CALL ZGERQF( 0, -1, A, 1, B, W, 1, INFO )
 86       CALL CHKXER( 'ZGERQF', INFOT, NOUT, LERR, OK )
 87       INFOT = 4
 88       CALL ZGERQF( 2, 1, A, 1, B, W, 2, INFO )
 89       CALL CHKXER( 'ZGERQF', INFOT, NOUT, LERR, OK )
 90       INFOT = 7
 91       CALL ZGERQF( 2, 1, A, 2, B, W, 1, INFO )
 92       CALL CHKXER( 'ZGERQF', INFOT, NOUT, LERR, OK )
 93 *
 94 *     ZGERQ2
 95 *
 96       SRNAMT = 'ZGERQ2'
 97       INFOT = 1
 98       CALL ZGERQ2( -1, 0, A, 1, B, W, INFO )
 99       CALL CHKXER( 'ZGERQ2', INFOT, NOUT, LERR, OK )
100       INFOT = 2
101       CALL ZGERQ2( 0, -1, A, 1, B, W, INFO )
102       CALL CHKXER( 'ZGERQ2', INFOT, NOUT, LERR, OK )
103       INFOT = 4
104       CALL ZGERQ2( 2, 1, A, 1, B, W, INFO )
105       CALL CHKXER( 'ZGERQ2', INFOT, NOUT, LERR, OK )
106 *
107 *     ZGERQS
108 *
109       SRNAMT = 'ZGERQS'
110       INFOT = 1
111       CALL ZGERQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
112       CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK )
113       INFOT = 2
114       CALL ZGERQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
115       CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK )
116       INFOT = 2
117       CALL ZGERQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
118       CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK )
119       INFOT = 3
120       CALL ZGERQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
121       CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK )
122       INFOT = 5
123       CALL ZGERQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO )
124       CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK )
125       INFOT = 8
126       CALL ZGERQS( 2, 2, 0, A, 2, X, B, 1, W, 1, INFO )
127       CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK )
128       INFOT = 10
129       CALL ZGERQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
130       CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK )
131 *
132 *     ZUNGRQ
133 *
134       SRNAMT = 'ZUNGRQ'
135       INFOT = 1
136       CALL ZUNGRQ( -1, 0, 0, A, 1, X, W, 1, INFO )
137       CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK )
138       INFOT = 2
139       CALL ZUNGRQ( 0, -1, 0, A, 1, X, W, 1, INFO )
140       CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK )
141       INFOT = 2
142       CALL ZUNGRQ( 2, 1, 0, A, 2, X, W, 2, INFO )
143       CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK )
144       INFOT = 3
145       CALL ZUNGRQ( 0, 0, -1, A, 1, X, W, 1, INFO )
146       CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK )
147       INFOT = 3
148       CALL ZUNGRQ( 1, 2, 2, A, 1, X, W, 1, INFO )
149       CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK )
150       INFOT = 5
151       CALL ZUNGRQ( 2, 2, 0, A, 1, X, W, 2, INFO )
152       CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK )
153       INFOT = 8
154       CALL ZUNGRQ( 2, 2, 0, A, 2, X, W, 1, INFO )
155       CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK )
156 *
157 *     ZUNGR2
158 *
159       SRNAMT = 'ZUNGR2'
160       INFOT = 1
161       CALL ZUNGR2( -1, 0, 0, A, 1, X, W, INFO )
162       CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK )
163       INFOT = 2
164       CALL ZUNGR2( 0, -1, 0, A, 1, X, W, INFO )
165       CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK )
166       INFOT = 2
167       CALL ZUNGR2( 2, 1, 0, A, 2, X, W, INFO )
168       CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK )
169       INFOT = 3
170       CALL ZUNGR2( 0, 0, -1, A, 1, X, W, INFO )
171       CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK )
172       INFOT = 3
173       CALL ZUNGR2( 1, 2, 2, A, 2, X, W, INFO )
174       CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK )
175       INFOT = 5
176       CALL ZUNGR2( 2, 2, 0, A, 1, X, W, INFO )
177       CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK )
178 *
179 *     ZUNMRQ
180 *
181       SRNAMT = 'ZUNMRQ'
182       INFOT = 1
183       CALL ZUNMRQ( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
184       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
185       INFOT = 2
186       CALL ZUNMRQ( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
187       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
188       INFOT = 3
189       CALL ZUNMRQ( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
190       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
191       INFOT = 4
192       CALL ZUNMRQ( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO )
193       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
194       INFOT = 5
195       CALL ZUNMRQ( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO )
196       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
197       INFOT = 5
198       CALL ZUNMRQ( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO )
199       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
200       INFOT = 5
201       CALL ZUNMRQ( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO )
202       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
203       INFOT = 7
204       CALL ZUNMRQ( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, 1, INFO )
205       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
206       INFOT = 7
207       CALL ZUNMRQ( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, 1, INFO )
208       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
209       INFOT = 10
210       CALL ZUNMRQ( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, 1, INFO )
211       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
212       INFOT = 12
213       CALL ZUNMRQ( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
214       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
215       INFOT = 12
216       CALL ZUNMRQ( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
217       CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK )
218 *
219 *     ZUNMR2
220 *
221       SRNAMT = 'ZUNMR2'
222       INFOT = 1
223       CALL ZUNMR2( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
224       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
225       INFOT = 2
226       CALL ZUNMR2( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
227       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
228       INFOT = 3
229       CALL ZUNMR2( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO )
230       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
231       INFOT = 4
232       CALL ZUNMR2( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO )
233       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
234       INFOT = 5
235       CALL ZUNMR2( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO )
236       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
237       INFOT = 5
238       CALL ZUNMR2( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO )
239       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
240       INFOT = 5
241       CALL ZUNMR2( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO )
242       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
243       INFOT = 7
244       CALL ZUNMR2( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, INFO )
245       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
246       INFOT = 7
247       CALL ZUNMR2( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, INFO )
248       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
249       INFOT = 10
250       CALL ZUNMR2( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, INFO )
251       CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK )
252 *
253 *     Print a summary line.
254 *
255       CALL ALAESM( PATH, OK, NOUT )
256 *
257       RETURN
258 *
259 *     End of ZERRRQ
260 *
261       END
Home