LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cerrbd.f
Go to the documentation of this file.
1*> \brief \b CERRBD
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE CERRBD( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> CERRBD tests the error exits for CGEBD2, CGEBRD, CUNGBR, CUNMBR,
25*> and CBDSQR.
26*> \endverbatim
27*
28* Arguments:
29* ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*> PATH is CHARACTER*3
34*> The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*> NUNIT is INTEGER
40*> The unit number for output.
41*> \endverbatim
42*
43* Authors:
44* ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup complex_eig
52*
53* =====================================================================
54 SUBROUTINE cerrbd( PATH, NUNIT )
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*
298 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
cerrbd
subroutine cerrbd(path, nunit)
CERRBD
Definition cerrbd.f:55
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
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