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