LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zerrrq.f
Go to the documentation of this file.
1 *> \brief \b ZERRRQ
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE ZERRRQ( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> ZERRRQ tests the error exits for the COMPLEX*16 routines
25 *> that use the RQ decomposition of a general matrix.
26 *> \endverbatim
27 *
28 * Arguments:
29 * ==========
30 *
31 *> \param[in] PATH
32 *> \verbatim
33 *> PATH is CHARACTER*3
34 *> The LAPACK path name for the routines to be tested.
35 *> \endverbatim
36 *>
37 *> \param[in] NUNIT
38 *> \verbatim
39 *> NUNIT is INTEGER
40 *> The unit number for output.
41 *> \endverbatim
42 *
43 * Authors:
44 * ========
45 *
46 *> \author Univ. of Tennessee
47 *> \author Univ. of California Berkeley
48 *> \author Univ. of Colorado Denver
49 *> \author NAG Ltd.
50 *
51 *> \date November 2011
52 *
53 *> \ingroup complex16_lin
54 *
55 * =====================================================================
56  SUBROUTINE zerrrq( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.4.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * November 2011
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 path
65  INTEGER nunit
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER nmax
72  parameter( nmax = 2 )
73 * ..
74 * .. Local Scalars ..
75  INTEGER i, info, j
76 * ..
77 * .. Local Arrays ..
78  COMPLEX*16 a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
79  $ w( nmax ), x( nmax )
80 * ..
81 * .. External Subroutines ..
82  EXTERNAL alaesm, chkxer, zgerq2, zgerqf, zgerqs, zungr2,
83  $ zungrq, zunmr2, zunmrq
84 * ..
85 * .. Scalars in Common ..
86  LOGICAL lerr, ok
87  CHARACTER*32 srnamt
88  INTEGER infot, nout
89 * ..
90 * .. Common blocks ..
91  common / infoc / infot, nout, ok, lerr
92  common / srnamc / srnamt
93 * ..
94 * .. Intrinsic Functions ..
95  INTRINSIC dble, dcmplx
96 * ..
97 * .. Executable Statements ..
98 *
99  nout = nunit
100  WRITE( nout, fmt = * )
101 *
102 * Set the variables to innocuous values.
103 *
104  DO 20 j = 1, nmax
105  DO 10 i = 1, nmax
106  a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
107  $ -1.d0 / dble( i+j ) )
108  af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
109  $ -1.d0 / dble( i+j ) )
110  10 continue
111  b( j ) = 0.d0
112  w( j ) = 0.d0
113  x( j ) = 0.d0
114  20 continue
115  ok = .true.
116 *
117 * Error exits for RQ factorization
118 *
119 * ZGERQF
120 *
121  srnamt = 'ZGERQF'
122  infot = 1
123  CALL zgerqf( -1, 0, a, 1, b, w, 1, info )
124  CALL chkxer( 'ZGERQF', infot, nout, lerr, ok )
125  infot = 2
126  CALL zgerqf( 0, -1, a, 1, b, w, 1, info )
127  CALL chkxer( 'ZGERQF', infot, nout, lerr, ok )
128  infot = 4
129  CALL zgerqf( 2, 1, a, 1, b, w, 2, info )
130  CALL chkxer( 'ZGERQF', infot, nout, lerr, ok )
131  infot = 7
132  CALL zgerqf( 2, 1, a, 2, b, w, 1, info )
133  CALL chkxer( 'ZGERQF', infot, nout, lerr, ok )
134 *
135 * ZGERQ2
136 *
137  srnamt = 'ZGERQ2'
138  infot = 1
139  CALL zgerq2( -1, 0, a, 1, b, w, info )
140  CALL chkxer( 'ZGERQ2', infot, nout, lerr, ok )
141  infot = 2
142  CALL zgerq2( 0, -1, a, 1, b, w, info )
143  CALL chkxer( 'ZGERQ2', infot, nout, lerr, ok )
144  infot = 4
145  CALL zgerq2( 2, 1, a, 1, b, w, info )
146  CALL chkxer( 'ZGERQ2', infot, nout, lerr, ok )
147 *
148 * ZGERQS
149 *
150  srnamt = 'ZGERQS'
151  infot = 1
152  CALL zgerqs( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
153  CALL chkxer( 'ZGERQS', infot, nout, lerr, ok )
154  infot = 2
155  CALL zgerqs( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
156  CALL chkxer( 'ZGERQS', infot, nout, lerr, ok )
157  infot = 2
158  CALL zgerqs( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
159  CALL chkxer( 'ZGERQS', infot, nout, lerr, ok )
160  infot = 3
161  CALL zgerqs( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
162  CALL chkxer( 'ZGERQS', infot, nout, lerr, ok )
163  infot = 5
164  CALL zgerqs( 2, 2, 0, a, 1, x, b, 2, w, 1, info )
165  CALL chkxer( 'ZGERQS', infot, nout, lerr, ok )
166  infot = 8
167  CALL zgerqs( 2, 2, 0, a, 2, x, b, 1, w, 1, info )
168  CALL chkxer( 'ZGERQS', infot, nout, lerr, ok )
169  infot = 10
170  CALL zgerqs( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
171  CALL chkxer( 'ZGERQS', infot, nout, lerr, ok )
172 *
173 * ZUNGRQ
174 *
175  srnamt = 'ZUNGRQ'
176  infot = 1
177  CALL zungrq( -1, 0, 0, a, 1, x, w, 1, info )
178  CALL chkxer( 'ZUNGRQ', infot, nout, lerr, ok )
179  infot = 2
180  CALL zungrq( 0, -1, 0, a, 1, x, w, 1, info )
181  CALL chkxer( 'ZUNGRQ', infot, nout, lerr, ok )
182  infot = 2
183  CALL zungrq( 2, 1, 0, a, 2, x, w, 2, info )
184  CALL chkxer( 'ZUNGRQ', infot, nout, lerr, ok )
185  infot = 3
186  CALL zungrq( 0, 0, -1, a, 1, x, w, 1, info )
187  CALL chkxer( 'ZUNGRQ', infot, nout, lerr, ok )
188  infot = 3
189  CALL zungrq( 1, 2, 2, a, 1, x, w, 1, info )
190  CALL chkxer( 'ZUNGRQ', infot, nout, lerr, ok )
191  infot = 5
192  CALL zungrq( 2, 2, 0, a, 1, x, w, 2, info )
193  CALL chkxer( 'ZUNGRQ', infot, nout, lerr, ok )
194  infot = 8
195  CALL zungrq( 2, 2, 0, a, 2, x, w, 1, info )
196  CALL chkxer( 'ZUNGRQ', infot, nout, lerr, ok )
197 *
198 * ZUNGR2
199 *
200  srnamt = 'ZUNGR2'
201  infot = 1
202  CALL zungr2( -1, 0, 0, a, 1, x, w, info )
203  CALL chkxer( 'ZUNGR2', infot, nout, lerr, ok )
204  infot = 2
205  CALL zungr2( 0, -1, 0, a, 1, x, w, info )
206  CALL chkxer( 'ZUNGR2', infot, nout, lerr, ok )
207  infot = 2
208  CALL zungr2( 2, 1, 0, a, 2, x, w, info )
209  CALL chkxer( 'ZUNGR2', infot, nout, lerr, ok )
210  infot = 3
211  CALL zungr2( 0, 0, -1, a, 1, x, w, info )
212  CALL chkxer( 'ZUNGR2', infot, nout, lerr, ok )
213  infot = 3
214  CALL zungr2( 1, 2, 2, a, 2, x, w, info )
215  CALL chkxer( 'ZUNGR2', infot, nout, lerr, ok )
216  infot = 5
217  CALL zungr2( 2, 2, 0, a, 1, x, w, info )
218  CALL chkxer( 'ZUNGR2', infot, nout, lerr, ok )
219 *
220 * ZUNMRQ
221 *
222  srnamt = 'ZUNMRQ'
223  infot = 1
224  CALL zunmrq( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
225  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
226  infot = 2
227  CALL zunmrq( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
228  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
229  infot = 3
230  CALL zunmrq( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
231  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
232  infot = 4
233  CALL zunmrq( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
234  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
235  infot = 5
236  CALL zunmrq( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
237  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
238  infot = 5
239  CALL zunmrq( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
240  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
241  infot = 5
242  CALL zunmrq( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
243  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
244  infot = 7
245  CALL zunmrq( 'L', 'N', 2, 1, 2, a, 1, x, af, 2, w, 1, info )
246  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
247  infot = 7
248  CALL zunmrq( 'R', 'N', 1, 2, 2, a, 1, x, af, 1, w, 1, info )
249  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
250  infot = 10
251  CALL zunmrq( 'L', 'N', 2, 1, 0, a, 1, x, af, 1, w, 1, info )
252  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
253  infot = 12
254  CALL zunmrq( 'L', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
255  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
256  infot = 12
257  CALL zunmrq( 'R', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
258  CALL chkxer( 'ZUNMRQ', infot, nout, lerr, ok )
259 *
260 * ZUNMR2
261 *
262  srnamt = 'ZUNMR2'
263  infot = 1
264  CALL zunmr2( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, info )
265  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
266  infot = 2
267  CALL zunmr2( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, info )
268  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
269  infot = 3
270  CALL zunmr2( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, info )
271  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
272  infot = 4
273  CALL zunmr2( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, info )
274  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
275  infot = 5
276  CALL zunmr2( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, info )
277  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
278  infot = 5
279  CALL zunmr2( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, info )
280  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
281  infot = 5
282  CALL zunmr2( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, info )
283  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
284  infot = 7
285  CALL zunmr2( 'L', 'N', 2, 1, 2, a, 1, x, af, 2, w, info )
286  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
287  infot = 7
288  CALL zunmr2( 'R', 'N', 1, 2, 2, a, 1, x, af, 1, w, info )
289  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
290  infot = 10
291  CALL zunmr2( 'L', 'N', 2, 1, 0, a, 1, x, af, 1, w, info )
292  CALL chkxer( 'ZUNMR2', infot, nout, lerr, ok )
293 *
294 * Print a summary line.
295 *
296  CALL alaesm( path, ok, nout )
297 *
298  return
299 *
300 * End of ZERRRQ
301 *
302  END