LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ serrls()

subroutine serrls ( character*3  PATH,
integer  NUNIT 
)

SERRLS

Purpose:
 SERRLS tests the error exits for the REAL least squares
 driver routines (SGELS, SGELSS, SGELSY, SGELSD).
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 54 of file serrls.f.

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 *
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
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
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
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:210
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:204
Here is the call graph for this function:
Here is the caller graph for this function: