OpenRadioss 2025.1.11
OpenRadioss project
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 CGEBRD, CUNGBR, CUNMBR, and CBDSQR.
25*> \endverbatim
26*
27* Arguments:
28* ==========
29*
30*> \param[in] PATH
31*> \verbatim
32*> PATH is CHARACTER*3
33*> The LAPACK path name for the routines to be tested.
34*> \endverbatim
35*>
36*> \param[in] NUNIT
37*> \verbatim
38*> NUNIT is INTEGER
39*> The unit number for output.
40*> \endverbatim
41*
42* Authors:
43* ========
44*
45*> \author Univ. of Tennessee
46*> \author Univ. of California Berkeley
47*> \author Univ. of Colorado Denver
48*> \author NAG Ltd.
49*
50*> \ingroup complex_eig
51*
52* =====================================================================
53 SUBROUTINE cerrbd( PATH, NUNIT )
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*
282 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
the
end diagonal values have been computed in the(sparse) matrix id.SOL
cungbr
subroutine cungbr(vect, m, n, k, a, lda, tau, work, lwork, info)
CUNGBR
Definition cungbr.f:157
cgebrd
subroutine cgebrd(m, n, a, lda, d, e, tauq, taup, work, lwork, info)
CGEBRD
Definition cgebrd.f:206
cbdsqr
subroutine cbdsqr(uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c, ldc, rwork, info)
CBDSQR
Definition cbdsqr.f:222
cunmbr
subroutine cunmbr(vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
CUNMBR
Definition cunmbr.f:197
cerrbd
subroutine cerrbd(path, nunit)
CERRBD
Definition cerrbd.f:54