OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
derrge.f
Go to the documentation of this file.
1*> \brief \b DERRGE
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 DERRGE( 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*> DERRGE tests the error exits for the DOUBLE PRECISION routines
25*> for general matrices.
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 derrge( 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, LW
69 parameter( nmax = 4, lw = 3*nmax )
70* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER I, INFO, J
74 DOUBLE PRECISION ANRM, CCOND, RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IP( NMAX ), IW( NMAX )
78 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
79 $ R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX )
80* ..
81* .. External Functions ..
82 LOGICAL LSAMEN
83 EXTERNAL lsamen
84* ..
85* .. External Subroutines ..
86 EXTERNAL alaesm, chkxer, dgbcon, dgbequ, dgbrfs, dgbtf2,
87 $ dgbtrf, dgbtrs, dgecon, dgeequ, dgerfs, dgetf2,
88 $ dgetrf, dgetri, dgetrs
89* ..
90* .. Scalars in Common ..
91 LOGICAL LERR, OK
92 CHARACTER*32 SRNAMT
93 INTEGER INFOT, NOUT
94* ..
95* .. Common blocks ..
96 COMMON / infoc / infot, nout, ok, lerr
97 COMMON / srnamc / srnamt
98* ..
99* .. Intrinsic Functions ..
100 INTRINSIC dble
101* ..
102* .. Executable Statements ..
103*
104 nout = nunit
105 WRITE( nout, fmt = * )
106 c2 = path( 2: 3 )
107*
108* Set the variables to innocuous values.
109*
110 DO 20 j = 1, nmax
111 DO 10 i = 1, nmax
112 a( i, j ) = 1.d0 / dble( i+j )
113 af( i, j ) = 1.d0 / dble( i+j )
114 10 CONTINUE
115 b( j ) = 0.d0
116 r1( j ) = 0.d0
117 r2( j ) = 0.d0
118 w( j ) = 0.d0
119 x( j ) = 0.d0
120 ip( j ) = j
121 iw( j ) = j
122 20 CONTINUE
123 ok = .true.
124*
125 IF( lsamen( 2, c2, 'GE' ) ) THEN
126*
127* Test error exits of the routines that use the LU decomposition
128* of a general matrix.
129*
130* DGETRF
131*
132 srnamt = 'DGETRF'
133 infot = 1
134 CALL dgetrf( -1, 0, a, 1, ip, info )
135 CALL chkxer( 'DGETRF', infot, nout, lerr, ok )
136 infot = 2
137 CALL dgetrf( 0, -1, a, 1, ip, info )
138 CALL chkxer( 'DGETRF', infot, nout, lerr, ok )
139 infot = 4
140 CALL dgetrf( 2, 1, a, 1, ip, info )
141 CALL chkxer( 'DGETRF', infot, nout, lerr, ok )
142*
143* DGETF2
144*
145 srnamt = 'DGETF2'
146 infot = 1
147 CALL dgetf2( -1, 0, a, 1, ip, info )
148 CALL chkxer( 'DGETF2', infot, nout, lerr, ok )
149 infot = 2
150 CALL dgetf2( 0, -1, a, 1, ip, info )
151 CALL chkxer( 'DGETF2', infot, nout, lerr, ok )
152 infot = 4
153 CALL dgetf2( 2, 1, a, 1, ip, info )
154 CALL chkxer( 'DGETF2', infot, nout, lerr, ok )
155*
156* DGETRI
157*
158 srnamt = 'DGETRI'
159 infot = 1
160 CALL dgetri( -1, a, 1, ip, w, lw, info )
161 CALL chkxer( 'DGETRI', infot, nout, lerr, ok )
162 infot = 3
163 CALL dgetri( 2, a, 1, ip, w, lw, info )
164 CALL chkxer( 'DGETRI', infot, nout, lerr, ok )
165*
166* DGETRS
167*
168 srnamt = 'DGETRS'
169 infot = 1
170 CALL dgetrs( '/', 0, 0, a, 1, ip, b, 1, info )
171 CALL chkxer( 'DGETRS', infot, nout, lerr, ok )
172 infot = 2
173 CALL dgetrs( 'N', -1, 0, a, 1, ip, b, 1, info )
174 CALL chkxer( 'DGETRS', infot, nout, lerr, ok )
175 infot = 3
176 CALL dgetrs( 'N', 0, -1, a, 1, ip, b, 1, info )
177 CALL chkxer( 'DGETRS', infot, nout, lerr, ok )
178 infot = 5
179 CALL dgetrs( 'n', 2, 1, A, 1, IP, B, 2, INFO )
180 CALL CHKXER( 'dgetrs', INFOT, NOUT, LERR, OK )
181 INFOT = 8
182 CALL DGETRS( 'n', 2, 1, A, 2, IP, B, 1, INFO )
183 CALL CHKXER( 'dgetrs', INFOT, NOUT, LERR, OK )
184*
185* DGERFS
186*
187 SRNAMT = 'dgerfs'
188 INFOT = 1
189 CALL DGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
190 $ IW, INFO )
191 CALL CHKXER( 'dgerfs', INFOT, NOUT, LERR, OK )
192 INFOT = 2
193 CALL DGERFS( 'n', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
194 $ W, IW, INFO )
195 CALL CHKXER( 'dgerfs', INFOT, NOUT, LERR, OK )
196 INFOT = 3
197 CALL DGERFS( 'n', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
198 $ W, IW, INFO )
199 CALL CHKXER( 'dgerfs', INFOT, NOUT, LERR, OK )
200 INFOT = 5
201 CALL DGERFS( 'n', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
202 $ IW, INFO )
203 CALL CHKXER( 'dgerfs', INFOT, NOUT, LERR, OK )
204 INFOT = 7
205 CALL DGERFS( 'n', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
206 $ IW, INFO )
207 CALL CHKXER( 'dgerfs', INFOT, NOUT, LERR, OK )
208 INFOT = 10
209 CALL DGERFS( 'n', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
210 $ IW, INFO )
211 CALL CHKXER( 'dgerfs', INFOT, NOUT, LERR, OK )
212 INFOT = 12
213 CALL DGERFS( 'n', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
214 $ IW, INFO )
215 CALL CHKXER( 'dgerfs', INFOT, NOUT, LERR, OK )
216*
217* DGECON
218*
219 SRNAMT = 'dgecon'
220 INFOT = 1
221 CALL DGECON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO )
222 CALL CHKXER( 'dgecon', INFOT, NOUT, LERR, OK )
223 INFOT = 2
224 CALL DGECON( '1', -1, A, 1, ANRM, RCOND, W, IW, INFO )
225 CALL CHKXER( 'dgecon', INFOT, NOUT, LERR, OK )
226 INFOT = 4
227 CALL DGECON( '1', 2, A, 1, ANRM, RCOND, W, IW, INFO )
228 CALL CHKXER( 'dgecon', INFOT, NOUT, LERR, OK )
229*
230* DGEEQU
231*
232 SRNAMT = 'dgeequ'
233 INFOT = 1
234 CALL DGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
235 CALL CHKXER( 'dgeequ', INFOT, NOUT, LERR, OK )
236 INFOT = 2
237 CALL DGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
238 CALL CHKXER( 'dgeequ', INFOT, NOUT, LERR, OK )
239 INFOT = 4
240 CALL DGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
241 CALL CHKXER( 'dgeequ', INFOT, NOUT, LERR, OK )
242*
243 ELSE IF( LSAMEN( 2, C2, 'gb' ) ) THEN
244*
245* Test error exits of the routines that use the LU decomposition
246* of a general band matrix.
247*
248* DGBTRF
249*
250 SRNAMT = 'dgbtrf'
251 INFOT = 1
252 CALL DGBTRF( -1, 0, 0, 0, A, 1, IP, INFO )
253 CALL CHKXER( 'dgbtrf', INFOT, NOUT, LERR, OK )
254 INFOT = 2
255 CALL DGBTRF( 0, -1, 0, 0, A, 1, IP, INFO )
256 CALL CHKXER( 'dgbtrf', INFOT, NOUT, LERR, OK )
257 INFOT = 3
258 CALL DGBTRF( 1, 1, -1, 0, A, 1, IP, INFO )
259 CALL CHKXER( 'dgbtrf', INFOT, NOUT, LERR, OK )
260 INFOT = 4
261 CALL DGBTRF( 1, 1, 0, -1, A, 1, IP, INFO )
262 CALL CHKXER( 'dgbtrf', INFOT, NOUT, LERR, OK )
263 INFOT = 6
264 CALL DGBTRF( 2, 2, 1, 1, A, 3, IP, INFO )
265 CALL CHKXER( 'dgbtrf', INFOT, NOUT, LERR, OK )
266*
267* DGBTF2
268*
269 SRNAMT = 'dgbtf2'
270 INFOT = 1
271 CALL DGBTF2( -1, 0, 0, 0, A, 1, IP, INFO )
272 CALL CHKXER( 'dgbtf2', INFOT, NOUT, LERR, OK )
273 INFOT = 2
274 CALL DGBTF2( 0, -1, 0, 0, A, 1, IP, INFO )
275 CALL CHKXER( 'dgbtf2', INFOT, NOUT, LERR, OK )
276 INFOT = 3
277 CALL DGBTF2( 1, 1, -1, 0, A, 1, IP, INFO )
278 CALL CHKXER( 'dgbtf2', INFOT, NOUT, LERR, OK )
279 INFOT = 4
280 CALL DGBTF2( 1, 1, 0, -1, A, 1, IP, INFO )
281 CALL CHKXER( 'dgbtf2', INFOT, NOUT, LERR, OK )
282 INFOT = 6
283 CALL DGBTF2( 2, 2, 1, 1, A, 3, IP, INFO )
284 CALL CHKXER( 'dgbtf2', INFOT, NOUT, LERR, OK )
285*
286* DGBTRS
287*
288 SRNAMT = 'dgbtrs'
289 INFOT = 1
290 CALL DGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO )
291 CALL CHKXER( 'dgbtrs', INFOT, NOUT, LERR, OK )
292 INFOT = 2
293 CALL DGBTRS( 'n', -1, 0, 0, 1, A, 1, IP, B, 1, INFO )
294 CALL CHKXER( 'dgbtrs', INFOT, NOUT, LERR, OK )
295 INFOT = 3
296 CALL DGBTRS( 'n', 1, -1, 0, 1, A, 1, IP, B, 1, INFO )
297 CALL CHKXER( 'dgbtrs', INFOT, NOUT, LERR, OK )
298 INFOT = 4
299 CALL DGBTRS( 'n', 1, 0, -1, 1, A, 1, IP, B, 1, INFO )
300 CALL CHKXER( 'dgbtrs', INFOT, NOUT, LERR, OK )
301 INFOT = 5
302 CALL DGBTRS( 'n', 1, 0, 0, -1, A, 1, IP, B, 1, INFO )
303 CALL CHKXER( 'dgbtrs', INFOT, NOUT, LERR, OK )
304 INFOT = 7
305 CALL DGBTRS( 'n', 2, 1, 1, 1, A, 3, IP, B, 2, INFO )
306 CALL CHKXER( 'dgbtrs', INFOT, NOUT, LERR, OK )
307 INFOT = 10
308 CALL DGBTRS( 'n', 2, 0, 0, 1, A, 1, IP, B, 1, INFO )
309 CALL CHKXER( 'dgbtrs', INFOT, NOUT, LERR, OK )
310*
311* DGBRFS
312*
313 SRNAMT = 'dgbrfs'
314 INFOT = 1
315 CALL DGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
316 $ R2, W, IW, INFO )
317 CALL CHKXER( 'dgbrfs', INFOT, NOUT, LERR, OK )
318 INFOT = 2
319 CALL DGBRFS( 'n', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
320 $ R2, W, IW, INFO )
321 CALL CHKXER( 'dgbrfs', INFOT, NOUT, LERR, OK )
322 INFOT = 3
323 CALL DGBRFS( 'n', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
324 $ R2, W, IW, INFO )
325 CALL CHKXER( 'dgbrfs', INFOT, NOUT, LERR, OK )
326 INFOT = 4
327 CALL DGBRFS( 'n', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
328 $ R2, W, IW, INFO )
329 CALL CHKXER( 'dgbrfs', INFOT, NOUT, LERR, OK )
330 INFOT = 5
331 CALL DGBRFS( 'n', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1,
332 $ R2, W, IW, INFO )
333 CALL CHKXER( 'dgbrfs', INFOT, NOUT, LERR, OK )
334 INFOT = 7
335 CALL DGBRFS( 'n', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1,
336 $ R2, W, IW, INFO )
337 CALL CHKXER( 'dgbrfs', INFOT, NOUT, LERR, OK )
338 INFOT = 9
339 CALL DGBRFS( 'n', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1,
340 $ R2, W, IW, INFO )
341 CALL CHKXER( 'dgbrfs', INFOT, NOUT, LERR, OK )
342 INFOT = 12
343 CALL DGBRFS( 'n', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1,
344 $ R2, W, IW, INFO )
345 CALL CHKXER( 'dgbrfs', INFOT, NOUT, LERR, OK )
346 INFOT = 14
347 CALL DGBRFS( 'n', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1,
348 $ R2, W, IW, INFO )
349 CALL CHKXER( 'dgbrfs', INFOT, NOUT, LERR, OK )
350*
351* DGBCON
352*
353 SRNAMT = 'dgbcon'
354 INFOT = 1
355 CALL DGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
356 CALL CHKXER( 'dgbcon', INFOT, NOUT, LERR, OK )
357 INFOT = 2
358 CALL DGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, IW,
359 $ INFO )
360 CALL CHKXER( 'dgbcon', INFOT, NOUT, LERR, OK )
361 INFOT = 3
362 CALL DGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, IW,
363 $ INFO )
364 CALL CHKXER( 'dgbcon', INFOT, NOUT, LERR, OK )
365 INFOT = 4
366 CALL DGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, IW,
367 $ INFO )
368 CALL CHKXER( 'dgbcon', INFOT, NOUT, LERR, OK )
369 INFOT = 6
370 CALL DGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, IW, INFO )
371 CALL CHKXER( 'dgbcon', INFOT, NOUT, LERR, OK )
372*
373* DGBEQU
374*
375 SRNAMT = 'dgbequ'
376 INFOT = 1
377 CALL DGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
378 $ INFO )
379 CALL CHKXER( 'dgbequ', INFOT, NOUT, LERR, OK )
380 INFOT = 2
381 CALL DGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
382 $ INFO )
383 CALL CHKXER( 'dgbequ', INFOT, NOUT, LERR, OK )
384 INFOT = 3
385 CALL DGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
386 $ INFO )
387 CALL CHKXER( 'dgbequ', infot, nout, lerr, ok )
388 infot = 4
389 CALL dgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
390 $ info )
391 CALL chkxer( 'DGBEQU', infot, nout, lerr, ok )
392 infot = 6
393 CALL dgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
394 $ info )
395 CALL chkxer( 'DGBEQU', infot, nout, lerr, ok )
396 END IF
397*
398* Print a summary line.
399*
400 CALL alaesm( path, ok, nout )
401*
402 RETURN
403*
404* End of DERRGE
405*
406 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
dgbtf2
subroutine dgbtf2(m, n, kl, ku, ab, ldab, ipiv, info)
DGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
Definition dgbtf2.f:145
dgbtrs
subroutine dgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
DGBTRS
Definition dgbtrs.f:138
dgbequ
subroutine dgbequ(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
DGBEQU
Definition dgbequ.f:153
dgbtrf
subroutine dgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
DGBTRF
Definition dgbtrf.f:144
dgbrfs
subroutine dgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DGBRFS
Definition dgbrfs.f:205
dgbcon
subroutine dgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, iwork, info)
DGBCON
Definition dgbcon.f:146
dgecon
subroutine dgecon(norm, n, a, lda, anorm, rcond, work, iwork, info)
DGECON
Definition dgecon.f:124
dgetf2
subroutine dgetf2(m, n, a, lda, ipiv, info)
DGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
Definition dgetf2.f:108
dgeequ
subroutine dgeequ(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
DGEEQU
Definition dgeequ.f:139
dgetri
subroutine dgetri(n, a, lda, ipiv, work, lwork, info)
DGETRI
Definition dgetri.f:114
dgetrs
subroutine dgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
DGETRS
Definition dgetrs.f:121
dgetrf
subroutine dgetrf(m, n, a, lda, ipiv, info)
DGETRF
Definition dgetrf.f:108
dgerfs
subroutine dgerfs(trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DGERFS
Definition dgerfs.f:185
derrge
subroutine derrge(path, nunit)
DERRGE
Definition derrge.f:55