OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
derrls.f
Go to the documentation of this file.
1*> \brief \b DERRLS
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 DERRLS( 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*> DERRLS tests the error exits for the DOUBLE PRECISION least squares
25*> driver routines (DGELS, 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 double_lin
52*
53* =====================================================================
54 SUBROUTINE derrls( 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 DOUBLE PRECISION RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IP( NMAX )
78 DOUBLE PRECISION 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, dgels, dgelsd, dgelss, dgelsy
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.0d+0
103 a( 1, 2 ) = 2.0d+0
104 a( 2, 2 ) = 3.0d+0
105 a( 2, 1 ) = 4.0d+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* DGELS
113*
114 srnamt = 'DGELS '
115 infot = 1
116 CALL dgels( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
117 CALL CHKXER( 'dgels ', INFOT, NOUT, LERR, OK )
118 INFOT = 2
119 CALL DGELS( 'n', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
120 CALL CHKXER( 'dgels ', INFOT, NOUT, LERR, OK )
121 INFOT = 3
122 CALL DGELS( 'n', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
123 CALL CHKXER( 'dgels ', INFOT, NOUT, LERR, OK )
124 INFOT = 4
125 CALL DGELS( 'n', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
126 CALL CHKXER( 'dgels ', INFOT, NOUT, LERR, OK )
127 INFOT = 6
128 CALL DGELS( 'n', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
129 CALL CHKXER( 'dgels ', INFOT, NOUT, LERR, OK )
130 INFOT = 8
131 CALL DGELS( 'n', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
132 CALL CHKXER( 'dgels ', INFOT, NOUT, LERR, OK )
133 INFOT = 10
134 CALL DGELS( 'n', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
135 CALL CHKXER( 'dgels ', INFOT, NOUT, LERR, OK )
136*
137* DGELSS
138*
139 SRNAMT = 'dgelss'
140 INFOT = 1
141 CALL DGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
142 CALL CHKXER( 'dgelss', INFOT, NOUT, LERR, OK )
143 INFOT = 2
144 CALL DGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
145 CALL CHKXER( 'dgelss', INFOT, NOUT, LERR, OK )
146 INFOT = 3
147 CALL DGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
148 CALL CHKXER( 'dgelss', INFOT, NOUT, LERR, OK )
149 INFOT = 5
150 CALL DGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO )
151 CALL CHKXER( 'dgelss', INFOT, NOUT, LERR, OK )
152 INFOT = 7
153 CALL DGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO )
154 CALL CHKXER( 'dgelss', INFOT, NOUT, LERR, OK )
155*
156* DGELSY
157*
158 SRNAMT = 'dgelsy'
159 INFOT = 1
160 CALL DGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
161 $ INFO )
162 CALL CHKXER( 'dgelsy', INFOT, NOUT, LERR, OK )
163 INFOT = 2
164 CALL DGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
165 $ INFO )
166 CALL CHKXER( 'dgelsy', INFOT, NOUT, LERR, OK )
167 INFOT = 3
168 CALL DGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
169 $ INFO )
170 CALL CHKXER( 'dgelsy', INFOT, NOUT, LERR, OK )
171 INFOT = 5
172 CALL DGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10,
173 $ INFO )
174 CALL CHKXER( 'dgelsy', INFOT, NOUT, LERR, OK )
175 INFOT = 7
176 CALL DGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10,
177 $ INFO )
178 CALL CHKXER( 'dgelsy', INFOT, NOUT, LERR, OK )
179 INFOT = 12
180 CALL DGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO )
181 CALL CHKXER( 'dgelsy', INFOT, NOUT, LERR, OK )
182*
183* DGELSD
184*
185 SRNAMT = 'dgelsd'
186 INFOT = 1
187 CALL DGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
188 $ INFO )
189 CALL CHKXER( 'dgelsd', INFOT, NOUT, LERR, OK )
190 INFOT = 2
191 CALL DGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
192 $ INFO )
193 CALL CHKXER( 'dgelsd', INFOT, NOUT, LERR, OK )
194 INFOT = 3
195 CALL DGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
196 $ INFO )
197 CALL CHKXER( 'dgelsd', INFOT, NOUT, LERR, OK )
198 INFOT = 5
199 CALL DGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, IP,
200 $ INFO )
201 CALL CHKXER( 'dgelsd', INFOT, NOUT, LERR, OK )
202 INFOT = 7
203 CALL DGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, IP,
204 $ INFO )
205 CALL CHKXER( 'dgelsd', INFOT, NOUT, LERR, OK )
206 INFOT = 12
207 CALL DGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP,
208 $ INFO )
209 CALL CHKXER( 'dgelsd', 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 DERRLS
219*
220 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
dgelsd
subroutine dgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, iwork, info)
DGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices
Definition dgelsd.f:209
dgelsy
subroutine dgelsy(m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, lwork, info)
DGELSY solves overdetermined or underdetermined systems for GE matrices
Definition dgelsy.f:204
dgels
subroutine dgels(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
DGELS solves overdetermined or underdetermined systems for GE matrices
Definition dgels.f:183
dgelss
subroutine dgelss(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, info)
DGELSS solves overdetermined or underdetermined systems for GE matrices
Definition dgelss.f:172
derrls
subroutine derrls(path, nunit)
DERRLS
Definition derrls.f:55