LAPACK  3.6.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 *> \date June 2016
52 *
53 *> \ingroup single_eig
54 *
55 * =====================================================================
56  SUBROUTINE serrbd( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.6.1) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * June 2016
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 PATH
65  INTEGER NUNIT
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER NMAX, LW
72  parameter ( nmax = 4, lw = nmax )
73  REAL ZERO, ONE
74  parameter ( zero = 0.0e0, one = 1.0e0 )
75 * ..
76 * .. Local Scalars ..
77  CHARACTER*2 C2
78  INTEGER I, INFO, J, NS, NT
79 * ..
80 * .. Local Arrays ..
81  INTEGER IQ( nmax, nmax ), IW( nmax )
82  REAL A( nmax, nmax ), D( nmax ), E( nmax ),
83  $ q( nmax, nmax ), s( nmax ), tp( nmax ),
84  $ tq( nmax ), u( nmax, nmax ),
85  $ v( nmax, nmax ), w( lw )
86 * ..
87 * .. External Functions ..
88  LOGICAL LSAMEN
89  EXTERNAL lsamen
90 * ..
91 * .. External Subroutines ..
92  EXTERNAL chkxer, sbdsdc, sbdsqr, sbdsvdx, sgebd2,
93  $ sgebrd, sorgbr, sormbr
94 * ..
95 * .. Scalars in Common ..
96  LOGICAL LERR, OK
97  CHARACTER*32 SRNAMT
98  INTEGER INFOT, NOUT
99 * ..
100 * .. Common blocks ..
101  COMMON / infoc / infot, nout, ok, lerr
102  COMMON / srnamc / srnamt
103 * ..
104 * .. Intrinsic Functions ..
105  INTRINSIC real
106 * ..
107 * .. Executable Statements ..
108 *
109  nout = nunit
110  WRITE( nout, fmt = * )
111  c2 = path( 2: 3 )
112 *
113 * Set the variables to innocuous values.
114 *
115  DO 20 j = 1, nmax
116  DO 10 i = 1, nmax
117  a( i, j ) = 1.d0 / REAL( i+j )
118  10 CONTINUE
119  20 CONTINUE
120  ok = .true.
121  nt = 0
122 *
123 * Test error exits of the SVD routines.
124 *
125  IF( lsamen( 2, c2, 'BD' ) ) THEN
126 *
127 * SGEBRD
128 *
129  srnamt = 'SGEBRD'
130  infot = 1
131  CALL sgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
132  CALL chkxer( 'SGEBRD', infot, nout, lerr, ok )
133  infot = 2
134  CALL sgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
135  CALL chkxer( 'SGEBRD', infot, nout, lerr, ok )
136  infot = 4
137  CALL sgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
138  CALL chkxer( 'SGEBRD', infot, nout, lerr, ok )
139  infot = 10
140  CALL sgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
141  CALL chkxer( 'SGEBRD', infot, nout, lerr, ok )
142  nt = nt + 4
143 *
144 * SGEBD2
145 *
146  srnamt = 'SGEBD2'
147  infot = 1
148  CALL sgebd2( -1, 0, a, 1, d, e, tq, tp, w, info )
149  CALL chkxer( 'SGEBD2', infot, nout, lerr, ok )
150  infot = 2
151  CALL sgebd2( 0, -1, a, 1, d, e, tq, tp, w, info )
152  CALL chkxer( 'SGEBD2', infot, nout, lerr, ok )
153  infot = 4
154  CALL sgebd2( 2, 1, a, 1, d, e, tq, tp, w, info )
155  CALL chkxer( 'SGEBD2', infot, nout, lerr, ok )
156  nt = nt + 3
157 *
158 * SORGBR
159 *
160  srnamt = 'SORGBR'
161  infot = 1
162  CALL sorgbr( '/', 0, 0, 0, a, 1, tq, w, 1, info )
163  CALL chkxer( 'SORGBR', infot, nout, lerr, ok )
164  infot = 2
165  CALL sorgbr( 'Q', -1, 0, 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', 0, 1, 0, a, 1, tq, w, 1, info )
172  CALL chkxer( 'SORGBR', infot, nout, lerr, ok )
173  infot = 3
174  CALL sorgbr( 'Q', 1, 0, 1, a, 1, tq, w, 1, info )
175  CALL chkxer( 'SORGBR', infot, nout, lerr, ok )
176  infot = 3
177  CALL sorgbr( 'P', 1, 0, 0, a, 1, tq, w, 1, info )
178  CALL chkxer( 'SORGBR', infot, nout, lerr, ok )
179  infot = 3
180  CALL sorgbr( 'P', 0, 1, 1, a, 1, tq, w, 1, info )
181  CALL chkxer( 'SORGBR', infot, nout, lerr, ok )
182  infot = 4
183  CALL sorgbr( 'Q', 0, 0, -1, a, 1, tq, w, 1, info )
184  CALL chkxer( 'SORGBR', infot, nout, lerr, ok )
185  infot = 6
186  CALL sorgbr( 'Q', 2, 1, 1, a, 1, tq, w, 1, info )
187  CALL chkxer( 'SORGBR', infot, nout, lerr, ok )
188  infot = 9
189  CALL sorgbr( 'Q', 2, 2, 1, a, 2, tq, w, 1, info )
190  CALL chkxer( 'SORGBR', infot, nout, lerr, ok )
191  nt = nt + 10
192 *
193 * SORMBR
194 *
195  srnamt = 'SORMBR'
196  infot = 1
197  CALL sormbr( '/', 'L', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
198  $ info )
199  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
200  infot = 2
201  CALL sormbr( 'Q', '/', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
202  $ info )
203  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
204  infot = 3
205  CALL sormbr( 'Q', 'L', '/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
206  $ info )
207  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
208  infot = 4
209  CALL sormbr( 'Q', 'L', 'T', -1, 0, 0, a, 1, tq, u, 1, w, 1,
210  $ info )
211  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
212  infot = 5
213  CALL sormbr( 'Q', 'L', 'T', 0, -1, 0, a, 1, tq, u, 1, w, 1,
214  $ info )
215  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
216  infot = 6
217  CALL sormbr( 'Q', 'L', 'T', 0, 0, -1, a, 1, tq, u, 1, w, 1,
218  $ info )
219  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
220  infot = 8
221  CALL sormbr( 'Q', 'L', 'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
222  $ info )
223  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
224  infot = 8
225  CALL sormbr( 'Q', 'R', 'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
226  $ info )
227  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
228  infot = 8
229  CALL sormbr( 'P', 'L', 'T', 2, 0, 2, a, 1, tq, u, 2, w, 1,
230  $ info )
231  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
232  infot = 8
233  CALL sormbr( 'P', 'R', 'T', 0, 2, 2, a, 1, tq, u, 1, w, 1,
234  $ info )
235  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
236  infot = 11
237  CALL sormbr( 'Q', 'R', 'T', 2, 0, 0, a, 1, tq, u, 1, w, 1,
238  $ info )
239  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
240  infot = 13
241  CALL sormbr( 'Q', 'L', 'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
242  $ info )
243  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
244  infot = 13
245  CALL sormbr( 'Q', 'R', 'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
246  $ info )
247  CALL chkxer( 'SORMBR', infot, nout, lerr, ok )
248  nt = nt + 13
249 *
250 * SBDSQR
251 *
252  srnamt = 'SBDSQR'
253  infot = 1
254  CALL sbdsqr( '/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
255  CALL chkxer( 'SBDSQR', infot, nout, lerr, ok )
256  infot = 2
257  CALL sbdsqr( 'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w,
258  $ info )
259  CALL chkxer( 'SBDSQR', infot, nout, lerr, ok )
260  infot = 3
261  CALL sbdsqr( 'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, w,
262  $ info )
263  CALL chkxer( 'SBDSQR', infot, nout, lerr, ok )
264  infot = 4
265  CALL sbdsqr( 'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, w,
266  $ info )
267  CALL chkxer( 'SBDSQR', infot, nout, lerr, ok )
268  infot = 5
269  CALL sbdsqr( 'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, w,
270  $ info )
271  CALL chkxer( 'SBDSQR', infot, nout, lerr, ok )
272  infot = 9
273  CALL sbdsqr( 'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
274  CALL chkxer( 'SBDSQR', infot, nout, lerr, ok )
275  infot = 11
276  CALL sbdsqr( 'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, w, info )
277  CALL chkxer( 'SBDSQR', infot, nout, lerr, ok )
278  infot = 13
279  CALL sbdsqr( 'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, w, info )
280  CALL chkxer( 'SBDSQR', infot, nout, lerr, ok )
281  nt = nt + 8
282 *
283 * SBDSDC
284 *
285  srnamt = 'SBDSDC'
286  infot = 1
287  CALL sbdsdc( '/', 'N', 0, d, e, u, 1, v, 1, q, iq, w, iw,
288  $ info )
289  CALL chkxer( 'SBDSDC', infot, nout, lerr, ok )
290  infot = 2
291  CALL sbdsdc( 'U', '/', 0, d, e, u, 1, v, 1, q, iq, w, iw,
292  $ info )
293  CALL chkxer( 'SBDSDC', infot, nout, lerr, ok )
294  infot = 3
295  CALL sbdsdc( 'U', 'N', -1, d, e, u, 1, v, 1, q, iq, w, iw,
296  $ info )
297  CALL chkxer( 'SBDSDC', infot, nout, lerr, ok )
298  infot = 7
299  CALL sbdsdc( 'U', 'I', 2, d, e, u, 1, v, 1, q, iq, w, iw,
300  $ info )
301  CALL chkxer( 'SBDSDC', infot, nout, lerr, ok )
302  infot = 9
303  CALL sbdsdc( 'U', 'I', 2, d, e, u, 2, v, 1, q, iq, w, iw,
304  $ info )
305  CALL chkxer( 'SBDSDC', infot, nout, lerr, ok )
306  nt = nt + 5
307 *
308 * SBDSVDX
309 *
310  srnamt = 'SBDSVDX'
311  infot = 1
312  CALL sbdsvdx( 'X', 'N', 'A', 1, d, e, zero, one, 0, 0,
313  $ ns, s, q, 1, w, iw, info)
314  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
315  infot = 2
316  CALL sbdsvdx( 'U', 'X', 'A', 1, d, e, zero, one, 0, 0,
317  $ ns, s, q, 1, w, iw, info)
318  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
319  infot = 3
320  CALL sbdsvdx( 'U', 'V', 'X', 1, d, e, zero, one, 0, 0,
321  $ ns, s, q, 1, w, iw, info)
322  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
323  infot = 4
324  CALL sbdsvdx( 'U', 'V', 'A', -1, d, e, zero, one, 0, 0,
325  $ ns, s, q, 1, w, iw, info)
326  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
327  infot = 7
328  CALL sbdsvdx( 'U', 'V', 'V', 2, d, e, -one, zero, 0, 0,
329  $ ns, s, q, 1, w, iw, info)
330  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
331  infot = 8
332  CALL sbdsvdx( 'U', 'V', 'V', 2, d, e, one, zero, 0, 0,
333  $ ns, s, q, 1, w, iw, info)
334  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
335  infot = 9
336  CALL sbdsvdx( 'L', 'V', 'I', 2, d, e, zero, zero, 0, 2,
337  $ ns, s, q, 1, w, iw, info)
338  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
339  infot = 9
340  CALL sbdsvdx( 'L', 'V', 'I', 4, d, e, zero, zero, 5, 2,
341  $ ns, s, q, 1, w, iw, info)
342  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
343  infot = 10
344  CALL sbdsvdx( 'L', 'V', 'I', 4, d, e, zero, zero, 3, 2,
345  $ ns, s, q, 1, w, iw, info)
346  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
347  infot = 10
348  CALL sbdsvdx( 'L', 'V', 'I', 4, d, e, zero, zero, 3, 5,
349  $ ns, s, q, 1, w, iw, info)
350  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
351  infot = 14
352  CALL sbdsvdx( 'L', 'V', 'A', 4, d, e, zero, zero, 0, 0,
353  $ ns, s, q, 0, w, iw, info)
354  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
355  infot = 14
356  CALL sbdsvdx( 'L', 'V', 'A', 4, d, e, zero, zero, 0, 0,
357  $ ns, s, q, 2, w, iw, info)
358  CALL chkxer( 'SBDSVDX', infot, nout, lerr, ok )
359  nt = nt + 12
360  END IF
361 *
362 * Print a summary line.
363 *
364  IF( ok ) THEN
365  WRITE( nout, fmt = 9999 )path, nt
366  ELSE
367  WRITE( nout, fmt = 9998 )path
368  END IF
369 *
370  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
371  $ ' (', i3, ' tests done)' )
372  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
373  $ 'exits ***' )
374 *
375  RETURN
376 *
377 * End of SERRBD
378 *
379  END
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:191
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
sormbr
subroutine sormbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMBR
Definition: sormbr.f:198
sbdsvdx
subroutine sbdsvdx(UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, NS, S, Z, LDZ, WORK, IWORK, INFO)
SBDSVDX
Definition: sbdsvdx.f:228
sbdsqr
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
Definition: sbdsqr.f:232
sbdsdc
subroutine sbdsdc(UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, WORK, IWORK, INFO)
SBDSDC
Definition: sbdsdc.f:207
sgebrd
subroutine sgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
SGEBRD
Definition: sgebrd.f:207
serrbd
subroutine serrbd(PATH, NUNIT)
SERRBD
Definition: serrbd.f:57
sorgbr
subroutine sorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGBR
Definition: sorgbr.f:159