LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
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, CTRSYL3, 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 ), SWORK( 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, ctrsyl3
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 CTRSYL3
145*
146 srnamt = 'CTRSYL3'
147 infot = 1
148 CALL ctrsyl3( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale,
149 $ swork, nmax, info )
150 CALL chkxer( 'CTRSYL3', infot, nout, lerr, ok )
151 infot = 2
152 CALL ctrsyl3( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale,
153 $ swork, nmax, info )
154 CALL chkxer( 'CTRSYL3', infot, nout, lerr, ok )
155 infot = 3
156 CALL ctrsyl3( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale,
157 $ swork, nmax, info )
158 CALL chkxer( 'CTRSYL3', infot, nout, lerr, ok )
159 infot = 4
160 CALL ctrsyl3( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale,
161 $ swork, nmax, info )
162 CALL chkxer( 'CTRSYL3', infot, nout, lerr, ok )
163 infot = 5
164 CALL ctrsyl3( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale,
165 $ swork, nmax, info )
166 CALL chkxer( 'CTRSYL3', infot, nout, lerr, ok )
167 infot = 7
168 CALL ctrsyl3( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale,
169 $ swork, nmax, info )
170 CALL chkxer( 'CTRSYL3', infot, nout, lerr, ok )
171 infot = 9
172 CALL ctrsyl3( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale,
173 $ swork, nmax, info )
174 CALL chkxer( 'CTRSYL3', infot, nout, lerr, ok )
175 infot = 11
176 CALL ctrsyl3( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale,
177 $ swork, nmax, info )
178 CALL chkxer( 'CTRSYL3', infot, nout, lerr, ok )
179 nt = nt + 8
180*
181* Test CTREXC
182*
183 srnamt = 'CTREXC'
184 ifst = 1
185 ilst = 1
186 infot = 1
187 CALL ctrexc( 'X', 1, a, 1, b, 1, ifst, ilst, info )
188 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
189 infot = 2
190 CALL ctrexc( 'N', -1, a, 1, b, 1, ifst, ilst, info )
191 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
192 infot = 4
193 ilst = 2
194 CALL ctrexc( 'N', 2, a, 1, b, 1, ifst, ilst, info )
195 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
196 infot = 6
197 CALL ctrexc( 'V', 2, a, 2, b, 1, ifst, ilst, info )
198 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
199 infot = 7
200 ifst = 0
201 ilst = 1
202 CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
203 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
204 infot = 7
205 ifst = 2
206 CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
207 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
208 infot = 8
209 ifst = 1
210 ilst = 0
211 CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
212 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
213 infot = 8
214 ilst = 2
215 CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
216 CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
217 nt = nt + 8
218*
219* Test CTRSNA
220*
221 srnamt = 'CTRSNA'
222 infot = 1
223 CALL ctrsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
224 $ work, 1, rw, info )
225 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
226 infot = 2
227 CALL ctrsna( 'B', 'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
228 $ work, 1, rw, info )
229 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
230 infot = 4
231 CALL ctrsna( 'B', 'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
232 $ work, 1, rw, info )
233 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
234 infot = 6
235 CALL ctrsna( 'V', 'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
236 $ work, 2, rw, info )
237 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
238 infot = 8
239 CALL ctrsna( 'B', 'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
240 $ work, 2, rw, info )
241 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
242 infot = 10
243 CALL ctrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
244 $ work, 2, rw, info )
245 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
246 infot = 13
247 CALL ctrsna( 'B', 'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
248 $ work, 1, rw, info )
249 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
250 infot = 13
251 CALL ctrsna( 'B', 'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
252 $ work, 1, rw, info )
253 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
254 infot = 16
255 CALL ctrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
256 $ work, 1, rw, info )
257 CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
258 nt = nt + 9
259*
260* Test CTRSEN
261*
262 sel( 1 ) = .false.
263 srnamt = 'CTRSEN'
264 infot = 1
265 CALL ctrsen( 'X', 'N', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
266 $ work, 1, info )
267 CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
268 infot = 2
269 CALL ctrsen( 'N', 'X', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
270 $ work, 1, info )
271 CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
272 infot = 4
273 CALL ctrsen( 'N', 'N', sel, -1, a, 1, b, 1, x, m, s( 1 ),
274 $ sep( 1 ), work, 1, info )
275 CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
276 infot = 6
277 CALL ctrsen( 'N', 'N', sel, 2, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
278 $ work, 2, info )
279 CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
280 infot = 8
281 CALL ctrsen( 'N', 'V', sel, 2, a, 2, b, 1, x, m, s( 1 ), sep( 1 ),
282 $ work, 1, info )
283 CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
284 infot = 14
285 CALL ctrsen( 'N', 'V', sel, 2, a, 2, b, 2, x, m, s( 1 ), sep( 1 ),
286 $ work, 0, info )
287 CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
288 infot = 14
289 CALL ctrsen( 'E', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
290 $ work, 1, info )
291 CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
292 infot = 14
293 CALL ctrsen( 'V', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
294 $ work, 3, info )
295 CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
296 nt = nt + 8
297*
298* Print a summary line.
299*
300 IF( ok ) THEN
301 WRITE( nout, fmt = 9999 )path, nt
302 ELSE
303 WRITE( nout, fmt = 9998 )path
304 END IF
305*
306 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
307 $ i3, ' tests done)' )
308 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
309 $ 'exits ***' )
310 RETURN
311*
312* End of CERREC
313*
314 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
cerrec
subroutine cerrec(path, nunit)
CERREC
Definition cerrec.f:56
ctrexc
subroutine ctrexc(compq, n, t, ldt, q, ldq, ifst, ilst, info)
CTREXC
Definition ctrexc.f:126
ctrsen
subroutine ctrsen(job, compq, select, n, t, ldt, q, ldq, w, m, s, sep, work, lwork, info)
CTRSEN
Definition ctrsen.f:264
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
ctrsyl3
subroutine ctrsyl3(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, swork, ldswork, info)
CTRSYL3
Definition ctrsyl3.f:156
ctrsyl
subroutine ctrsyl(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, info)
CTRSYL
Definition ctrsyl.f:157