LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
serrls.f
Go to the documentation of this file.
1*> \brief \b SERRLS
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 SERRLS( 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*> SERRLS tests the error exits for the REAL least squares
25*> driver routines (SGELS, SGELST, SGETSLS, SGELSS, SGELSY, SGELSD).
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 serrls( 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 CHARACTER*2 C2
73 INTEGER INFO, IRNK
74 REAL RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IP( NMAX )
78 REAL A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ),
79 $ W( NMAX )
80* ..
81* .. External Functions ..
82 LOGICAL LSAMEN
83 EXTERNAL lsamen
84* ..
85* .. External Subroutines ..
86 EXTERNAL alaesm, chkxer, sgels, sgelsd, sgelss, sgelst,
87 $ sgelsy, sgetsls
88* ..
89* .. Scalars in Common ..
90 LOGICAL LERR, OK
91 CHARACTER*32 SRNAMT
92 INTEGER INFOT, NOUT
93* ..
94* .. Common blocks ..
95 COMMON / infoc / infot, nout, ok, lerr
96 COMMON / srnamc / srnamt
97* ..
98* .. Executable Statements ..
99*
100 nout = nunit
101 WRITE( nout, fmt = * )
102 c2 = path( 2: 3 )
103 a( 1, 1 ) = 1.0e+0
104 a( 1, 2 ) = 2.0e+0
105 a( 2, 2 ) = 3.0e+0
106 a( 2, 1 ) = 4.0e+0
107 ok = .true.
108*
109 IF( lsamen( 2, c2, 'LS' ) ) THEN
110*
111* Test error exits for the least squares driver routines.
112*
113* SGELS
114*
115 srnamt = 'SGELS '
116 infot = 1
117 CALL sgels( '/', 0, 0, 0, a, 1, b, 1, w, 1, info )
118 CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
119 infot = 2
120 CALL sgels( 'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
121 CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
122 infot = 3
123 CALL sgels( 'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
124 CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
125 infot = 4
126 CALL sgels( 'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
127 CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
128 infot = 6
129 CALL sgels( 'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
130 CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
131 infot = 8
132 CALL sgels( 'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
133 CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
134 infot = 8
135 CALL sgels( 'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
136 CALL chkxer( 'DGELS', infot, nout, lerr, ok )
137 infot = 10
138 CALL sgels( 'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
139 CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
140*
141* SGELST
142*
143 srnamt = 'SGELST'
144 infot = 1
145 CALL sgelst( '/', 0, 0, 0, a, 1, b, 1, w, 1, info )
146 CALL chkxer( 'SGELST', infot, nout, lerr, ok )
147 infot = 2
148 CALL sgelst( 'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
149 CALL chkxer( 'SGELST', infot, nout, lerr, ok )
150 infot = 3
151 CALL sgelst( 'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
152 CALL chkxer( 'SGELST', infot, nout, lerr, ok )
153 infot = 4
154 CALL sgelst( 'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
155 CALL chkxer( 'SGELST', infot, nout, lerr, ok )
156 infot = 6
157 CALL sgelst( 'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
158 CALL chkxer( 'SGELST', infot, nout, lerr, ok )
159 infot = 8
160 CALL sgelst( 'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
161 CALL chkxer( 'SGELST', infot, nout, lerr, ok )
162 infot = 8
163 CALL sgelst( 'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
164 CALL chkxer( 'SGELST', infot, nout, lerr, ok )
165 infot = 10
166 CALL sgelst( 'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
167 CALL chkxer( 'SGELST', infot, nout, lerr, ok )
168*
169* SGETSLS
170*
171 srnamt = 'SGETSLS'
172 infot = 1
173 CALL sgetsls( '/', 0, 0, 0, a, 1, b, 1, w, 1, info )
174 CALL chkxer( 'SGETSLS', infot, nout, lerr, ok )
175 infot = 2
176 CALL sgetsls( 'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
177 CALL chkxer( 'SGETSLS', infot, nout, lerr, ok )
178 infot = 3
179 CALL sgetsls( 'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
180 CALL chkxer( 'SGETSLS', infot, nout, lerr, ok )
181 infot = 4
182 CALL sgetsls( 'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
183 CALL chkxer( 'SGETSLS', infot, nout, lerr, ok )
184 infot = 6
185 CALL sgetsls( 'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
186 CALL chkxer( 'SGETSLS', infot, nout, lerr, ok )
187 infot = 8
188 CALL sgetsls( 'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
189 CALL chkxer( 'SGETSLS', infot, nout, lerr, ok )
190 infot = 8
191 CALL sgetsls( 'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
192 CALL chkxer( 'SGETSLS', infot, nout, lerr, ok )
193*
194* SGELSS
195*
196 srnamt = 'SGELSS'
197 infot = 1
198 CALL sgelss( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 1, info )
199 CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
200 infot = 2
201 CALL sgelss( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 1, info )
202 CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
203 infot = 3
204 CALL sgelss( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 1, info )
205 CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
206 infot = 5
207 CALL sgelss( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 2, info )
208 CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
209 infot = 7
210 CALL sgelss( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 2, info )
211 CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
212*
213* SGELSY
214*
215 srnamt = 'SGELSY'
216 infot = 1
217 CALL sgelsy( -1, 0, 0, a, 1, b, 1, ip, rcond, irnk, w, 10,
218 $ info )
219 CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
220 infot = 2
221 CALL sgelsy( 0, -1, 0, a, 1, b, 1, ip, rcond, irnk, w, 10,
222 $ info )
223 CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
224 infot = 3
225 CALL sgelsy( 0, 0, -1, a, 1, b, 1, ip, rcond, irnk, w, 10,
226 $ info )
227 CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
228 infot = 5
229 CALL sgelsy( 2, 0, 0, a, 1, b, 2, ip, rcond, irnk, w, 10,
230 $ info )
231 CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
232 infot = 7
233 CALL sgelsy( 2, 0, 0, a, 2, b, 1, ip, rcond, irnk, w, 10,
234 $ info )
235 CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
236 infot = 12
237 CALL sgelsy( 2, 2, 1, a, 2, b, 2, ip, rcond, irnk, w, 1, info )
238 CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
239*
240* SGELSD
241*
242 srnamt = 'SGELSD'
243 infot = 1
244 CALL sgelsd( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
245 $ ip, info )
246 CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
247 infot = 2
248 CALL sgelsd( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
249 $ ip, info )
250 CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
251 infot = 3
252 CALL sgelsd( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 10,
253 $ ip, info )
254 CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
255 infot = 5
256 CALL sgelsd( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 10,
257 $ ip, info )
258 CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
259 infot = 7
260 CALL sgelsd( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 10,
261 $ ip, info )
262 CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
263 infot = 12
264 CALL sgelsd( 2, 2, 1, a, 2, b, 2, s, rcond, irnk, w, 1, ip,
265 $ info )
266 CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
267 END IF
268*
269* Print a summary line.
270*
271 CALL alaesm( path, ok, nout )
272*
273 RETURN
274*
275* End of SERRLS
276*
277 END
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
sgels
subroutine sgels(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
SGELS solves overdetermined or underdetermined systems for GE matrices
Definition sgels.f:183
sgelsd
subroutine sgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, iwork, info)
SGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices
Definition sgelsd.f:204
sgelss
subroutine sgelss(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, info)
SGELSS solves overdetermined or underdetermined systems for GE matrices
Definition sgelss.f:172
sgelst
subroutine sgelst(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
SGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization ...
Definition sgelst.f:194
sgelsy
subroutine sgelsy(m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, lwork, info)
SGELSY solves overdetermined or underdetermined systems for GE matrices
Definition sgelsy.f:206
sgetsls
subroutine sgetsls(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
SGETSLS
Definition sgetsls.f:162
serrls
subroutine serrls(path, nunit)
SERRLS
Definition serrls.f:55