LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cerrbd ( character*3  PATH,
integer  NUNIT 
)

CERRBD

Purpose:
 CERRBD tests the error exits for CGEBRD, CUNGBR, CUNMBR, and CBDSQR.
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
November 2011

Definition at line 56 of file cerrbd.f.

56 *
57 * -- LAPACK test routine (version 3.4.0) --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 * November 2011
61 *
62 * .. Scalar Arguments ..
63  CHARACTER*3 path
64  INTEGER nunit
65 * ..
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  INTEGER nmax, lw
71  parameter ( nmax = 4, lw = nmax )
72 * ..
73 * .. Local Scalars ..
74  CHARACTER*2 c2
75  INTEGER i, info, j, nt
76 * ..
77 * .. Local Arrays ..
78  REAL d( nmax ), e( nmax ), rw( 4*nmax )
79  COMPLEX a( nmax, nmax ), tp( nmax ), tq( nmax ),
80  $ u( nmax, nmax ), v( nmax, nmax ), w( lw )
81 * ..
82 * .. External Functions ..
83  LOGICAL lsamen
84  EXTERNAL lsamen
85 * ..
86 * .. External Subroutines ..
87  EXTERNAL cbdsqr, cgebrd, chkxer, cungbr, cunmbr
88 * ..
89 * .. Scalars in Common ..
90  LOGICAL lerr, ok
91  CHARACTER*32 srnamt
92  INTEGER infot, nout
93 * ..
94 * .. Common blocks ..
95  COMMON / infoc / infot, nout, ok, lerr
96  COMMON / srnamc / srnamt
97 * ..
98 * .. Intrinsic Functions ..
99  INTRINSIC real
100 * ..
101 * .. Executable Statements ..
102 *
103  nout = nunit
104  WRITE( nout, fmt = * )
105  c2 = path( 2: 3 )
106 *
107 * Set the variables to innocuous values.
108 *
109  DO 20 j = 1, nmax
110  DO 10 i = 1, nmax
111  a( i, j ) = 1. / REAL( i+j )
112  10 CONTINUE
113  20 CONTINUE
114  ok = .true.
115  nt = 0
116 *
117 * Test error exits of the SVD routines.
118 *
119  IF( lsamen( 2, c2, 'BD' ) ) THEN
120 *
121 * CGEBRD
122 *
123  srnamt = 'CGEBRD'
124  infot = 1
125  CALL cgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
126  CALL chkxer( 'CGEBRD', infot, nout, lerr, ok )
127  infot = 2
128  CALL cgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
129  CALL chkxer( 'CGEBRD', infot, nout, lerr, ok )
130  infot = 4
131  CALL cgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
132  CALL chkxer( 'CGEBRD', infot, nout, lerr, ok )
133  infot = 10
134  CALL cgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
135  CALL chkxer( 'CGEBRD', infot, nout, lerr, ok )
136  nt = nt + 4
137 *
138 * CUNGBR
139 *
140  srnamt = 'CUNGBR'
141  infot = 1
142  CALL cungbr( '/', 0, 0, 0, a, 1, tq, w, 1, info )
143  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
144  infot = 2
145  CALL cungbr( 'Q', -1, 0, 0, a, 1, tq, w, 1, info )
146  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
147  infot = 3
148  CALL cungbr( 'Q', 0, -1, 0, a, 1, tq, w, 1, info )
149  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
150  infot = 3
151  CALL cungbr( 'Q', 0, 1, 0, a, 1, tq, w, 1, info )
152  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
153  infot = 3
154  CALL cungbr( 'Q', 1, 0, 1, a, 1, tq, w, 1, info )
155  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
156  infot = 3
157  CALL cungbr( 'P', 1, 0, 0, a, 1, tq, w, 1, info )
158  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
159  infot = 3
160  CALL cungbr( 'P', 0, 1, 1, a, 1, tq, w, 1, info )
161  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
162  infot = 4
163  CALL cungbr( 'Q', 0, 0, -1, a, 1, tq, w, 1, info )
164  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
165  infot = 6
166  CALL cungbr( 'Q', 2, 1, 1, a, 1, tq, w, 1, info )
167  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
168  infot = 9
169  CALL cungbr( 'Q', 2, 2, 1, a, 2, tq, w, 1, info )
170  CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
171  nt = nt + 10
172 *
173 * CUNMBR
174 *
175  srnamt = 'CUNMBR'
176  infot = 1
177  CALL cunmbr( '/', 'L', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
178  $ info )
179  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
180  infot = 2
181  CALL cunmbr( 'Q', '/', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
182  $ info )
183  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
184  infot = 3
185  CALL cunmbr( 'Q', 'L', '/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
186  $ info )
187  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
188  infot = 4
189  CALL cunmbr( 'Q', 'L', 'C', -1, 0, 0, a, 1, tq, u, 1, w, 1,
190  $ info )
191  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
192  infot = 5
193  CALL cunmbr( 'Q', 'L', 'C', 0, -1, 0, a, 1, tq, u, 1, w, 1,
194  $ info )
195  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
196  infot = 6
197  CALL cunmbr( 'Q', 'L', 'C', 0, 0, -1, a, 1, tq, u, 1, w, 1,
198  $ info )
199  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
200  infot = 8
201  CALL cunmbr( 'Q', 'L', 'C', 2, 0, 0, a, 1, tq, u, 2, w, 1,
202  $ info )
203  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
204  infot = 8
205  CALL cunmbr( 'Q', 'R', 'C', 0, 2, 0, a, 1, tq, u, 1, w, 1,
206  $ info )
207  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
208  infot = 8
209  CALL cunmbr( 'P', 'L', 'C', 2, 0, 2, a, 1, tq, u, 2, w, 1,
210  $ info )
211  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
212  infot = 8
213  CALL cunmbr( 'P', 'R', 'C', 0, 2, 2, a, 1, tq, u, 1, w, 1,
214  $ info )
215  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
216  infot = 11
217  CALL cunmbr( 'Q', 'R', 'C', 2, 0, 0, a, 1, tq, u, 1, w, 1,
218  $ info )
219  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
220  infot = 13
221  CALL cunmbr( 'Q', 'L', 'C', 0, 2, 0, a, 1, tq, u, 1, w, 0,
222  $ info )
223  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
224  infot = 13
225  CALL cunmbr( 'Q', 'R', 'C', 2, 0, 0, a, 1, tq, u, 2, w, 0,
226  $ info )
227  CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
228  nt = nt + 13
229 *
230 * CBDSQR
231 *
232  srnamt = 'CBDSQR'
233  infot = 1
234  CALL cbdsqr( '/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
235  $ info )
236  CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
237  infot = 2
238  CALL cbdsqr( 'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
239  $ info )
240  CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
241  infot = 3
242  CALL cbdsqr( 'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
243  $ info )
244  CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
245  infot = 4
246  CALL cbdsqr( 'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, rw,
247  $ info )
248  CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
249  infot = 5
250  CALL cbdsqr( 'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, rw,
251  $ info )
252  CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
253  infot = 9
254  CALL cbdsqr( 'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
255  $ info )
256  CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
257  infot = 11
258  CALL cbdsqr( 'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, rw,
259  $ info )
260  CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
261  infot = 13
262  CALL cbdsqr( 'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, rw,
263  $ info )
264  CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
265  nt = nt + 8
266  END IF
267 *
268 * Print a summary line.
269 *
270  IF( ok ) THEN
271  WRITE( nout, fmt = 9999 )path, nt
272  ELSE
273  WRITE( nout, fmt = 9998 )path
274  END IF
275 *
276  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
277  $ i3, ' tests done)' )
278  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
279  $ 'exits ***' )
280 *
281  RETURN
282 *
283 * End of CERRBD
284 *
subroutine cungbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGBR
Definition: cungbr.f:159
subroutine cunmbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMBR
Definition: cunmbr.f:199
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine cbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, RWORK, INFO)
CBDSQR
Definition: cbdsqr.f:224
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine cgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
CGEBRD
Definition: cgebrd.f:208

Here is the call graph for this function:

Here is the caller graph for this function: