57 SUBROUTINE derrec( PATH, NUNIT )
73 DOUBLE PRECISION ONE, ZERO
74 parameter ( nmax = 4, one = 1.0d0, zero = 0.0d0 )
77 INTEGER I, IFST, ILST, INFO, J, M, NT
78 DOUBLE PRECISION SCALE
83 DOUBLE PRECISION A( nmax, nmax ), B( nmax, nmax ),
84 $ c( nmax, nmax ), s( nmax ), sep( nmax ),
85 $ wi( nmax ), work( nmax ), wr( nmax )
96 COMMON / infoc / infot, nout, ok, lerr
97 COMMON / srnamc / srnamt
122 CALL dtrsyl(
'X',
'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
125 CALL dtrsyl(
'N',
'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
126 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
128 CALL dtrsyl(
'N',
'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
129 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
131 CALL dtrsyl(
'N',
'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
132 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
134 CALL dtrsyl(
'N',
'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
135 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
137 CALL dtrsyl(
'N',
'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
138 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
140 CALL dtrsyl(
'N',
'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
141 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
143 CALL dtrsyl(
'N',
'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
144 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
153 CALL dtrexc(
'X', 1, a, 1, b, 1, ifst, ilst, work, info )
154 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
156 CALL dtrexc(
'N', -1, a, 1, b, 1, ifst, ilst, work, info )
157 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
160 CALL dtrexc(
'N', 2, a, 1, b, 1, ifst, ilst, work, info )
161 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
163 CALL dtrexc(
'V', 2, a, 2, b, 1, ifst, ilst, work, info )
164 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
168 CALL dtrexc(
'V', 1, a, 1, b, 1, ifst, ilst, work, info )
169 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
172 CALL dtrexc(
'V', 1, a, 1, b, 1, ifst, ilst, work, info )
173 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
177 CALL dtrexc(
'V', 1, a, 1, b, 1, ifst, ilst, work, info )
178 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
181 CALL dtrexc(
'V', 1, a, 1, b, 1, ifst, ilst, work, info )
182 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
189 CALL dtrsna(
'X',
'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
190 $ work, 1, iwork, info )
191 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
193 CALL dtrsna(
'B',
'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
194 $ work, 1, iwork, info )
195 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
197 CALL dtrsna(
'B',
'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
198 $ work, 1, iwork, info )
199 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
201 CALL dtrsna(
'V',
'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
202 $ work, 2, iwork, info )
203 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
205 CALL dtrsna(
'B',
'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
206 $ work, 2, iwork, info )
207 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
209 CALL dtrsna(
'B',
'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
210 $ work, 2, iwork, info )
211 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
213 CALL dtrsna(
'B',
'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
214 $ work, 1, iwork, info )
215 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
217 CALL dtrsna(
'B',
'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
218 $ work, 2, iwork, info )
219 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
221 CALL dtrsna(
'B',
'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
222 $ work, 1, iwork, info )
223 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
231 CALL dtrsen(
'X',
'N', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
232 $ sep( 1 ), work, 1, iwork, 1, info )
233 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
235 CALL dtrsen(
'N',
'X', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
236 $ sep( 1 ), work, 1, iwork, 1, info )
237 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
239 CALL dtrsen(
'N',
'N', sel, -1, a, 1, b, 1, wr, wi, m, s( 1 ),
240 $ sep( 1 ), work, 1, iwork, 1, info )
241 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
243 CALL dtrsen(
'N',
'N', sel, 2, a, 1, b, 1, wr, wi, m, s( 1 ),
244 $ sep( 1 ), work, 2, iwork, 1, info )
245 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
247 CALL dtrsen(
'N',
'V', sel, 2, a, 2, b, 1, wr, wi, m, s( 1 ),
248 $ sep( 1 ), work, 1, iwork, 1, info )
249 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
251 CALL dtrsen(
'N',
'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
252 $ sep( 1 ), work, 0, iwork, 1, info )
253 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
255 CALL dtrsen(
'E',
'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
256 $ sep( 1 ), work, 1, iwork, 1, info )
257 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
259 CALL dtrsen(
'V',
'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
260 $ sep( 1 ), work, 3, iwork, 2, info )
261 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
263 CALL dtrsen(
'E',
'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
264 $ sep( 1 ), work, 1, iwork, 0, info )
265 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
267 CALL dtrsen(
'V',
'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
268 $ sep( 1 ), work, 4, iwork, 1, info )
269 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
275 WRITE( nout, fmt = 9999 )path, nt
277 WRITE( nout, fmt = 9998 )path
281 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits (',
282 $ i3,
' tests done)' )
283 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ex',
subroutine dtrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
DTRSEN
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine dtrsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO)
DTRSNA
subroutine dtrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
DTRSYL
subroutine derrec(PATH, NUNIT)
DERREC
subroutine dtrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO)
DTREXC