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

◆ cerrec()

subroutine cerrec ( character*3  path,
integer  nunit 
)

CERREC

Purpose:
 CERREC tests the error exits for the routines for eigen- condition
 estimation for REAL matrices:
    CTRSYL, CTRSYL3, CTREXC, CTRSNA and CTRSEN.
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 55 of file cerrec.f.

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*
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
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
Here is the call graph for this function:
Here is the caller graph for this function: