LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ derrbd()

subroutine derrbd ( character*3  PATH,
integer  NUNIT 
)

DERRBD

Purpose:
 DERRBD tests the error exits for DGEBD2, DGEBRD, DORGBR, DORMBR,
 DBDSQR, DBDSDC and DBDSVDX.
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 derrbd.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  DOUBLE PRECISION ZERO, ONE
71  parameter( zero = 0.0d0, one = 1.0d0 )
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  DOUBLE PRECISION 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, dbdsdc, dbdsqr, dbdsvdx, dgebd2,
90  $ dgebrd, dorgbr, dormbr
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 dble
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 / dble( 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 * DGEBRD
125 *
126  srnamt = 'DGEBRD'
127  infot = 1
128  CALL dgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
129  CALL chkxer( 'DGEBRD', infot, nout, lerr, ok )
130  infot = 2
131  CALL dgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
132  CALL chkxer( 'DGEBRD', infot, nout, lerr, ok )
133  infot = 4
134  CALL dgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
135  CALL chkxer( 'DGEBRD', infot, nout, lerr, ok )
136  infot = 10
137  CALL dgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
138  CALL chkxer( 'DGEBRD', infot, nout, lerr, ok )
139  nt = nt + 4
140 *
141 * DGEBD2
142 *
143  srnamt = 'DGEBD2'
144  infot = 1
145  CALL dgebd2( -1, 0, a, 1, d, e, tq, tp, w, info )
146  CALL chkxer( 'DGEBD2', infot, nout, lerr, ok )
147  infot = 2
148  CALL dgebd2( 0, -1, a, 1, d, e, tq, tp, w, info )
149  CALL chkxer( 'DGEBD2', infot, nout, lerr, ok )
150  infot = 4
151  CALL dgebd2( 2, 1, a, 1, d, e, tq, tp, w, info )
152  CALL chkxer( 'DGEBD2', infot, nout, lerr, ok )
153  nt = nt + 3
154 *
155 * DORGBR
156 *
157  srnamt = 'DORGBR'
158  infot = 1
159  CALL dorgbr( '/', 0, 0, 0, a, 1, tq, w, 1, info )
160  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
161  infot = 2
162  CALL dorgbr( 'Q', -1, 0, 0, a, 1, tq, w, 1, info )
163  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
164  infot = 3
165  CALL dorgbr( 'Q', 0, -1, 0, a, 1, tq, w, 1, info )
166  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
167  infot = 3
168  CALL dorgbr( 'Q', 0, 1, 0, a, 1, tq, w, 1, info )
169  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
170  infot = 3
171  CALL dorgbr( 'Q', 1, 0, 1, a, 1, tq, w, 1, info )
172  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
173  infot = 3
174  CALL dorgbr( 'P', 1, 0, 0, a, 1, tq, w, 1, info )
175  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
176  infot = 3
177  CALL dorgbr( 'P', 0, 1, 1, a, 1, tq, w, 1, info )
178  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
179  infot = 4
180  CALL dorgbr( 'Q', 0, 0, -1, a, 1, tq, w, 1, info )
181  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
182  infot = 6
183  CALL dorgbr( 'Q', 2, 1, 1, a, 1, tq, w, 1, info )
184  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
185  infot = 9
186  CALL dorgbr( 'Q', 2, 2, 1, a, 2, tq, w, 1, info )
187  CALL chkxer( 'DORGBR', infot, nout, lerr, ok )
188  nt = nt + 10
189 *
190 * DORMBR
191 *
192  srnamt = 'DORMBR'
193  infot = 1
194  CALL dormbr( '/', 'L', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
195  $ info )
196  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
197  infot = 2
198  CALL dormbr( 'Q', '/', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
199  $ info )
200  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
201  infot = 3
202  CALL dormbr( 'Q', 'L', '/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
203  $ info )
204  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
205  infot = 4
206  CALL dormbr( 'Q', 'L', 'T', -1, 0, 0, a, 1, tq, u, 1, w, 1,
207  $ info )
208  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
209  infot = 5
210  CALL dormbr( 'Q', 'L', 'T', 0, -1, 0, a, 1, tq, u, 1, w, 1,
211  $ info )
212  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
213  infot = 6
214  CALL dormbr( 'Q', 'L', 'T', 0, 0, -1, a, 1, tq, u, 1, w, 1,
215  $ info )
216  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
217  infot = 8
218  CALL dormbr( 'Q', 'L', 'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
219  $ info )
220  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
221  infot = 8
222  CALL dormbr( 'Q', 'R', 'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
223  $ info )
224  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
225  infot = 8
226  CALL dormbr( 'P', 'L', 'T', 2, 0, 2, a, 1, tq, u, 2, w, 1,
227  $ info )
228  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
229  infot = 8
230  CALL dormbr( 'P', 'R', 'T', 0, 2, 2, a, 1, tq, u, 1, w, 1,
231  $ info )
232  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
233  infot = 11
234  CALL dormbr( 'Q', 'R', 'T', 2, 0, 0, a, 1, tq, u, 1, w, 1,
235  $ info )
236  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
237  infot = 13
238  CALL dormbr( 'Q', 'L', 'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
239  $ info )
240  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
241  infot = 13
242  CALL dormbr( 'Q', 'R', 'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
243  $ info )
244  CALL chkxer( 'DORMBR', infot, nout, lerr, ok )
245  nt = nt + 13
246 *
247 * DBDSQR
248 *
249  srnamt = 'DBDSQR'
250  infot = 1
251  CALL dbdsqr( '/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
252  CALL chkxer( 'DBDSQR', infot, nout, lerr, ok )
253  infot = 2
254  CALL dbdsqr( 'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w,
255  $ info )
256  CALL chkxer( 'DBDSQR', infot, nout, lerr, ok )
257  infot = 3
258  CALL dbdsqr( 'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, w,
259  $ info )
260  CALL chkxer( 'DBDSQR', infot, nout, lerr, ok )
261  infot = 4
262  CALL dbdsqr( 'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, w,
263  $ info )
264  CALL chkxer( 'DBDSQR', infot, nout, lerr, ok )
265  infot = 5
266  CALL dbdsqr( 'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, w,
267  $ info )
268  CALL chkxer( 'DBDSQR', infot, nout, lerr, ok )
269  infot = 9
270  CALL dbdsqr( 'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
271  CALL chkxer( 'DBDSQR', infot, nout, lerr, ok )
272  infot = 11
273  CALL dbdsqr( 'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, w, info )
274  CALL chkxer( 'DBDSQR', infot, nout, lerr, ok )
275  infot = 13
276  CALL dbdsqr( 'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, w, info )
277  CALL chkxer( 'DBDSQR', infot, nout, lerr, ok )
278  nt = nt + 8
279 *
280 * DBDSDC
281 *
282  srnamt = 'DBDSDC'
283  infot = 1
284  CALL dbdsdc( '/', 'N', 0, d, e, u, 1, v, 1, q, iq, w, iw,
285  $ info )
286  CALL chkxer( 'DBDSDC', infot, nout, lerr, ok )
287  infot = 2
288  CALL dbdsdc( 'U', '/', 0, d, e, u, 1, v, 1, q, iq, w, iw,
289  $ info )
290  CALL chkxer( 'DBDSDC', infot, nout, lerr, ok )
291  infot = 3
292  CALL dbdsdc( 'U', 'N', -1, d, e, u, 1, v, 1, q, iq, w, iw,
293  $ info )
294  CALL chkxer( 'DBDSDC', infot, nout, lerr, ok )
295  infot = 7
296  CALL dbdsdc( 'U', 'I', 2, d, e, u, 1, v, 1, q, iq, w, iw,
297  $ info )
298  CALL chkxer( 'DBDSDC', infot, nout, lerr, ok )
299  infot = 9
300  CALL dbdsdc( 'U', 'I', 2, d, e, u, 2, v, 1, q, iq, w, iw,
301  $ info )
302  CALL chkxer( 'DBDSDC', infot, nout, lerr, ok )
303  nt = nt + 5
304 *
305 * DBDSVDX
306 *
307  srnamt = 'DBDSVDX'
308  infot = 1
309  CALL dbdsvdx( 'X', 'N', 'A', 1, d, e, zero, one, 0, 0,
310  $ ns, s, q, 1, w, iw, info)
311  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
312  infot = 2
313  CALL dbdsvdx( 'U', 'X', 'A', 1, d, e, zero, one, 0, 0,
314  $ ns, s, q, 1, w, iw, info)
315  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
316  infot = 3
317  CALL dbdsvdx( 'U', 'V', 'X', 1, d, e, zero, one, 0, 0,
318  $ ns, s, q, 1, w, iw, info)
319  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
320  infot = 4
321  CALL dbdsvdx( 'U', 'V', 'A', -1, d, e, zero, one, 0, 0,
322  $ ns, s, q, 1, w, iw, info)
323  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
324  infot = 7
325  CALL dbdsvdx( 'U', 'V', 'V', 2, d, e, -one, zero, 0, 0,
326  $ ns, s, q, 1, w, iw, info)
327  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
328  infot = 8
329  CALL dbdsvdx( 'U', 'V', 'V', 2, d, e, one, zero, 0, 0,
330  $ ns, s, q, 1, w, iw, info)
331  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
332  infot = 9
333  CALL dbdsvdx( 'L', 'V', 'I', 2, d, e, zero, zero, 0, 2,
334  $ ns, s, q, 1, w, iw, info)
335  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
336  infot = 9
337  CALL dbdsvdx( 'L', 'V', 'I', 4, d, e, zero, zero, 5, 2,
338  $ ns, s, q, 1, w, iw, info)
339  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
340  infot = 10
341  CALL dbdsvdx( 'L', 'V', 'I', 4, d, e, zero, zero, 3, 2,
342  $ ns, s, q, 1, w, iw, info)
343  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
344  infot = 10
345  CALL dbdsvdx( 'L', 'V', 'I', 4, d, e, zero, zero, 3, 5,
346  $ ns, s, q, 1, w, iw, info)
347  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
348  infot = 14
349  CALL dbdsvdx( 'L', 'V', 'A', 4, d, e, zero, zero, 0, 0,
350  $ ns, s, q, 0, w, iw, info)
351  CALL chkxer( 'DBDSVDX', infot, nout, lerr, ok )
352  infot = 14
353  CALL dbdsvdx( 'L', 'V', 'A', 4, d, e, zero, zero, 0, 0,
354  $ ns, s, q, 2, w, iw, info)
355  CALL chkxer( 'DBDSVDX', 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 DERRBD
375 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
subroutine dbdsdc(UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, WORK, IWORK, INFO)
DBDSDC
Definition: dbdsdc.f:205
subroutine dbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
DBDSQR
Definition: dbdsqr.f:241
subroutine dorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGBR
Definition: dorgbr.f:157
subroutine dgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
DGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
Definition: dgebd2.f:189
subroutine dgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
DGEBRD
Definition: dgebrd.f:205
subroutine dormbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMBR
Definition: dormbr.f:195
subroutine dbdsvdx(UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, NS, S, Z, LDZ, WORK, IWORK, INFO)
DBDSVDX
Definition: dbdsvdx.f:226
Here is the call graph for this function:
Here is the caller graph for this function: