LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
Definition: sbdsqr.f:240
subroutine sbdsdc(UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, WORK, IWORK, INFO)
SBDSDC
Definition: sbdsdc.f:205
subroutine sorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGBR
Definition: sorgbr.f:157
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
subroutine sgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
SGEBRD
Definition: sgebrd.f:205
subroutine sormbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMBR
Definition: sormbr.f:196
subroutine sbdsvdx(UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, NS, S, Z, LDZ, WORK, IWORK, INFO)
SBDSVDX
Definition: sbdsvdx.f:226
subroutine serrbd(PATH, NUNIT)
SERRBD
Definition: serrbd.f:55