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,
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
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
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
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
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
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
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
subroutine sgetsls(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
SGETSLS
Definition sgetsls.f:162
subroutine serrls(path, nunit)
SERRLS
Definition serrls.f:55