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

◆ zerrec()

subroutine zerrec ( character*3  path,
integer  nunit 
)

ZERREC

Purpose:
 ZERREC tests the error exits for the routines for eigen- condition
 estimation for DOUBLE PRECISION matrices:
    ZTRSYL, ZTRSYL3, ZTREXC, ZTRSNA and ZTRSEN.
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 zerrec.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 DOUBLE PRECISION ONE, ZERO
72 parameter( one = 1.0d0, zero = 0.0d0 )
73* ..
74* .. Local Scalars ..
75 INTEGER I, IFST, ILST, INFO, J, M, NT
76 DOUBLE PRECISION SCALE
77* ..
78* .. Local Arrays ..
79 LOGICAL SEL( NMAX )
80 DOUBLE PRECISION RW( LW ), S( NMAX ), SEP( NMAX ), SWORK( NMAX )
81 COMPLEX*16 A( NMAX, NMAX ), B( NMAX, NMAX ),
82 $ C( NMAX, NMAX ), WORK( LW ), X( NMAX )
83* ..
84* .. External Subroutines ..
85 EXTERNAL chkxer, ztrexc, ztrsen, ztrsna, ztrsyl
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 ZTRSYL
116*
117 srnamt = 'ZTRSYL'
118 infot = 1
119 CALL ztrsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
120 CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
121 infot = 2
122 CALL ztrsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123 CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
124 infot = 3
125 CALL ztrsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
126 CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
127 infot = 4
128 CALL ztrsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
129 CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
130 infot = 5
131 CALL ztrsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
132 CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
133 infot = 7
134 CALL ztrsyl( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
135 CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
136 infot = 9
137 CALL ztrsyl( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
138 CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
139 infot = 11
140 CALL ztrsyl( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
141 CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
142 nt = nt + 8
143*
144* Test ZTRSYL3
145*
146 srnamt = 'ZTRSYL3'
147 infot = 1
148 CALL ztrsyl3( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale,
149 $ swork, nmax, info )
150 CALL chkxer( 'ZTRSYL3', infot, nout, lerr, ok )
151 infot = 2
152 CALL ztrsyl3( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale,
153 $ swork, nmax, info )
154 CALL chkxer( 'ZTRSYL3', infot, nout, lerr, ok )
155 infot = 3
156 CALL ztrsyl3( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale,
157 $ swork, nmax, info )
158 CALL chkxer( 'ZTRSYL3', infot, nout, lerr, ok )
159 infot = 4
160 CALL ztrsyl3( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale,
161 $ swork, nmax, info )
162 CALL chkxer( 'ZTRSYL3', infot, nout, lerr, ok )
163 infot = 5
164 CALL ztrsyl3( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale,
165 $ swork, nmax, info )
166 CALL chkxer( 'ZTRSYL3', infot, nout, lerr, ok )
167 infot = 7
168 CALL ztrsyl3( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale,
169 $ swork, nmax, info )
170 CALL chkxer( 'ZTRSYL3', infot, nout, lerr, ok )
171 infot = 9
172 CALL ztrsyl3( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale,
173 $ swork, nmax, info )
174 CALL chkxer( 'ZTRSYL3', infot, nout, lerr, ok )
175 infot = 11
176 CALL ztrsyl3( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale,
177 $ swork, nmax, info )
178 CALL chkxer( 'ZTRSYL3', infot, nout, lerr, ok )
179 nt = nt + 8
180*
181* Test ZTREXC
182*
183 srnamt = 'ZTREXC'
184 ifst = 1
185 ilst = 1
186 infot = 1
187 CALL ztrexc( 'X', 1, a, 1, b, 1, ifst, ilst, info )
188 CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
189 infot = 2
190 CALL ztrexc( 'N', -1, a, 1, b, 1, ifst, ilst, info )
191 CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
192 infot = 4
193 ilst = 2
194 CALL ztrexc( 'N', 2, a, 1, b, 1, ifst, ilst, info )
195 CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
196 infot = 6
197 CALL ztrexc( 'V', 2, a, 2, b, 1, ifst, ilst, info )
198 CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
199 infot = 7
200 ifst = 0
201 ilst = 1
202 CALL ztrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
203 CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
204 infot = 7
205 ifst = 2
206 CALL ztrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
207 CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
208 infot = 8
209 ifst = 1
210 ilst = 0
211 CALL ztrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
212 CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
213 infot = 8
214 ilst = 2
215 CALL ztrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
216 CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
217 nt = nt + 8
218*
219* Test ZTRSNA
220*
221 srnamt = 'ZTRSNA'
222 infot = 1
223 CALL ztrsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
224 $ work, 1, rw, info )
225 CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
226 infot = 2
227 CALL ztrsna( 'B', 'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
228 $ work, 1, rw, info )
229 CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
230 infot = 4
231 CALL ztrsna( 'B', 'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
232 $ work, 1, rw, info )
233 CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
234 infot = 6
235 CALL ztrsna( 'V', 'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
236 $ work, 2, rw, info )
237 CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
238 infot = 8
239 CALL ztrsna( 'B', 'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
240 $ work, 2, rw, info )
241 CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
242 infot = 10
243 CALL ztrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
244 $ work, 2, rw, info )
245 CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
246 infot = 13
247 CALL ztrsna( 'B', 'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
248 $ work, 1, rw, info )
249 CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
250 infot = 13
251 CALL ztrsna( 'B', 'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
252 $ work, 1, rw, info )
253 CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
254 infot = 16
255 CALL ztrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
256 $ work, 1, rw, info )
257 CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
258 nt = nt + 9
259*
260* Test ZTRSEN
261*
262 sel( 1 ) = .false.
263 srnamt = 'ZTRSEN'
264 infot = 1
265 CALL ztrsen( 'X', 'N', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
266 $ work, 1, info )
267 CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
268 infot = 2
269 CALL ztrsen( 'N', 'X', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
270 $ work, 1, info )
271 CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
272 infot = 4
273 CALL ztrsen( 'N', 'N', sel, -1, a, 1, b, 1, x, m, s( 1 ),
274 $ sep( 1 ), work, 1, info )
275 CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
276 infot = 6
277 CALL ztrsen( 'N', 'N', sel, 2, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
278 $ work, 2, info )
279 CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
280 infot = 8
281 CALL ztrsen( 'N', 'V', sel, 2, a, 2, b, 1, x, m, s( 1 ), sep( 1 ),
282 $ work, 1, info )
283 CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
284 infot = 14
285 CALL ztrsen( 'N', 'V', sel, 2, a, 2, b, 2, x, m, s( 1 ), sep( 1 ),
286 $ work, 0, info )
287 CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
288 infot = 14
289 CALL ztrsen( 'E', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
290 $ work, 1, info )
291 CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
292 infot = 14
293 CALL ztrsen( 'V', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
294 $ work, 3, info )
295 CALL chkxer( 'ZTRSEN', 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 ZERREC
313*
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
ztrexc
subroutine ztrexc(compq, n, t, ldt, q, ldq, ifst, ilst, info)
ZTREXC
Definition ztrexc.f:126
ztrsen
subroutine ztrsen(job, compq, select, n, t, ldt, q, ldq, w, m, s, sep, work, lwork, info)
ZTRSEN
Definition ztrsen.f:264
ztrsna
subroutine ztrsna(job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, rwork, info)
ZTRSNA
Definition ztrsna.f:249
ztrsyl3
subroutine ztrsyl3(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, swork, ldswork, info)
ZTRSYL3
Definition ztrsyl3.f:157
ztrsyl
subroutine ztrsyl(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, info)
ZTRSYL
Definition ztrsyl.f:157
Here is the call graph for this function:
Here is the caller graph for this function: