LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cerrbd()

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.

Definition at line 53 of file cerrbd.f.

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