OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
serrbd.f
Go to the documentation of this file.
1*> \brief \b SERRBD
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 SERRBD( 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*> SERRBD tests the error exits for SGEBD2, SGEBRD, SORGBR, SORMBR,
25*> SBDSQR, SBDSDC and SBDSVDX.
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_eig
52*
53* =====================================================================
54 SUBROUTINE serrbd( 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 REAL ZERO, ONE
71 parameter( zero = 0.0e0, one = 1.0e0 )
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 REAL 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, sbdsdc, sbdsqr, sbdsvdx, sgebd2,
90 $ sgebrd, sorgbr, sormbr
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 real
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 / real( 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* SGEBRD
125*
126 srnamt = 'SGEBRD'
127 infot = 1
128 CALL sgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
129 CALL chkxer( 'SGEBRD', infot, nout, lerr, ok )
130 infot = 2
131 CALL sgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
132 CALL chkxer( 'SGEBRD', infot, nout, lerr, ok )
133 infot = 4
134 CALL sgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
135 CALL chkxer( 'SGEBRD', infot, nout, lerr, ok )
136 infot = 10
137 CALL sgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
138 CALL chkxer( 'SGEBRD', infot, nout, lerr, ok )
139 nt = nt + 4
140*
141* SGEBD2
142*
143 srnamt = 'SGEBD2'
144 infot = 1
145 CALL sgebd2( -1, 0, a, 1, d, e, tq, tp, w, info )
146 CALL chkxer( 'SGEBD2', infot, nout, lerr, ok )
147 infot = 2
148 CALL sgebd2( 0, -1, a, 1, d, e, tq, tp, w, info )
149 CALL chkxer( 'SGEBD2', infot, nout, lerr, ok )
150 infot = 4
151 CALL sgebd2( 2, 1, a, 1, d, e, tq, tp, w, info )
152 CALL chkxer( 'SGEBD2', infot, nout, lerr, ok )
153 nt = nt + 3
154*
155* SORGBR
156*
157 srnamt = 'SORGBR'
158 infot = 1
159 CALL sorgbr( '/', 0, 0, 0, a, 1, tq, w, 1, info )
160 CALL chkxer( 'SORGBR', infot, nout, lerr, ok )
161 infot = 2
162 CALL sorgbr( 'q', -1, 0, 0, A, 1, TQ, W, 1, INFO )
163 CALL CHKXER( 'sorgbr', INFOT, NOUT, LERR, OK )
164 INFOT = 3
165 CALL SORGBR( 'q', 0, -1, 0, A, 1, TQ, W, 1, INFO )
166 CALL CHKXER( 'sorgbr', INFOT, NOUT, LERR, OK )
167 INFOT = 3
168 CALL SORGBR( 'q', 0, 1, 0, A, 1, TQ, W, 1, INFO )
169 CALL CHKXER( 'sorgbr', INFOT, NOUT, LERR, OK )
170 INFOT = 3
171 CALL SORGBR( 'q', 1, 0, 1, A, 1, TQ, W, 1, INFO )
172 CALL CHKXER( 'sorgbr', INFOT, NOUT, LERR, OK )
173 INFOT = 3
174 CALL SORGBR( 'p', 1, 0, 0, A, 1, TQ, W, 1, INFO )
175 CALL CHKXER( 'sorgbr', INFOT, NOUT, LERR, OK )
176 INFOT = 3
177 CALL SORGBR( 'p', 0, 1, 1, A, 1, TQ, W, 1, INFO )
178 CALL CHKXER( 'sorgbr', INFOT, NOUT, LERR, OK )
179 INFOT = 4
180 CALL SORGBR( 'q', 0, 0, -1, A, 1, TQ, W, 1, INFO )
181 CALL CHKXER( 'sorgbr', INFOT, NOUT, LERR, OK )
182 INFOT = 6
183 CALL SORGBR( 'q', 2, 1, 1, A, 1, TQ, W, 1, INFO )
184 CALL CHKXER( 'sorgbr', INFOT, NOUT, LERR, OK )
185 INFOT = 9
186 CALL SORGBR( 'q', 2, 2, 1, A, 2, TQ, W, 1, INFO )
187 CALL CHKXER( 'sorgbr', infot, nout, lerr, ok )
188 nt = nt + 10
189*
190* SORMBR
191*
192 srnamt = 'SORMBR'
193 infot = 1
194 CALL sormbr( '/', 'L', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
195 $ info )
196 CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
197 infot = 2
198 CALL sormbr( 'Q', '/', 't', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
199 $ INFO )
200 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
201 INFOT = 3
202 CALL SORMBR( 'q', 'l', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
203 $ INFO )
204 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
205 INFOT = 4
206 CALL SORMBR( 'q', 'l', 't', -1, 0, 0, A, 1, TQ, U, 1, W, 1,
207 $ INFO )
208 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
209 INFOT = 5
210 CALL SORMBR( 'q', 'l', 't', 0, -1, 0, A, 1, TQ, U, 1, W, 1,
211 $ INFO )
212 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
213 INFOT = 6
214 CALL SORMBR( 'q', 'l', 't', 0, 0, -1, A, 1, TQ, U, 1, W, 1,
215 $ INFO )
216 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
217 INFOT = 8
218 CALL SORMBR( 'q', 'l', 't', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
219 $ INFO )
220 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
221 INFOT = 8
222 CALL SORMBR( 'q', 'r', 't', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
223 $ INFO )
224 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
225 INFOT = 8
226 CALL SORMBR( 'p', 'l', 't', 2, 0, 2, A, 1, TQ, U, 2, W, 1,
227 $ INFO )
228 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
229 INFOT = 8
230 CALL SORMBR( 'p', 'r', 't', 0, 2, 2, A, 1, TQ, U, 1, W, 1,
231 $ INFO )
232 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
233 INFOT = 11
234 CALL SORMBR( 'q', 'r', 't', 2, 0, 0, A, 1, TQ, U, 1, W, 1,
235 $ INFO )
236 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
237 INFOT = 13
238 CALL SORMBR( 'q', 'l', 't', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
239 $ INFO )
240 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
241 INFOT = 13
242 CALL SORMBR( 'q', 'r', 't', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
243 $ INFO )
244 CALL CHKXER( 'sormbr', INFOT, NOUT, LERR, OK )
245 NT = NT + 13
246*
247* SBDSQR
248*
249 SRNAMT = 'sbdsqr'
250 INFOT = 1
251 CALL SBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
252 CALL CHKXER( 'sbdsqr', INFOT, NOUT, LERR, OK )
253 INFOT = 2
254 CALL SBDSQR( 'u', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W,
255 $ INFO )
256 CALL CHKXER( 'sbdsqr', INFOT, NOUT, LERR, OK )
257 INFOT = 3
258 CALL SBDSQR( 'u', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, W,
259 $ INFO )
260 CALL CHKXER( 'sbdsqr', INFOT, NOUT, LERR, OK )
261 INFOT = 4
262 CALL SBDSQR( 'u', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, W,
263 $ INFO )
264 CALL CHKXER( 'sbdsqr', INFOT, NOUT, LERR, OK )
265 INFOT = 5
266 CALL SBDSQR( 'u', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, W,
267 $ INFO )
268 CALL CHKXER( 'sbdsqr', INFOT, NOUT, LERR, OK )
269 INFOT = 9
270 CALL SBDSQR( 'u', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
271 CALL CHKXER( 'sbdsqr', INFOT, NOUT, LERR, OK )
272 INFOT = 11
273 CALL SBDSQR( 'u', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, W, INFO )
274 CALL CHKXER( 'sbdsqr', INFOT, NOUT, LERR, OK )
275 INFOT = 13
276 CALL SBDSQR( 'u', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, W, INFO )
277 CALL CHKXER( 'sbdsqr', INFOT, NOUT, LERR, OK )
278 NT = NT + 8
279*
280* SBDSDC
281*
282 SRNAMT = 'sbdsdc'
283 INFOT = 1
284 CALL SBDSDC( '/', 'n', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
285 $ INFO )
286 CALL CHKXER( 'sbdsdc', INFOT, NOUT, LERR, OK )
287 INFOT = 2
288 CALL SBDSDC( 'u', '/', 0, D, E, U, 1, V, 1, Q, IQ, W, IW,
289 $ INFO )
290 CALL CHKXER( 'sbdsdc', INFOT, NOUT, LERR, OK )
291 INFOT = 3
292 CALL SBDSDC( 'u', 'n', -1, D, E, U, 1, V, 1, Q, IQ, W, IW,
293 $ INFO )
294 CALL CHKXER( 'sbdsdc', INFOT, NOUT, LERR, OK )
295 INFOT = 7
296 CALL SBDSDC( 'u', 'i', 2, D, E, U, 1, V, 1, Q, IQ, W, IW,
297 $ INFO )
298 CALL CHKXER( 'sbdsdc', INFOT, NOUT, LERR, OK )
299 INFOT = 9
300 CALL SBDSDC( 'u', 'i', 2, D, E, U, 2, V, 1, Q, IQ, W, IW,
301 $ INFO )
302 CALL CHKXER( 'sbdsdc', INFOT, NOUT, LERR, OK )
303 NT = NT + 5
304*
305* SBDSVDX
306*
307 SRNAMT = 'sbdsvdx'
308 INFOT = 1
309 CALL SBDSVDX( 'x', 'n', 'a', 1, D, E, ZERO, ONE, 0, 0,
310 $ NS, S, Q, 1, W, IW, INFO)
311 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
312 INFOT = 2
313 CALL SBDSVDX( 'u', 'x', 'a', 1, D, E, ZERO, ONE, 0, 0,
314 $ NS, S, Q, 1, W, IW, INFO)
315 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
316 INFOT = 3
317 CALL SBDSVDX( 'u', 'v', 'x', 1, D, E, ZERO, ONE, 0, 0,
318 $ NS, S, Q, 1, W, IW, INFO)
319 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
320 INFOT = 4
321 CALL SBDSVDX( 'u', 'v', 'a', -1, D, E, ZERO, ONE, 0, 0,
322 $ NS, S, Q, 1, W, IW, INFO)
323 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
324 INFOT = 7
325 CALL SBDSVDX( 'u', 'v', 'v', 2, D, E, -ONE, ZERO, 0, 0,
326 $ NS, S, Q, 1, W, IW, INFO)
327 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
328 INFOT = 8
329 CALL SBDSVDX( 'u', 'v', 'v', 2, D, E, ONE, ZERO, 0, 0,
330 $ NS, S, Q, 1, W, IW, INFO)
331 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
332 INFOT = 9
333 CALL SBDSVDX( 'l', 'v', 'i', 2, D, E, ZERO, ZERO, 0, 2,
334 $ NS, S, Q, 1, W, IW, INFO)
335 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
336 INFOT = 9
337 CALL SBDSVDX( 'l', 'v', 'i', 4, D, E, ZERO, ZERO, 5, 2,
338 $ NS, S, Q, 1, W, IW, INFO)
339 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
340 INFOT = 10
341 CALL SBDSVDX( 'l', 'v', 'i', 4, D, E, ZERO, ZERO, 3, 2,
342 $ NS, S, Q, 1, W, IW, INFO)
343 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
344 INFOT = 10
345 CALL SBDSVDX( 'l', 'v', 'i', 4, D, E, ZERO, ZERO, 3, 5,
346 $ NS, S, Q, 1, W, IW, INFO)
347 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
348 INFOT = 14
349 CALL SBDSVDX( 'l', 'v', 'a', 4, D, E, ZERO, ZERO, 0, 0,
350 $ NS, S, Q, 0, W, IW, INFO)
351 CALL CHKXER( 'sbdsvdx', INFOT, NOUT, LERR, OK )
352 INFOT = 14
353 CALL SBDSVDX( 'l', 'v', 'a', 4, D, E, ZERO, ZERO, 0, 0,
354 $ NS, S, Q, 2, W, IW, INFO)
355 CALL CHKXER( 'sbdsvdx', 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 SERRBD
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
sbdsqr
subroutine sbdsqr(uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c, ldc, work, info)
SBDSQR
Definition sbdsqr.f:240
sbdsdc
subroutine sbdsdc(uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq, work, iwork, info)
SBDSDC
Definition sbdsdc.f:205
sorgbr
subroutine sorgbr(vect, m, n, k, a, lda, tau, work, lwork, info)
SORGBR
Definition sorgbr.f:157
sgebrd
subroutine sgebrd(m, n, a, lda, d, e, tauq, taup, work, lwork, info)
SGEBRD
Definition sgebrd.f:205
sgebd2
subroutine sgebd2(m, n, a, lda, d, e, tauq, taup, work, info)
SGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
Definition sgebd2.f:189
sormbr
subroutine sormbr(vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
SORMBR
Definition sormbr.f:196
sbdsvdx
subroutine sbdsvdx(uplo, jobz, range, n, d, e, vl, vu, il, iu, ns, s, z, ldz, work, iwork, info)
SBDSVDX
Definition sbdsvdx.f:226
serrbd
subroutine serrbd(path, nunit)
SERRBD
Definition serrbd.f:55