OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cerrec.f
Go to the documentation of this file.
1*> \brief \b CERREC
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 CERREC( 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*> CERREC tests the error exits for the routines for eigen- condition
25*> estimation for REAL matrices:
26*> CTRSYL, CTREXC, CTRSNA and CTRSEN.
27*> \endverbatim
28*
29* Arguments:
30* ==========
31*
32*> \param[in] PATH
33*> \verbatim
34*> PATH is CHARACTER*3
35*> The LAPACK path name for the routines to be tested.
36*> \endverbatim
37*>
38*> \param[in] NUNIT
39*> \verbatim
40*> NUNIT is INTEGER
41*> The unit number for output.
42*> \endverbatim
43*
44* Authors:
45* ========
46*
47*> \author Univ. of Tennessee
48*> \author Univ. of California Berkeley
49*> \author Univ. of Colorado Denver
50*> \author NAG Ltd.
51*
52*> \ingroup complex_eig
53*
54* =====================================================================
55 SUBROUTINE cerrec( PATH, NUNIT )
56*
57* -- LAPACK test routine --
58* -- LAPACK is a software package provided by Univ. of Tennessee, --
59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60*
61* .. Scalar Arguments ..
62 CHARACTER*3 PATH
63 INTEGER NUNIT
64* ..
65*
66* =====================================================================
67*
68* .. Parameters ..
69 INTEGER NMAX, LW
70 parameter( nmax = 4, lw = nmax*( nmax+2 ) )
71 REAL ONE, ZERO
72 parameter( one = 1.0e0, zero = 0.0e0 )
73* ..
74* .. Local Scalars ..
75 INTEGER I, IFST, ILST, INFO, J, M, NT
76 REAL SCALE
77* ..
78* .. Local Arrays ..
79 LOGICAL SEL( NMAX )
80 REAL RW( LW ), S( NMAX ), SEP( NMAX )
81 COMPLEX A( NMAX, NMAX ), B( NMAX, NMAX ),
82 $ C( NMAX, NMAX ), WORK( LW ), X( NMAX )
83* ..
84* .. External Subroutines ..
85 EXTERNAL chkxer, ctrexc, ctrsen, ctrsna, ctrsyl
86* ..
87* .. Scalars in Common ..
88 LOGICAL LERR, OK
89 CHARACTER*32 SRNAMT
90 INTEGER INFOT, NOUT
91* ..
92* .. Common blocks ..
93 COMMON / infoc / infot, nout, ok, lerr
94 COMMON / srnamc / srnamt
95* ..
96* .. Executable Statements ..
97*
98 nout = nunit
99 ok = .true.
100 nt = 0
101*
102* Initialize A, B and SEL
103*
104 DO 20 j = 1, nmax
105 DO 10 i = 1, nmax
106 a( i, j ) = zero
107 b( i, j ) = zero
108 10 CONTINUE
109 20 CONTINUE
110 DO 30 i = 1, nmax
111 a( i, i ) = one
112 sel( i ) = .true.
113 30 CONTINUE
114*
115* Test CTRSYL
116*
117 srnamt = 'CTRSYL'
118 infot = 1
119 CALL ctrsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
120 CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
121 infot = 2
122 CALL ctrsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123 CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
124 infot = 3
125 CALL ctrsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
126 CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
127 infot = 4
128 CALL ctrsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
129 CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
130 infot = 5
131 CALL ctrsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
132 CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
133 infot = 7
134 CALL ctrsyl( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
135 CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
136 infot = 9
137 CALL ctrsyl( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
138 CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
139 infot = 11
140 CALL ctrsyl( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
141 CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
142 nt = nt + 8
143*
144* Test CTREXC
145*
146 srnamt = 'CTREXC'
147 ifst = 1
148 ilst = 1
149 infot = 1
150 CALL ctrexc( 'X', 1, a, 1, b, 1, ifst, ilst, info )
151 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
152 infot = 2
153 CALL ctrexc( 'N', -1, a, 1, b, 1, ifst, ilst, info )
154 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
155 infot = 4
156 ilst = 2
157 CALL ctrexc( 'N', 2, a, 1, b, 1, ifst, ilst, info )
158 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
159 infot = 6
160 CALL ctrexc( 'V', 2, a, 2, b, 1, ifst, ilst, info )
161 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
162 infot = 7
163 ifst = 0
164 ilst = 1
165 CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
166 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
167 infot = 7
168 ifst = 2
169 CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
170 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
171 infot = 8
172 ifst = 1
173 ilst = 0
174 CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
175 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
176 infot = 8
177 ilst = 2
178 CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
179 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
180 nt = nt + 8
181*
182* Test CTRSNA
183*
184 srnamt = 'CTRSNA'
185 infot = 1
186 CALL ctrsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
187 $ work, 1, rw, info )
188 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
189 infot = 2
190 CALL ctrsna( 'b', 'x', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
191 $ WORK, 1, RW, INFO )
192 CALL CHKXER( 'ctrsna', INFOT, NOUT, LERR, OK )
193 INFOT = 4
194 CALL CTRSNA( 'b', 'a', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M,
195 $ WORK, 1, RW, INFO )
196 CALL CHKXER( 'ctrsna', INFOT, NOUT, LERR, OK )
197 INFOT = 6
198 CALL CTRSNA( 'v', 'a', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M,
199 $ WORK, 2, RW, INFO )
200 CALL CHKXER( 'ctrsna', INFOT, NOUT, LERR, OK )
201 INFOT = 8
202 CALL CTRSNA( 'b', 'a', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M,
203 $ WORK, 2, RW, INFO )
204 CALL CHKXER( 'ctrsna', INFOT, NOUT, LERR, OK )
205 INFOT = 10
206 CALL CTRSNA( 'b', 'a', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M,
207 $ WORK, 2, RW, INFO )
208 CALL CHKXER( 'ctrsna', INFOT, NOUT, LERR, OK )
209 INFOT = 13
210 CALL CTRSNA( 'b', 'a', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M,
211 $ WORK, 1, RW, INFO )
212 CALL CHKXER( 'ctrsna', INFOT, NOUT, LERR, OK )
213 INFOT = 13
214 CALL CTRSNA( 'b', 's', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M,
215 $ WORK, 1, RW, INFO )
216 CALL CHKXER( 'ctrsna', INFOT, NOUT, LERR, OK )
217 INFOT = 16
218 CALL CTRSNA( 'b', 'a', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M,
219 $ WORK, 1, RW, INFO )
220 CALL CHKXER( 'ctrsna', INFOT, NOUT, LERR, OK )
221 NT = NT + 9
222*
223* Test CTRSEN
224*
225 SEL( 1 ) = .FALSE.
226 SRNAMT = 'ctrsen'
227 INFOT = 1
228 CALL CTRSEN( 'x', 'n', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
229 $ WORK, 1, INFO )
230 CALL CHKXER( 'ctrsen', INFOT, NOUT, LERR, OK )
231 INFOT = 2
232 CALL CTRSEN( 'n', 'x', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
233 $ WORK, 1, INFO )
234 CALL CHKXER( 'ctrsen', INFOT, NOUT, LERR, OK )
235 INFOT = 4
236 CALL CTRSEN( 'n', 'n', SEL, -1, A, 1, B, 1, X, M, S( 1 ),
237 $ SEP( 1 ), WORK, 1, INFO )
238 CALL CHKXER( 'ctrsen', INFOT, NOUT, LERR, OK )
239 INFOT = 6
240 CALL CTRSEN( 'n', 'n', SEL, 2, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
241 $ WORK, 2, INFO )
242 CALL CHKXER( 'ctrsen', INFOT, NOUT, LERR, OK )
243 INFOT = 8
244 CALL CTRSEN( 'n', 'v', SEL, 2, A, 2, B, 1, X, M, S( 1 ), SEP( 1 ),
245 $ WORK, 1, INFO )
246 CALL CHKXER( 'ctrsen', INFOT, NOUT, LERR, OK )
247 INFOT = 14
248 CALL CTRSEN( 'n', 'v', SEL, 2, A, 2, B, 2, X, M, S( 1 ), SEP( 1 ),
249 $ WORK, 0, INFO )
250 CALL CHKXER( 'ctrsen', INFOT, NOUT, LERR, OK )
251 INFOT = 14
252 CALL CTRSEN( 'e', 'v', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ),
253 $ WORK, 1, INFO )
254 CALL CHKXER( 'ctrsen', INFOT, NOUT, LERR, OK )
255 INFOT = 14
256 CALL CTRSEN( 'v', 'v', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ),
257 $ WORK, 3, INFO )
258 CALL CHKXER( 'ctrsen', INFOT, NOUT, LERR, OK )
259 NT = NT + 8
260*
261* Print a summary line.
262*
263 IF( OK ) THEN
264 WRITE( NOUT, FMT = 9999 )PATH, NT
265 ELSE
266 WRITE( NOUT, FMT = 9998 )PATH
267 END IF
268*
269 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits(',
270 $ I3, ' tests done)' )
271 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
272 $ 'exits ***' )
273 RETURN
274*
275* End of CERREC
276*
277 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
ctrexc
subroutine ctrexc(compq, n, t, ldt, q, ldq, ifst, ilst, info)
CTREXC
Definition ctrexc.f:126
ctrsna
subroutine ctrsna(job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, rwork, info)
CTRSNA
Definition ctrsna.f:249
ctrsen
subroutine ctrsen(job, compq, select, n, t, ldt, q, ldq, w, m, s, sep, work, lwork, info)
CTRSEN
Definition ctrsen.f:264
ctrsyl
subroutine ctrsyl(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, info)
CTRSYL
Definition ctrsyl.f:157
cerrec
subroutine cerrec(path, nunit)
CERREC
Definition cerrec.f:56