LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cerrbd()

subroutine cerrbd ( character*3  path,
integer  nunit 
)

CERRBD

Purpose:
 CERRBD tests the error exits for CGEBD2, 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 54 of file cerrbd.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* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER I, INFO, J, NT
74* ..
75* .. Local Arrays ..
76 REAL D( NMAX ), E( NMAX ), RW( 4*NMAX )
77 COMPLEX A( NMAX, NMAX ), TP( NMAX ), TQ( NMAX ),
78 $ U( NMAX, NMAX ), V( NMAX, NMAX ), W( LW )
79* ..
80* .. External Functions ..
81 LOGICAL LSAMEN
82 EXTERNAL lsamen
83* ..
84* .. External Subroutines ..
85 EXTERNAL chkxer, cbdsqr, cgebd2, cgebrd, cungbr,
86 $ cunmbr
87* ..
88* .. Scalars in Common ..
89 LOGICAL LERR, OK
90 CHARACTER*32 SRNAMT
91 INTEGER INFOT, NOUT
92* ..
93* .. Common blocks ..
94 COMMON / infoc / infot, nout, ok, lerr
95 COMMON / srnamc / srnamt
96* ..
97* .. Intrinsic Functions ..
98 INTRINSIC real
99* ..
100* .. Executable Statements ..
101*
102 nout = nunit
103 WRITE( nout, fmt = * )
104 c2 = path( 2: 3 )
105*
106* Set the variables to innocuous values.
107*
108 DO 20 j = 1, nmax
109 DO 10 i = 1, nmax
110 a( i, j ) = 1. / real( i+j )
111 10 CONTINUE
112 20 CONTINUE
113 ok = .true.
114 nt = 0
115*
116* Test error exits of the SVD routines.
117*
118 IF( lsamen( 2, c2, 'BD' ) ) THEN
119*
120* CGEBRD
121*
122 srnamt = 'CGEBRD'
123 infot = 1
124 CALL cgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
125 CALL chkxer( 'CGEBRD', infot, nout, lerr, ok )
126 infot = 2
127 CALL cgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
128 CALL chkxer( 'CGEBRD', infot, nout, lerr, ok )
129 infot = 4
130 CALL cgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
131 CALL chkxer( 'CGEBRD', infot, nout, lerr, ok )
132 infot = 10
133 CALL cgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
134 CALL chkxer( 'CGEBRD', infot, nout, lerr, ok )
135 nt = nt + 4
136*
137* CGEBD2
138*
139 srnamt = 'CGEBD2'
140 infot = 1
141 CALL cgebd2( -1, 0, a, 1, d, e, tq, tp, w, info )
142 CALL chkxer( 'CGEBD2', infot, nout, lerr, ok )
143 infot = 2
144 CALL cgebd2( 0, -1, a, 1, d, e, tq, tp, w, info )
145 CALL chkxer( 'CGEBD2', infot, nout, lerr, ok )
146 infot = 4
147 CALL cgebd2( 2, 1, a, 1, d, e, tq, tp, w, info )
148 CALL chkxer( 'CGEBD2', infot, nout, lerr, ok )
149 nt = nt + 3
150*
151* CUNGBR
152*
153 srnamt = 'CUNGBR'
154 infot = 1
155 CALL cungbr( '/', 0, 0, 0, a, 1, tq, w, 1, info )
156 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
157 infot = 2
158 CALL cungbr( 'Q', -1, 0, 0, a, 1, tq, w, 1, info )
159 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
160 infot = 3
161 CALL cungbr( 'Q', 0, -1, 0, a, 1, tq, w, 1, info )
162 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
163 infot = 3
164 CALL cungbr( 'Q', 0, 1, 0, a, 1, tq, w, 1, info )
165 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
166 infot = 3
167 CALL cungbr( 'Q', 1, 0, 1, a, 1, tq, w, 1, info )
168 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
169 infot = 3
170 CALL cungbr( 'P', 1, 0, 0, a, 1, tq, w, 1, info )
171 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
172 infot = 3
173 CALL cungbr( 'P', 0, 1, 1, a, 1, tq, w, 1, info )
174 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
175 infot = 4
176 CALL cungbr( 'Q', 0, 0, -1, a, 1, tq, w, 1, info )
177 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
178 infot = 6
179 CALL cungbr( 'Q', 2, 1, 1, a, 1, tq, w, 1, info )
180 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
181 infot = 9
182 CALL cungbr( 'Q', 2, 2, 1, a, 2, tq, w, 1, info )
183 CALL chkxer( 'CUNGBR', infot, nout, lerr, ok )
184 nt = nt + 10
185*
186* CUNMBR
187*
188 srnamt = 'CUNMBR'
189 infot = 1
190 CALL cunmbr( '/', 'L', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
191 $ info )
192 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
193 infot = 2
194 CALL cunmbr( 'Q', '/', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
195 $ info )
196 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
197 infot = 3
198 CALL cunmbr( 'Q', 'L', '/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
199 $ info )
200 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
201 infot = 4
202 CALL cunmbr( 'Q', 'L', 'C', -1, 0, 0, a, 1, tq, u, 1, w, 1,
203 $ info )
204 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
205 infot = 5
206 CALL cunmbr( 'Q', 'L', 'C', 0, -1, 0, a, 1, tq, u, 1, w, 1,
207 $ info )
208 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
209 infot = 6
210 CALL cunmbr( 'Q', 'L', 'C', 0, 0, -1, a, 1, tq, u, 1, w, 1,
211 $ info )
212 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
213 infot = 8
214 CALL cunmbr( 'Q', 'L', 'C', 2, 0, 0, a, 1, tq, u, 2, w, 1,
215 $ info )
216 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
217 infot = 8
218 CALL cunmbr( 'Q', 'R', 'C', 0, 2, 0, a, 1, tq, u, 1, w, 1,
219 $ info )
220 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
221 infot = 8
222 CALL cunmbr( 'P', 'L', 'C', 2, 0, 2, a, 1, tq, u, 2, w, 1,
223 $ info )
224 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
225 infot = 8
226 CALL cunmbr( 'P', 'R', 'C', 0, 2, 2, a, 1, tq, u, 1, w, 1,
227 $ info )
228 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
229 infot = 11
230 CALL cunmbr( 'Q', 'R', 'C', 2, 0, 0, a, 1, tq, u, 1, w, 1,
231 $ info )
232 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
233 infot = 13
234 CALL cunmbr( 'Q', 'L', 'C', 0, 2, 0, a, 1, tq, u, 1, w, 0,
235 $ info )
236 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
237 infot = 13
238 CALL cunmbr( 'Q', 'R', 'C', 2, 0, 0, a, 1, tq, u, 2, w, 0,
239 $ info )
240 CALL chkxer( 'CUNMBR', infot, nout, lerr, ok )
241 nt = nt + 13
242*
243* CBDSQR
244*
245 srnamt = 'CBDSQR'
246 infot = 1
247 CALL cbdsqr( '/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
248 $ info )
249 CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
250 infot = 2
251 CALL cbdsqr( 'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
252 $ info )
253 CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
254 infot = 3
255 CALL cbdsqr( 'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
256 $ info )
257 CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
258 infot = 4
259 CALL cbdsqr( 'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, rw,
260 $ info )
261 CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
262 infot = 5
263 CALL cbdsqr( 'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, rw,
264 $ info )
265 CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
266 infot = 9
267 CALL cbdsqr( 'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
268 $ info )
269 CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
270 infot = 11
271 CALL cbdsqr( 'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, rw,
272 $ info )
273 CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
274 infot = 13
275 CALL cbdsqr( 'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, rw,
276 $ info )
277 CALL chkxer( 'CBDSQR', infot, nout, lerr, ok )
278 nt = nt + 8
279 END IF
280*
281* Print a summary line.
282*
283 IF( ok ) THEN
284 WRITE( nout, fmt = 9999 )path, nt
285 ELSE
286 WRITE( nout, fmt = 9998 )path
287 END IF
288*
289 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
290 $ i3, ' tests done)' )
291 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
292 $ 'exits ***' )
293*
294 RETURN
295*
296* End of CERRBD
297*
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
cbdsqr
subroutine cbdsqr(uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c, ldc, rwork, info)
CBDSQR
Definition cbdsqr.f:233
cgebd2
subroutine cgebd2(m, n, a, lda, d, e, tauq, taup, work, info)
CGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
Definition cgebd2.f:190
cgebrd
subroutine cgebrd(m, n, a, lda, d, e, tauq, taup, work, lwork, info)
CGEBRD
Definition cgebrd.f:206
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
cungbr
subroutine cungbr(vect, m, n, k, a, lda, tau, work, lwork, info)
CUNGBR
Definition cungbr.f:157
cunmbr
subroutine cunmbr(vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
CUNMBR
Definition cunmbr.f:197
Here is the call graph for this function:
Here is the caller graph for this function: