LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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.
Date
June 2016

Definition at line 57 of file serrbd.f.

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 *
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
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
sorgbr
subroutine sorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGBR
Definition: sorgbr.f:159

Here is the call graph for this function:

Here is the caller graph for this function: