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

◆ derrec()

subroutine derrec ( character*3  path,
integer  nunit 
)

DERREC

Purpose:
 DERREC tests the error exits for the routines for eigen- condition
 estimation for DOUBLE PRECISION matrices:
    DTRSYL, DTRSYL3, DTREXC, DTRSNA and DTRSEN.
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 derrec.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
70 DOUBLE PRECISION ONE, ZERO
71 parameter( nmax = 4, one = 1.0d0, zero = 0.0d0 )
72* ..
73* .. Local Scalars ..
74 INTEGER I, IFST, ILST, INFO, J, M, NT
75 DOUBLE PRECISION SCALE
76* ..
77* .. Local Arrays ..
78 LOGICAL SEL( NMAX )
79 INTEGER IWORK( NMAX )
80 DOUBLE PRECISION A( NMAX, NMAX ), B( NMAX, NMAX ),
81 $ C( NMAX, NMAX ), S( NMAX ), SEP( NMAX ),
82 $ WI( NMAX ), WORK( NMAX ), WR( NMAX )
83* ..
84* .. External Subroutines ..
85 EXTERNAL chkxer, dtrexc, dtrsen, dtrsna, dtrsyl, dtrsyl3
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 DTRSYL
116*
117 srnamt = 'DTRSYL'
118 infot = 1
119 CALL dtrsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
120 CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
121 infot = 2
122 CALL dtrsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123 CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
124 infot = 3
125 CALL dtrsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
126 CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
127 infot = 4
128 CALL dtrsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
129 CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
130 infot = 5
131 CALL dtrsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
132 CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
133 infot = 7
134 CALL dtrsyl( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
135 CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
136 infot = 9
137 CALL dtrsyl( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
138 CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
139 infot = 11
140 CALL dtrsyl( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
141 CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
142 nt = nt + 8
143*
144* Test DTRSYL3
145*
146 srnamt = 'DTRSYL3'
147 infot = 1
148 CALL dtrsyl3( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale,
149 $ iwork, nmax, work, nmax, info )
150 CALL chkxer( 'DTRSYL3', infot, nout, lerr, ok )
151 infot = 2
152 CALL dtrsyl3( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale,
153 $ iwork, nmax, work, nmax, info )
154 CALL chkxer( 'DTRSYL3', infot, nout, lerr, ok )
155 infot = 3
156 CALL dtrsyl3( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale,
157 $ iwork, nmax, work, nmax, info )
158 CALL chkxer( 'DTRSYL3', infot, nout, lerr, ok )
159 infot = 4
160 CALL dtrsyl3( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale,
161 $ iwork, nmax, work, nmax, info )
162 CALL chkxer( 'DTRSYL3', infot, nout, lerr, ok )
163 infot = 5
164 CALL dtrsyl3( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale,
165 $ iwork, nmax, work, nmax, info )
166 CALL chkxer( 'DTRSYL3', infot, nout, lerr, ok )
167 infot = 7
168 CALL dtrsyl3( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale,
169 $ iwork, nmax, work, nmax, info )
170 CALL chkxer( 'DTRSYL3', infot, nout, lerr, ok )
171 infot = 9
172 CALL dtrsyl3( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale,
173 $ iwork, nmax, work, nmax, info )
174 CALL chkxer( 'DTRSYL3', infot, nout, lerr, ok )
175 infot = 11
176 CALL dtrsyl3( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale,
177 $ iwork, nmax, work, nmax, info )
178 CALL chkxer( 'DTRSYL3', infot, nout, lerr, ok )
179 nt = nt + 8
180*
181* Test DTREXC
182*
183 srnamt = 'DTREXC'
184 ifst = 1
185 ilst = 1
186 infot = 1
187 CALL dtrexc( 'X', 1, a, 1, b, 1, ifst, ilst, work, info )
188 CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
189 infot = 2
190 CALL dtrexc( 'N', -1, a, 1, b, 1, ifst, ilst, work, info )
191 CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
192 infot = 4
193 ilst = 2
194 CALL dtrexc( 'N', 2, a, 1, b, 1, ifst, ilst, work, info )
195 CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
196 infot = 6
197 CALL dtrexc( 'V', 2, a, 2, b, 1, ifst, ilst, work, info )
198 CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
199 infot = 7
200 ifst = 0
201 ilst = 1
202 CALL dtrexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
203 CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
204 infot = 7
205 ifst = 2
206 CALL dtrexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
207 CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
208 infot = 8
209 ifst = 1
210 ilst = 0
211 CALL dtrexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
212 CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
213 infot = 8
214 ilst = 2
215 CALL dtrexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
216 CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
217 nt = nt + 8
218*
219* Test DTRSNA
220*
221 srnamt = 'DTRSNA'
222 infot = 1
223 CALL dtrsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
224 $ work, 1, iwork, info )
225 CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
226 infot = 2
227 CALL dtrsna( 'B', 'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
228 $ work, 1, iwork, info )
229 CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
230 infot = 4
231 CALL dtrsna( 'B', 'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
232 $ work, 1, iwork, info )
233 CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
234 infot = 6
235 CALL dtrsna( 'V', 'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
236 $ work, 2, iwork, info )
237 CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
238 infot = 8
239 CALL dtrsna( 'B', 'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
240 $ work, 2, iwork, info )
241 CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
242 infot = 10
243 CALL dtrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
244 $ work, 2, iwork, info )
245 CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
246 infot = 13
247 CALL dtrsna( 'B', 'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
248 $ work, 1, iwork, info )
249 CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
250 infot = 13
251 CALL dtrsna( 'B', 'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
252 $ work, 2, iwork, info )
253 CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
254 infot = 16
255 CALL dtrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
256 $ work, 1, iwork, info )
257 CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
258 nt = nt + 9
259*
260* Test DTRSEN
261*
262 sel( 1 ) = .false.
263 srnamt = 'DTRSEN'
264 infot = 1
265 CALL dtrsen( 'X', 'N', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
266 $ sep( 1 ), work, 1, iwork, 1, info )
267 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
268 infot = 2
269 CALL dtrsen( 'N', 'X', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
270 $ sep( 1 ), work, 1, iwork, 1, info )
271 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
272 infot = 4
273 CALL dtrsen( 'N', 'N', sel, -1, a, 1, b, 1, wr, wi, m, s( 1 ),
274 $ sep( 1 ), work, 1, iwork, 1, info )
275 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
276 infot = 6
277 CALL dtrsen( 'N', 'N', sel, 2, a, 1, b, 1, wr, wi, m, s( 1 ),
278 $ sep( 1 ), work, 2, iwork, 1, info )
279 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
280 infot = 8
281 CALL dtrsen( 'N', 'V', sel, 2, a, 2, b, 1, wr, wi, m, s( 1 ),
282 $ sep( 1 ), work, 1, iwork, 1, info )
283 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
284 infot = 15
285 CALL dtrsen( 'N', 'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
286 $ sep( 1 ), work, 0, iwork, 1, info )
287 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
288 infot = 15
289 CALL dtrsen( 'E', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
290 $ sep( 1 ), work, 1, iwork, 1, info )
291 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
292 infot = 15
293 CALL dtrsen( 'V', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
294 $ sep( 1 ), work, 3, iwork, 2, info )
295 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
296 infot = 17
297 CALL dtrsen( 'E', 'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
298 $ sep( 1 ), work, 1, iwork, 0, info )
299 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
300 infot = 17
301 CALL dtrsen( 'V', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
302 $ sep( 1 ), work, 4, iwork, 1, info )
303 CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
304 nt = nt + 10
305*
306* Print a summary line.
307*
308 IF( ok ) THEN
309 WRITE( nout, fmt = 9999 )path, nt
310 ELSE
311 WRITE( nout, fmt = 9998 )path
312 END IF
313*
314 RETURN
315 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
316 $ i3, ' tests done)' )
317 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ex',
318 $ 'its ***' )
319*
320* End of DERREC
321*
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
dtrsyl3
subroutine dtrsyl3(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, iwork, liwork, swork, ldswork, info)
DTRSYL3
Definition dtrsyl3.f:181
dtrexc
subroutine dtrexc(compq, n, t, ldt, q, ldq, ifst, ilst, work, info)
DTREXC
Definition dtrexc.f:148
dtrsen
subroutine dtrsen(job, compq, select, n, t, ldt, q, ldq, wr, wi, m, s, sep, work, lwork, iwork, liwork, info)
DTRSEN
Definition dtrsen.f:313
dtrsna
subroutine dtrsna(job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, iwork, info)
DTRSNA
Definition dtrsna.f:265
dtrsyl
subroutine dtrsyl(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, info)
DTRSYL
Definition dtrsyl.f:164
Here is the call graph for this function:
Here is the caller graph for this function: