LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
serrql.f
Go to the documentation of this file.
1 *> \brief \b SERRQL
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 SERRQL( 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 *> SERRQL tests the error exits for the REAL routines
25 *> that use the QL 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 serrql( 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, sgeql2, sgeqlf, sgeqls, sorg2l,
83  $ sorgql, sorm2l, sormql
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 real
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 ) = 1. / REAL( i+j )
107  af( i, j ) = 1. / REAL( i+j )
108  10 CONTINUE
109  b( j ) = 0.
110  w( j ) = 0.
111  x( j ) = 0.
112  20 CONTINUE
113  ok = .true.
114 *
115 * Error exits for QL factorization
116 *
117 * SGEQLF
118 *
119  srnamt = 'SGEQLF'
120  infot = 1
121  CALL sgeqlf( -1, 0, a, 1, b, w, 1, info )
122  CALL chkxer( 'SGEQLF', infot, nout, lerr, ok )
123  infot = 2
124  CALL sgeqlf( 0, -1, a, 1, b, w, 1, info )
125  CALL chkxer( 'SGEQLF', infot, nout, lerr, ok )
126  infot = 4
127  CALL sgeqlf( 2, 1, a, 1, b, w, 1, info )
128  CALL chkxer( 'SGEQLF', infot, nout, lerr, ok )
129  infot = 7
130  CALL sgeqlf( 1, 2, a, 1, b, w, 1, info )
131  CALL chkxer( 'SGEQLF', infot, nout, lerr, ok )
132 *
133 * SGEQL2
134 *
135  srnamt = 'SGEQL2'
136  infot = 1
137  CALL sgeql2( -1, 0, a, 1, b, w, info )
138  CALL chkxer( 'SGEQL2', infot, nout, lerr, ok )
139  infot = 2
140  CALL sgeql2( 0, -1, a, 1, b, w, info )
141  CALL chkxer( 'SGEQL2', infot, nout, lerr, ok )
142  infot = 4
143  CALL sgeql2( 2, 1, a, 1, b, w, info )
144  CALL chkxer( 'SGEQL2', infot, nout, lerr, ok )
145 *
146 * SGEQLS
147 *
148  srnamt = 'SGEQLS'
149  infot = 1
150  CALL sgeqls( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
151  CALL chkxer( 'SGEQLS', infot, nout, lerr, ok )
152  infot = 2
153  CALL sgeqls( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
154  CALL chkxer( 'SGEQLS', infot, nout, lerr, ok )
155  infot = 2
156  CALL sgeqls( 1, 2, 0, a, 1, x, b, 1, w, 1, info )
157  CALL chkxer( 'SGEQLS', infot, nout, lerr, ok )
158  infot = 3
159  CALL sgeqls( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
160  CALL chkxer( 'SGEQLS', infot, nout, lerr, ok )
161  infot = 5
162  CALL sgeqls( 2, 1, 0, a, 1, x, b, 2, w, 1, info )
163  CALL chkxer( 'SGEQLS', infot, nout, lerr, ok )
164  infot = 8
165  CALL sgeqls( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
166  CALL chkxer( 'SGEQLS', infot, nout, lerr, ok )
167  infot = 10
168  CALL sgeqls( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
169  CALL chkxer( 'SGEQLS', infot, nout, lerr, ok )
170 *
171 * SORGQL
172 *
173  srnamt = 'SORGQL'
174  infot = 1
175  CALL sorgql( -1, 0, 0, a, 1, x, w, 1, info )
176  CALL chkxer( 'SORGQL', infot, nout, lerr, ok )
177  infot = 2
178  CALL sorgql( 0, -1, 0, a, 1, x, w, 1, info )
179  CALL chkxer( 'SORGQL', infot, nout, lerr, ok )
180  infot = 2
181  CALL sorgql( 1, 2, 0, a, 1, x, w, 2, info )
182  CALL chkxer( 'SORGQL', infot, nout, lerr, ok )
183  infot = 3
184  CALL sorgql( 0, 0, -1, a, 1, x, w, 1, info )
185  CALL chkxer( 'SORGQL', infot, nout, lerr, ok )
186  infot = 3
187  CALL sorgql( 1, 1, 2, a, 1, x, w, 1, info )
188  CALL chkxer( 'SORGQL', infot, nout, lerr, ok )
189  infot = 5
190  CALL sorgql( 2, 1, 0, a, 1, x, w, 1, info )
191  CALL chkxer( 'SORGQL', infot, nout, lerr, ok )
192  infot = 8
193  CALL sorgql( 2, 2, 0, a, 2, x, w, 1, info )
194  CALL chkxer( 'SORGQL', infot, nout, lerr, ok )
195 *
196 * SORG2L
197 *
198  srnamt = 'SORG2L'
199  infot = 1
200  CALL sorg2l( -1, 0, 0, a, 1, x, w, info )
201  CALL chkxer( 'SORG2L', infot, nout, lerr, ok )
202  infot = 2
203  CALL sorg2l( 0, -1, 0, a, 1, x, w, info )
204  CALL chkxer( 'SORG2L', infot, nout, lerr, ok )
205  infot = 2
206  CALL sorg2l( 1, 2, 0, a, 1, x, w, info )
207  CALL chkxer( 'SORG2L', infot, nout, lerr, ok )
208  infot = 3
209  CALL sorg2l( 0, 0, -1, a, 1, x, w, info )
210  CALL chkxer( 'SORG2L', infot, nout, lerr, ok )
211  infot = 3
212  CALL sorg2l( 2, 1, 2, a, 2, x, w, info )
213  CALL chkxer( 'SORG2L', infot, nout, lerr, ok )
214  infot = 5
215  CALL sorg2l( 2, 1, 0, a, 1, x, w, info )
216  CALL chkxer( 'SORG2L', infot, nout, lerr, ok )
217 *
218 * SORMQL
219 *
220  srnamt = 'SORMQL'
221  infot = 1
222  CALL sormql( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
223  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
224  infot = 2
225  CALL sormql( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
226  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
227  infot = 3
228  CALL sormql( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
229  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
230  infot = 4
231  CALL sormql( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
232  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
233  infot = 5
234  CALL sormql( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
235  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
236  infot = 5
237  CALL sormql( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
238  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
239  infot = 5
240  CALL sormql( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
241  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
242  infot = 7
243  CALL sormql( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
244  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
245  infot = 7
246  CALL sormql( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
247  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
248  infot = 10
249  CALL sormql( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, 1, info )
250  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
251  infot = 12
252  CALL sormql( 'L', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
253  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
254  infot = 12
255  CALL sormql( 'R', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
256  CALL chkxer( 'SORMQL', infot, nout, lerr, ok )
257 *
258 * SORM2L
259 *
260  srnamt = 'SORM2L'
261  infot = 1
262  CALL sorm2l( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, info )
263  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
264  infot = 2
265  CALL sorm2l( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, info )
266  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
267  infot = 3
268  CALL sorm2l( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, info )
269  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
270  infot = 4
271  CALL sorm2l( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, info )
272  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
273  infot = 5
274  CALL sorm2l( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, info )
275  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
276  infot = 5
277  CALL sorm2l( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, info )
278  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
279  infot = 5
280  CALL sorm2l( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, info )
281  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
282  infot = 7
283  CALL sorm2l( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, info )
284  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
285  infot = 7
286  CALL sorm2l( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, info )
287  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
288  infot = 10
289  CALL sorm2l( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, info )
290  CALL chkxer( 'SORM2L', infot, nout, lerr, ok )
291 *
292 * Print a summary line.
293 *
294  CALL alaesm( path, ok, nout )
295 *
296  RETURN
297 *
298 * End of SERRQL
299 *
300  END
subroutine sgeqls(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
SGEQLS
Definition: sgeqls.f:124
subroutine sormql(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQL
Definition: sormql.f:170
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
subroutine sgeqlf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQLF
Definition: sgeqlf.f:140
subroutine sgeql2(M, N, A, LDA, TAU, WORK, INFO)
SGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm...
Definition: sgeql2.f:125
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine serrql(PATH, NUNIT)
SERRQL
Definition: serrql.f:57
subroutine sorm2l(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
SORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sge...
Definition: sorm2l.f:161
subroutine sorgql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQL
Definition: sorgql.f:130
subroutine sorg2l(M, N, K, A, LDA, TAU, WORK, INFO)
SORG2L generates all or part of the orthogonal matrix Q from a QL factorization determined by sgeqlf ...
Definition: sorg2l.f:116