LAPACK  3.9.0
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.
Date
June 2016

Definition at line 57 of file derrbd.f.

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