LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
serrlq.f
Go to the documentation of this file.
1 *> \brief \b SERRLQ
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 SERRLQ( 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 *> SERRLQ tests the error exits for the REAL routines
25 *> that use the LQ 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 *> \ingroup single_lin
52 *
53 * =====================================================================
54  SUBROUTINE serrlq( PATH, NUNIT )
55 *
56 * -- LAPACK test routine --
57 * -- LAPACK is a software package provided by Univ. of Tennessee, --
58 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59 *
60 * .. Scalar Arguments ..
61  CHARACTER*3 PATH
62  INTEGER NUNIT
63 * ..
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68  INTEGER NMAX
69  parameter( nmax = 2 )
70 * ..
71 * .. Local Scalars ..
72  INTEGER I, INFO, J
73 * ..
74 * .. Local Arrays ..
75  REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
76  $ W( NMAX ), X( NMAX )
77 * ..
78 * .. External Subroutines ..
79  EXTERNAL alaesm, chkxer, sgelq2, sgelqf, sgelqs, sorgl2,
80  $ sorglq, sorml2, sormlq
81 * ..
82 * .. Scalars in Common ..
83  LOGICAL LERR, OK
84  CHARACTER*32 SRNAMT
85  INTEGER INFOT, NOUT
86 * ..
87 * .. Common blocks ..
88  COMMON / infoc / infot, nout, ok, lerr
89  COMMON / srnamc / srnamt
90 * ..
91 * .. Intrinsic Functions ..
92  INTRINSIC real
93 * ..
94 * .. Executable Statements ..
95 *
96  nout = nunit
97  WRITE( nout, fmt = * )
98 *
99 * Set the variables to innocuous values.
100 *
101  DO 20 j = 1, nmax
102  DO 10 i = 1, nmax
103  a( i, j ) = 1. / real( i+j )
104  af( i, j ) = 1. / real( i+j )
105  10 CONTINUE
106  b( j ) = 0.
107  w( j ) = 0.
108  x( j ) = 0.
109  20 CONTINUE
110  ok = .true.
111 *
112 * Error exits for LQ factorization
113 *
114 * SGELQF
115 *
116  srnamt = 'SGELQF'
117  infot = 1
118  CALL sgelqf( -1, 0, a, 1, b, w, 1, info )
119  CALL chkxer( 'SGELQF', infot, nout, lerr, ok )
120  infot = 2
121  CALL sgelqf( 0, -1, a, 1, b, w, 1, info )
122  CALL chkxer( 'SGELQF', infot, nout, lerr, ok )
123  infot = 4
124  CALL sgelqf( 2, 1, a, 1, b, w, 2, info )
125  CALL chkxer( 'SGELQF', infot, nout, lerr, ok )
126  infot = 7
127  CALL sgelqf( 2, 1, a, 2, b, w, 1, info )
128  CALL chkxer( 'SGELQF', infot, nout, lerr, ok )
129 *
130 * SGELQ2
131 *
132  srnamt = 'SGELQ2'
133  infot = 1
134  CALL sgelq2( -1, 0, a, 1, b, w, info )
135  CALL chkxer( 'SGELQ2', infot, nout, lerr, ok )
136  infot = 2
137  CALL sgelq2( 0, -1, a, 1, b, w, info )
138  CALL chkxer( 'SGELQ2', infot, nout, lerr, ok )
139  infot = 4
140  CALL sgelq2( 2, 1, a, 1, b, w, info )
141  CALL chkxer( 'SGELQ2', infot, nout, lerr, ok )
142 *
143 * SGELQS
144 *
145  srnamt = 'SGELQS'
146  infot = 1
147  CALL sgelqs( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
148  CALL chkxer( 'SGELQS', infot, nout, lerr, ok )
149  infot = 2
150  CALL sgelqs( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
151  CALL chkxer( 'SGELQS', infot, nout, lerr, ok )
152  infot = 2
153  CALL sgelqs( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
154  CALL chkxer( 'SGELQS', infot, nout, lerr, ok )
155  infot = 3
156  CALL sgelqs( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
157  CALL chkxer( 'SGELQS', infot, nout, lerr, ok )
158  infot = 5
159  CALL sgelqs( 2, 2, 0, a, 1, x, b, 2, w, 1, info )
160  CALL chkxer( 'SGELQS', infot, nout, lerr, ok )
161  infot = 8
162  CALL sgelqs( 1, 2, 0, a, 1, x, b, 1, w, 1, info )
163  CALL chkxer( 'SGELQS', infot, nout, lerr, ok )
164  infot = 10
165  CALL sgelqs( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
166  CALL chkxer( 'SGELQS', infot, nout, lerr, ok )
167 *
168 * SORGLQ
169 *
170  srnamt = 'SORGLQ'
171  infot = 1
172  CALL sorglq( -1, 0, 0, a, 1, x, w, 1, info )
173  CALL chkxer( 'SORGLQ', infot, nout, lerr, ok )
174  infot = 2
175  CALL sorglq( 0, -1, 0, a, 1, x, w, 1, info )
176  CALL chkxer( 'SORGLQ', infot, nout, lerr, ok )
177  infot = 2
178  CALL sorglq( 2, 1, 0, a, 2, x, w, 2, info )
179  CALL chkxer( 'SORGLQ', infot, nout, lerr, ok )
180  infot = 3
181  CALL sorglq( 0, 0, -1, a, 1, x, w, 1, info )
182  CALL chkxer( 'SORGLQ', infot, nout, lerr, ok )
183  infot = 3
184  CALL sorglq( 1, 1, 2, a, 1, x, w, 1, info )
185  CALL chkxer( 'SORGLQ', infot, nout, lerr, ok )
186  infot = 5
187  CALL sorglq( 2, 2, 0, a, 1, x, w, 2, info )
188  CALL chkxer( 'SORGLQ', infot, nout, lerr, ok )
189  infot = 8
190  CALL sorglq( 2, 2, 0, a, 2, x, w, 1, info )
191  CALL chkxer( 'SORGLQ', infot, nout, lerr, ok )
192 *
193 * SORGL2
194 *
195  srnamt = 'SORGL2'
196  infot = 1
197  CALL sorgl2( -1, 0, 0, a, 1, x, w, info )
198  CALL chkxer( 'SORGL2', infot, nout, lerr, ok )
199  infot = 2
200  CALL sorgl2( 0, -1, 0, a, 1, x, w, info )
201  CALL chkxer( 'SORGL2', infot, nout, lerr, ok )
202  infot = 2
203  CALL sorgl2( 2, 1, 0, a, 2, x, w, info )
204  CALL chkxer( 'SORGL2', infot, nout, lerr, ok )
205  infot = 3
206  CALL sorgl2( 0, 0, -1, a, 1, x, w, info )
207  CALL chkxer( 'SORGL2', infot, nout, lerr, ok )
208  infot = 3
209  CALL sorgl2( 1, 1, 2, a, 1, x, w, info )
210  CALL chkxer( 'SORGL2', infot, nout, lerr, ok )
211  infot = 5
212  CALL sorgl2( 2, 2, 0, a, 1, x, w, info )
213  CALL chkxer( 'SORGL2', infot, nout, lerr, ok )
214 *
215 * SORMLQ
216 *
217  srnamt = 'SORMLQ'
218  infot = 1
219  CALL sormlq( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
220  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
221  infot = 2
222  CALL sormlq( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
223  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
224  infot = 3
225  CALL sormlq( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
226  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
227  infot = 4
228  CALL sormlq( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
229  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
230  infot = 5
231  CALL sormlq( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
232  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
233  infot = 5
234  CALL sormlq( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
235  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
236  infot = 5
237  CALL sormlq( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
238  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
239  infot = 7
240  CALL sormlq( 'L', 'N', 2, 0, 2, a, 1, x, af, 2, w, 1, info )
241  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
242  infot = 7
243  CALL sormlq( 'R', 'N', 0, 2, 2, a, 1, x, af, 1, w, 1, info )
244  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
245  infot = 10
246  CALL sormlq( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, 1, info )
247  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
248  infot = 12
249  CALL sormlq( 'L', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
250  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
251  infot = 12
252  CALL sormlq( 'R', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
253  CALL chkxer( 'SORMLQ', infot, nout, lerr, ok )
254 *
255 * SORML2
256 *
257  srnamt = 'SORML2'
258  infot = 1
259  CALL sorml2( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, info )
260  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
261  infot = 2
262  CALL sorml2( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, info )
263  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
264  infot = 3
265  CALL sorml2( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, info )
266  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
267  infot = 4
268  CALL sorml2( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, info )
269  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
270  infot = 5
271  CALL sorml2( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, info )
272  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
273  infot = 5
274  CALL sorml2( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, info )
275  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
276  infot = 5
277  CALL sorml2( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, info )
278  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
279  infot = 7
280  CALL sorml2( 'L', 'N', 2, 1, 2, a, 1, x, af, 2, w, info )
281  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
282  infot = 7
283  CALL sorml2( 'R', 'N', 1, 2, 2, a, 1, x, af, 1, w, info )
284  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
285  infot = 10
286  CALL sorml2( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, info )
287  CALL chkxer( 'SORML2', infot, nout, lerr, ok )
288 *
289 * Print a summary line.
290 *
291  CALL alaesm( path, ok, nout )
292 *
293  RETURN
294 *
295 * End of SERRLQ
296 *
297  END
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
sgelq2
subroutine sgelq2(M, N, A, LDA, TAU, WORK, INFO)
SGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm.
Definition: sgelq2.f:129
sgelqf
subroutine sgelqf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGELQF
Definition: sgelqf.f:143
sorgl2
subroutine sorgl2(M, N, K, A, LDA, TAU, WORK, INFO)
SORGL2
Definition: sorgl2.f:113
sorml2
subroutine sorml2(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
SORML2 multiplies a general matrix by the orthogonal matrix from a LQ factorization determined by sge...
Definition: sorml2.f:159
sorglq
subroutine sorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGLQ
Definition: sorglq.f:127
sormlq
subroutine sormlq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMLQ
Definition: sormlq.f:168
sgelqs
subroutine sgelqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
SGELQS
Definition: sgelqs.f:121
serrlq
subroutine serrlq(PATH, NUNIT)
SERRLQ
Definition: serrlq.f:55