OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
derrbd.f
Go to the documentation of this file.
1*> \brief \b DERRBD
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 DERRBD( 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*> DERRBD tests the error exits for DGEBD2, DGEBRD, DORGBR, DORMBR,
25*> DBDSQR, DBDSDC and DBDSVDX.
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_eig
52*
53* =====================================================================
54 SUBROUTINE derrbd( 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 = nmax )
70 DOUBLE PRECISION ZERO, ONE
71 parameter( zero = 0.0d0, one = 1.0d0 )
72* ..
73* .. Local Scalars ..
74 CHARACTER*2 C2
75 INTEGER I, INFO, J, NS, NT
76* ..
77* .. Local Arrays ..
78 INTEGER IQ( NMAX, NMAX ), IW( NMAX )
79 DOUBLE PRECISION A( NMAX, NMAX ), D( NMAX ), E( NMAX ),
80 $ Q( NMAX, NMAX ), S( NMAX ), TP( NMAX ),
81 $ TQ( NMAX ), U( NMAX, NMAX ),
82 $ V( NMAX, NMAX ), W( LW )
83* ..
84* .. External Functions ..
85 LOGICAL LSAMEN
86 EXTERNAL lsamen
87* ..
88* .. External Subroutines ..
89 EXTERNAL chkxer, dbdsdc, dbdsqr, dbdsvdx, dgebd2,
90 $ dgebrd, dorgbr, dormbr
91* ..
92* .. Scalars in Common ..
93 LOGICAL LERR, OK
94 CHARACTER*32 SRNAMT
95 INTEGER INFOT, NOUT
96* ..
97* .. Common blocks ..
98 COMMON / infoc / infot, nout, ok, lerr
99 COMMON / srnamc / srnamt
100* ..
101* .. Intrinsic Functions ..
102 INTRINSIC dble
103* ..
104* .. Executable Statements ..
105*
106 nout = nunit
107 WRITE( nout, fmt = * )
108 c2 = path( 2: 3 )
109*
110* Set the variables to innocuous values.
111*
112 DO 20 j = 1, nmax
113 DO 10 i = 1, nmax
114 a( i, j ) = 1.d0 / dble( i+j )
115 10 CONTINUE
116 20 CONTINUE
117 ok = .true.
118 nt = 0
119*
120* Test error exits of the SVD routines.
121*
122 IF( lsamen( 2, c2, 'BD' ) ) THEN
123*
124* DGEBRD
125*
126 srnamt = 'DGEBRD'
127 infot = 1
128 CALL dgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
129 CALL chkxer( 'DGEBRD', infot, nout, lerr, ok )
130 infot = 2
131 CALL dgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
132 CALL chkxer( 'DGEBRD', infot, nout, lerr, ok )
133 infot = 4
134 CALL dgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
135 CALL chkxer( 'DGEBRD', infot, nout, lerr, ok )
136 infot = 10
137 CALL dgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
138 CALL chkxer( 'DGEBRD', infot, nout, lerr, ok )
139 nt = nt + 4
140*
141* DGEBD2
142*
143 srnamt = 'DGEBD2'
144 infot = 1
145 CALL dgebd2( -1, 0, a, 1, d, e, tq, tp, w, info )
146 CALL chkxer( 'DGEBD2', infot, nout, lerr, ok )
147 infot = 2
148 CALL dgebd2( 0, -1, a, 1, d, e, tq, tp, w, info )
149 CALL chkxer( 'DGEBD2', infot, nout, lerr, ok )
150 infot = 4
151 CALL dgebd2( 2, 1, a, 1, d, e, tq, tp, w, info )
152 CALL chkxer( 'DGEBD2', infot, nout, lerr, ok )
153 nt = nt + 3
154*
155* DORGBR
156*
157 srnamt = 'DORGBR'
158 infot = 1
159 CALL dorgbr( '/', 0, 0, 0, a, 1, tq, w, 1, info )
160 CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
161 infot = 2
162 CALL dorgbr( 'Q', -1, 0, 0, a, 1, tq, w, 1, info )
163 CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
164 infot = 3
165 CALL dorgbr( 'Q', 0, -1, 0, a, 1, tq, w, 1, info )
166 CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
167 infot = 3
168 CALL dorgbr( 'Q', 0, 1, 0, a, 1, tq, w, 1, info )
169 CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
170 infot = 3
171 CALL dorgbr( 'Q', 1, 0, 1, a, 1, tq, w, 1, info )
172 CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
173 infot = 3
174 CALL dorgbr( 'P', 1, 0, 0, a, 1, tq, w, 1, info )
175 CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
176 infot = 3
177 CALL dorgbr( 'P', 0, 1, 1, a, 1, tq, w, 1, info )
178 CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
179 infot = 4
180 CALL dorgbr( 'q', 0, 0, -1, A, 1, TQ, W, 1, INFO )
181 CALL CHKXER( 'dorgbr', INFOT, NOUT, LERR, OK )
182 INFOT = 6
183 CALL DORGBR( 'q', 2, 1, 1, A, 1, TQ, W, 1, INFO )
184 CALL CHKXER( 'dorgbr', INFOT, NOUT, LERR, OK )
185 INFOT = 9
186 CALL DORGBR( 'q', 2, 2, 1, A, 2, TQ, W, 1, INFO )
187 CALL CHKXER( 'dorgbr', INFOT, NOUT, LERR, OK )
188 NT = NT + 10
189*
190* DORMBR
191*
192 SRNAMT = 'dormbr'
193 INFOT = 1
194 CALL DORMBR( '/', 'l', 't', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
195 $ INFO )
196 CALL CHKXER( 'dormbr', infot, nout, lerr, ok )
197 infot = 2
198 CALL dormbr( 'Q', '/', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
199 $ info )
200 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
201 infot = 3
202 CALL dormbr( 'Q', 'L', '/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
203 $ info )
204 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
205 infot = 4
206 CALL dormbr( 'Q', 'L', 'T', -1, 0, 0, a, 1, tq, u, 1, w, 1,
207 $ info )
208 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
209 infot = 5
210 CALL dormbr( 'Q', 'L', 'T', 0, -1, 0, a, 1, tq, u, 1, w, 1,
211 $ info )
212 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
213 infot = 6
214 CALL dormbr( 'Q', 'L', 'T', 0, 0, -1, a, 1, tq, u, 1, w, 1,
215 $ info )
216 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
217 infot = 8
218 CALL dormbr( 'Q', 'L', 'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
219 $ info )
220 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
221 infot = 8
222 CALL dormbr( 'Q', 'R', 'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
223 $ info )
224 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
225 infot = 8
226 CALL dormbr( 'P', 'L', 'T', 2, 0, 2, a, 1, tq, u, 2, w, 1,
227 $ info )
228 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
229 infot = 8
230 CALL dormbr( 'P', 'R', 'T', 0, 2, 2, a, 1, tq, u, 1, w, 1,
231 $ info )
232 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
233 infot = 11
234 CALL dormbr( 'Q', 'R', 'T', 2, 0, 0, a, 1, tq, u, 1, w, 1,
235 $ info )
236 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
237 infot = 13
238 CALL dormbr( 'Q', 'L', 'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
239 $ info )
240 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
241 infot = 13
242 CALL dormbr( 'Q', 'R', 'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
243 $ info )
244 CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
245 nt = nt + 13
246*
247* DBDSQR
248*
249 srnamt = 'DBDSQR'
250 infot = 1
251 CALL dbdsqr( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
252 CALL CHKXER( 'dbdsqr', INFOT, NOUT, LERR, OK )
253 INFOT = 2
254 CALL DBDSQR( 'u', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W,
255 $ INFO )
256 CALL CHKXER( 'dbdsqr', INFOT, NOUT, LERR, OK )
257 INFOT = 3
258 CALL DBDSQR( 'u', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, W,
259 $ INFO )
260 CALL CHKXER( 'dbdsqr', INFOT, NOUT, LERR, OK )
261 INFOT = 4
262 CALL DBDSQR( 'u', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, W,
263 $ INFO )
264 CALL CHKXER( 'dbdsqr', INFOT, NOUT, LERR, OK )
265 INFOT = 5
266 CALL DBDSQR( 'u', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, W,
267 $ INFO )
268 CALL CHKXER( 'dbdsqr', INFOT, NOUT, LERR, OK )
269 INFOT = 9
270 CALL DBDSQR( 'u', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
271 CALL CHKXER( 'dbdsqr', INFOT, NOUT, LERR, OK )
272 INFOT = 11
273 CALL DBDSQR( 'u', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
274 CALL CHKXER( 'dbdsqr', INFOT, NOUT, LERR, OK )
275 INFOT = 13
276 CALL DBDSQR( 'u', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, W, INFO )
277 CALL CHKXER( 'dbdsqr', INFOT, NOUT, LERR, OK )
278 NT = NT + 8
279*
280* DBDSDC
281*
282 SRNAMT = 'dbdsdc'
283 INFOT = 1
284 CALL DBDSDC( '/', 'n', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
285 $ INFO )
286 CALL CHKXER( 'dbdsdc', INFOT, NOUT, LERR, OK )
287 INFOT = 2
288 CALL DBDSDC( 'u', '/', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
289 $ INFO )
290 CALL CHKXER( 'dbdsdc', INFOT, NOUT, LERR, OK )
291 INFOT = 3
292 CALL DBDSDC( 'u', 'n', -1, D, E, U, 1, V, 1, Q, IQ, W, IW,
293 $ INFO )
294 CALL CHKXER( 'dbdsdc', INFOT, NOUT, LERR, OK )
295 INFOT = 7
296 CALL DBDSDC( 'u', 'i', 2, D, E, U, 1, V, 1, Q, IQ, W, IW,
297 $ INFO )
298 CALL CHKXER( 'dbdsdc', INFOT, NOUT, LERR, OK )
299 INFOT = 9
300 CALL DBDSDC( 'u', 'i', 2, D, E, U, 2, V, 1, Q, IQ, W, IW,
301 $ INFO )
302 CALL CHKXER( 'dbdsdc', INFOT, NOUT, LERR, OK )
303 NT = NT + 5
304*
305* DBDSVDX
306*
307 SRNAMT = 'dbdsvdx'
308 INFOT = 1
309 CALL DBDSVDX( 'x', 'n', 'a', 1, D, E, ZERO, ONE, 0, 0,
310 $ NS, S, Q, 1, W, IW, INFO)
311 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
312 INFOT = 2
313 CALL DBDSVDX( 'u', 'x', 'a', 1, D, E, ZERO, ONE, 0, 0,
314 $ NS, S, Q, 1, W, IW, INFO)
315 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
316 INFOT = 3
317 CALL DBDSVDX( 'u', 'v', 'x', 1, D, E, ZERO, ONE, 0, 0,
318 $ NS, S, Q, 1, W, IW, INFO)
319 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
320 INFOT = 4
321 CALL DBDSVDX( 'u', 'v', 'a', -1, D, E, ZERO, ONE, 0, 0,
322 $ NS, S, Q, 1, W, IW, INFO)
323 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
324 INFOT = 7
325 CALL DBDSVDX( 'u', 'v', 'v', 2, D, E, -ONE, ZERO, 0, 0,
326 $ NS, S, Q, 1, W, IW, INFO)
327 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
328 INFOT = 8
329 CALL DBDSVDX( 'u', 'v', 'v', 2, D, E, ONE, ZERO, 0, 0,
330 $ NS, S, Q, 1, W, IW, INFO)
331 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
332 INFOT = 9
333 CALL DBDSVDX( 'l', 'v', 'i', 2, D, E, ZERO, ZERO, 0, 2,
334 $ NS, S, Q, 1, W, IW, INFO)
335 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
336 INFOT = 9
337 CALL DBDSVDX( 'l', 'v', 'i', 4, D, E, ZERO, ZERO, 5, 2,
338 $ NS, S, Q, 1, W, IW, INFO)
339 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
340 INFOT = 10
341 CALL DBDSVDX( 'l', 'v', 'i', 4, D, E, ZERO, ZERO, 3, 2,
342 $ NS, S, Q, 1, W, IW, INFO)
343 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
344 INFOT = 10
345 CALL DBDSVDX( 'l', 'v', 'i', 4, D, E, ZERO, ZERO, 3, 5,
346 $ NS, S, Q, 1, W, IW, INFO)
347 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
348 INFOT = 14
349 CALL DBDSVDX( 'l', 'v', 'a', 4, D, E, ZERO, ZERO, 0, 0,
350 $ NS, S, Q, 0, W, IW, INFO)
351 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
352 INFOT = 14
353 CALL DBDSVDX( 'l', 'v', 'a', 4, D, E, ZERO, ZERO, 0, 0,
354 $ NS, S, Q, 2, W, IW, INFO)
355 CALL CHKXER( 'dbdsvdx', INFOT, NOUT, LERR, OK )
356 NT = NT + 12
357 END IF
358*
359* Print a summary line.
360*
361 IF( OK ) THEN
362 WRITE( NOUT, FMT = 9999 )PATH, NT
363 ELSE
364 WRITE( NOUT, FMT = 9998 )PATH
365 END IF
366*
367 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits',
368 $ ' (', I3, ' tests done)' )
369 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
370 $ 'exits ***' )
371*
372 RETURN
373*
374* End of DERRBD
375*
376 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
the
end diagonal values have been computed in the(sparse) matrix id.SOL
dbdsdc
subroutine dbdsdc(uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq, work, iwork, info)
DBDSDC
Definition dbdsdc.f:205
dbdsqr
subroutine dbdsqr(uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c, ldc, work, info)
DBDSQR
Definition dbdsqr.f:241
dorgbr
subroutine dorgbr(vect, m, n, k, a, lda, tau, work, lwork, info)
DORGBR
Definition dorgbr.f:157
dgebrd
subroutine dgebrd(m, n, a, lda, d, e, tauq, taup, work, lwork, info)
DGEBRD
Definition dgebrd.f:205
dgebd2
subroutine dgebd2(m, n, a, lda, d, e, tauq, taup, work, info)
DGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
Definition dgebd2.f:189
dormbr
subroutine dormbr(vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
DORMBR
Definition dormbr.f:195
dbdsvdx
subroutine dbdsvdx(uplo, jobz, range, n, d, e, vl, vu, il, iu, ns, s, z, ldz, work, iwork, info)
DBDSVDX
Definition dbdsvdx.f:226
derrbd
subroutine derrbd(path, nunit)
DERRBD
Definition derrbd.f:55