LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ serrbd()

subroutine serrbd ( character*3  PATH,
integer  NUNIT 
)

SERRBD

Purpose:
 SERRBD tests the error exits for SGEBD2, SGEBRD, SORGBR, SORMBR,
 SBDSQR, SBDSDC and SBDSVDX.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 54 of file serrbd.f.

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 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
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
Here is the call graph for this function:
Here is the caller graph for this function: