LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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, 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, sgelsy
87 * ..
88 * .. Scalars in Common ..
89  LOGICAL LERR, OK
90  CHARACTER*32 SRNAMT
91  INTEGER INFOT, NOUT
92 * ..
93 * .. Common blocks ..
94  COMMON / infoc / infot, nout, ok, lerr
95  COMMON / srnamc / srnamt
96 * ..
97 * .. Executable Statements ..
98 *
99  nout = nunit
100  WRITE( nout, fmt = * )
101  c2 = path( 2: 3 )
102  a( 1, 1 ) = 1.0e+0
103  a( 1, 2 ) = 2.0e+0
104  a( 2, 2 ) = 3.0e+0
105  a( 2, 1 ) = 4.0e+0
106  ok = .true.
107 *
108  IF( lsamen( 2, c2, 'LS' ) ) THEN
109 *
110 * Test error exits for the least squares driver routines.
111 *
112 * SGELS
113 *
114  srnamt = 'SGELS '
115  infot = 1
116  CALL sgels( '/', 0, 0, 0, a, 1, b, 1, w, 1, info )
117  CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
118  infot = 2
119  CALL sgels( 'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
120  CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
121  infot = 3
122  CALL sgels( 'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
123  CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
124  infot = 4
125  CALL sgels( 'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
126  CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
127  infot = 6
128  CALL sgels( 'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
129  CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
130  infot = 8
131  CALL sgels( 'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
132  CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
133  infot = 10
134  CALL sgels( 'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
135  CALL chkxer( 'SGELS ', infot, nout, lerr, ok )
136 *
137 * SGELSS
138 *
139  srnamt = 'SGELSS'
140  infot = 1
141  CALL sgelss( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 1, info )
142  CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
143  infot = 2
144  CALL sgelss( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 1, info )
145  CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
146  infot = 3
147  CALL sgelss( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 1, info )
148  CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
149  infot = 5
150  CALL sgelss( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 2, info )
151  CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
152  infot = 7
153  CALL sgelss( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 2, info )
154  CALL chkxer( 'SGELSS', infot, nout, lerr, ok )
155 *
156 * SGELSY
157 *
158  srnamt = 'SGELSY'
159  infot = 1
160  CALL sgelsy( -1, 0, 0, a, 1, b, 1, ip, rcond, irnk, w, 10,
161  $ info )
162  CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
163  infot = 2
164  CALL sgelsy( 0, -1, 0, a, 1, b, 1, ip, rcond, irnk, w, 10,
165  $ info )
166  CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
167  infot = 3
168  CALL sgelsy( 0, 0, -1, a, 1, b, 1, ip, rcond, irnk, w, 10,
169  $ info )
170  CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
171  infot = 5
172  CALL sgelsy( 2, 0, 0, a, 1, b, 2, ip, rcond, irnk, w, 10,
173  $ info )
174  CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
175  infot = 7
176  CALL sgelsy( 2, 0, 0, a, 2, b, 1, ip, rcond, irnk, w, 10,
177  $ info )
178  CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
179  infot = 12
180  CALL sgelsy( 2, 2, 1, a, 2, b, 2, ip, rcond, irnk, w, 1, info )
181  CALL chkxer( 'SGELSY', infot, nout, lerr, ok )
182 *
183 * SGELSD
184 *
185  srnamt = 'SGELSD'
186  infot = 1
187  CALL sgelsd( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
188  $ ip, info )
189  CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
190  infot = 2
191  CALL sgelsd( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
192  $ ip, info )
193  CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
194  infot = 3
195  CALL sgelsd( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 10,
196  $ ip, info )
197  CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
198  infot = 5
199  CALL sgelsd( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 10,
200  $ ip, info )
201  CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
202  infot = 7
203  CALL sgelsd( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 10,
204  $ ip, info )
205  CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
206  infot = 12
207  CALL sgelsd( 2, 2, 1, a, 2, b, 2, s, rcond, irnk, w, 1, ip,
208  $ info )
209  CALL chkxer( 'SGELSD', infot, nout, lerr, ok )
210  END IF
211 *
212 * Print a summary line.
213 *
214  CALL alaesm( path, ok, nout )
215 *
216  RETURN
217 *
218 * End of SERRLS
219 *
220  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
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 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 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:210
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:204
subroutine serrls(PATH, NUNIT)
SERRLS
Definition: serrls.f:55