LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
serrqr.f
Go to the documentation of this file.
1 *> \brief \b SERRQR
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 SERRQR( 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 *> SERRQR tests the error exits for the REAL routines
25 *> that use the QR 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 single_lin
54 *
55 * =====================================================================
56  SUBROUTINE serrqr( 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  REAL a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
79  $ w( nmax ), x( nmax )
80 * ..
81 * .. External Subroutines ..
82  EXTERNAL alaesm, chkxer, sgeqr2, sgeqr2p, sgeqrf,
83  $ sgeqrfp, sgeqrs, sorg2r, sorgqr, sorm2r,
84  $ sormqr
85 * ..
86 * .. Scalars in Common ..
87  LOGICAL lerr, ok
88  CHARACTER*32 srnamt
89  INTEGER infot, nout
90 * ..
91 * .. Common blocks ..
92  common / infoc / infot, nout, ok, lerr
93  common / srnamc / srnamt
94 * ..
95 * .. Intrinsic Functions ..
96  INTRINSIC real
97 * ..
98 * .. Executable Statements ..
99 *
100  nout = nunit
101  WRITE( nout, fmt = * )
102 *
103 * Set the variables to innocuous values.
104 *
105  DO 20 j = 1, nmax
106  DO 10 i = 1, nmax
107  a( i, j ) = 1. / REAL( i+j )
108  af( i, j ) = 1. / REAL( i+j )
109  10 continue
110  b( j ) = 0.
111  w( j ) = 0.
112  x( j ) = 0.
113  20 continue
114  ok = .true.
115 *
116 * Error exits for QR factorization
117 *
118 * SGEQRF
119 *
120  srnamt = 'SGEQRF'
121  infot = 1
122  CALL sgeqrf( -1, 0, a, 1, b, w, 1, info )
123  CALL chkxer( 'SGEQRF', infot, nout, lerr, ok )
124  infot = 2
125  CALL sgeqrf( 0, -1, a, 1, b, w, 1, info )
126  CALL chkxer( 'SGEQRF', infot, nout, lerr, ok )
127  infot = 4
128  CALL sgeqrf( 2, 1, a, 1, b, w, 1, info )
129  CALL chkxer( 'SGEQRF', infot, nout, lerr, ok )
130  infot = 7
131  CALL sgeqrf( 1, 2, a, 1, b, w, 1, info )
132  CALL chkxer( 'SGEQRF', infot, nout, lerr, ok )
133 *
134 * SGEQRFP
135 *
136  srnamt = 'SGEQRFP'
137  infot = 1
138  CALL sgeqrfp( -1, 0, a, 1, b, w, 1, info )
139  CALL chkxer( 'SGEQRFP', infot, nout, lerr, ok )
140  infot = 2
141  CALL sgeqrfp( 0, -1, a, 1, b, w, 1, info )
142  CALL chkxer( 'SGEQRFP', infot, nout, lerr, ok )
143  infot = 4
144  CALL sgeqrfp( 2, 1, a, 1, b, w, 1, info )
145  CALL chkxer( 'SGEQRFP', infot, nout, lerr, ok )
146  infot = 7
147  CALL sgeqrfp( 1, 2, a, 1, b, w, 1, info )
148  CALL chkxer( 'SGEQRFP', infot, nout, lerr, ok )
149 *
150 * SGEQR2
151 *
152  srnamt = 'SGEQR2'
153  infot = 1
154  CALL sgeqr2( -1, 0, a, 1, b, w, info )
155  CALL chkxer( 'SGEQR2', infot, nout, lerr, ok )
156  infot = 2
157  CALL sgeqr2( 0, -1, a, 1, b, w, info )
158  CALL chkxer( 'SGEQR2', infot, nout, lerr, ok )
159  infot = 4
160  CALL sgeqr2( 2, 1, a, 1, b, w, info )
161  CALL chkxer( 'SGEQR2', infot, nout, lerr, ok )
162 *
163 * SGEQR2P
164 *
165  srnamt = 'SGEQR2P'
166  infot = 1
167  CALL sgeqr2p( -1, 0, a, 1, b, w, info )
168  CALL chkxer( 'SGEQR2P', infot, nout, lerr, ok )
169  infot = 2
170  CALL sgeqr2p( 0, -1, a, 1, b, w, info )
171  CALL chkxer( 'SGEQR2P', infot, nout, lerr, ok )
172  infot = 4
173  CALL sgeqr2p( 2, 1, a, 1, b, w, info )
174  CALL chkxer( 'SGEQR2P', infot, nout, lerr, ok )
175 *
176 * SGEQRS
177 *
178  srnamt = 'SGEQRS'
179  infot = 1
180  CALL sgeqrs( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
181  CALL chkxer( 'SGEQRS', infot, nout, lerr, ok )
182  infot = 2
183  CALL sgeqrs( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
184  CALL chkxer( 'SGEQRS', infot, nout, lerr, ok )
185  infot = 2
186  CALL sgeqrs( 1, 2, 0, a, 2, x, b, 2, w, 1, info )
187  CALL chkxer( 'SGEQRS', infot, nout, lerr, ok )
188  infot = 3
189  CALL sgeqrs( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
190  CALL chkxer( 'SGEQRS', infot, nout, lerr, ok )
191  infot = 5
192  CALL sgeqrs( 2, 1, 0, a, 1, x, b, 2, w, 1, info )
193  CALL chkxer( 'SGEQRS', infot, nout, lerr, ok )
194  infot = 8
195  CALL sgeqrs( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
196  CALL chkxer( 'SGEQRS', infot, nout, lerr, ok )
197  infot = 10
198  CALL sgeqrs( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
199  CALL chkxer( 'SGEQRS', infot, nout, lerr, ok )
200 *
201 * SORGQR
202 *
203  srnamt = 'SORGQR'
204  infot = 1
205  CALL sorgqr( -1, 0, 0, a, 1, x, w, 1, info )
206  CALL chkxer( 'SORGQR', infot, nout, lerr, ok )
207  infot = 2
208  CALL sorgqr( 0, -1, 0, a, 1, x, w, 1, info )
209  CALL chkxer( 'SORGQR', infot, nout, lerr, ok )
210  infot = 2
211  CALL sorgqr( 1, 2, 0, a, 1, x, w, 2, info )
212  CALL chkxer( 'SORGQR', infot, nout, lerr, ok )
213  infot = 3
214  CALL sorgqr( 0, 0, -1, a, 1, x, w, 1, info )
215  CALL chkxer( 'SORGQR', infot, nout, lerr, ok )
216  infot = 3
217  CALL sorgqr( 1, 1, 2, a, 1, x, w, 1, info )
218  CALL chkxer( 'SORGQR', infot, nout, lerr, ok )
219  infot = 5
220  CALL sorgqr( 2, 2, 0, a, 1, x, w, 2, info )
221  CALL chkxer( 'SORGQR', infot, nout, lerr, ok )
222  infot = 8
223  CALL sorgqr( 2, 2, 0, a, 2, x, w, 1, info )
224  CALL chkxer( 'SORGQR', infot, nout, lerr, ok )
225 *
226 * SORG2R
227 *
228  srnamt = 'SORG2R'
229  infot = 1
230  CALL sorg2r( -1, 0, 0, a, 1, x, w, info )
231  CALL chkxer( 'SORG2R', infot, nout, lerr, ok )
232  infot = 2
233  CALL sorg2r( 0, -1, 0, a, 1, x, w, info )
234  CALL chkxer( 'SORG2R', infot, nout, lerr, ok )
235  infot = 2
236  CALL sorg2r( 1, 2, 0, a, 1, x, w, info )
237  CALL chkxer( 'SORG2R', infot, nout, lerr, ok )
238  infot = 3
239  CALL sorg2r( 0, 0, -1, a, 1, x, w, info )
240  CALL chkxer( 'SORG2R', infot, nout, lerr, ok )
241  infot = 3
242  CALL sorg2r( 2, 1, 2, a, 2, x, w, info )
243  CALL chkxer( 'SORG2R', infot, nout, lerr, ok )
244  infot = 5
245  CALL sorg2r( 2, 1, 0, a, 1, x, w, info )
246  CALL chkxer( 'SORG2R', infot, nout, lerr, ok )
247 *
248 * SORMQR
249 *
250  srnamt = 'SORMQR'
251  infot = 1
252  CALL sormqr( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
253  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
254  infot = 2
255  CALL sormqr( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
256  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
257  infot = 3
258  CALL sormqr( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
259  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
260  infot = 4
261  CALL sormqr( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
262  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
263  infot = 5
264  CALL sormqr( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
265  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
266  infot = 5
267  CALL sormqr( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
268  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
269  infot = 5
270  CALL sormqr( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
271  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
272  infot = 7
273  CALL sormqr( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
274  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
275  infot = 7
276  CALL sormqr( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
277  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
278  infot = 10
279  CALL sormqr( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, 1, info )
280  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
281  infot = 12
282  CALL sormqr( 'L', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
283  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
284  infot = 12
285  CALL sormqr( 'R', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
286  CALL chkxer( 'SORMQR', infot, nout, lerr, ok )
287 *
288 * SORM2R
289 *
290  srnamt = 'SORM2R'
291  infot = 1
292  CALL sorm2r( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, info )
293  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
294  infot = 2
295  CALL sorm2r( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, info )
296  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
297  infot = 3
298  CALL sorm2r( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, info )
299  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
300  infot = 4
301  CALL sorm2r( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, info )
302  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
303  infot = 5
304  CALL sorm2r( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, info )
305  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
306  infot = 5
307  CALL sorm2r( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, info )
308  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
309  infot = 5
310  CALL sorm2r( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, info )
311  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
312  infot = 7
313  CALL sorm2r( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, info )
314  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
315  infot = 7
316  CALL sorm2r( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, info )
317  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
318  infot = 10
319  CALL sorm2r( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, info )
320  CALL chkxer( 'SORM2R', infot, nout, lerr, ok )
321 *
322 * Print a summary line.
323 *
324  CALL alaesm( path, ok, nout )
325 *
326  return
327 *
328 * End of SERRQR
329 *
330  END