70 DOUBLE PRECISION ONE, ZERO
71 parameter( nmax = 4, one = 1.0d0, zero = 0.0d0 )
74 INTEGER I, IFST, ILST, INFO, J, M, NT
75 DOUBLE PRECISION SCALE
80 DOUBLE PRECISION A( NMAX, NMAX ), B( NMAX, NMAX ),
81 $ C( NMAX, NMAX ), S( NMAX ), SEP( NMAX ),
82 $ WI( NMAX ), WORK( NMAX ), WR( NMAX )
93 COMMON / infoc / infot, nout, ok, lerr
94 COMMON / srnamc / srnamt
119 CALL dtrsyl(
'X',
'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
120 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
122 CALL dtrsyl(
'N',
'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
125 CALL dtrsyl(
'N',
'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
126 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
128 CALL dtrsyl(
'N',
'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
129 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
131 CALL dtrsyl(
'N',
'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
132 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
134 CALL dtrsyl(
'N',
'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
135 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
137 CALL dtrsyl(
'N',
'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
138 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
140 CALL dtrsyl(
'N',
'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
141 CALL chkxer(
'DTRSYL', infot, nout, lerr, ok )
150 CALL dtrexc(
'X', 1, a, 1, b, 1, ifst, ilst, work, info )
151 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
153 CALL dtrexc(
'N', -1, a, 1, b, 1, ifst, ilst, work, info )
154 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
157 CALL dtrexc(
'N', 2, a, 1, b, 1, ifst, ilst, work, info )
158 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
160 CALL dtrexc(
'V', 2, a, 2, b, 1, ifst, ilst, work, info )
161 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
165 CALL dtrexc(
'V', 1, a, 1, b, 1, ifst, ilst, work, info )
166 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
169 CALL dtrexc(
'V', 1, a, 1, b, 1, ifst, ilst, work, info )
170 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
174 CALL dtrexc(
'V', 1, a, 1, b, 1, ifst, ilst, work, info )
175 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
178 CALL dtrexc(
'V', 1, a, 1, b, 1, ifst, ilst, work, info )
179 CALL chkxer(
'DTREXC', infot, nout, lerr, ok )
186 CALL dtrsna(
'X',
'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
187 $ work, 1, iwork, info )
188 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
190 CALL dtrsna(
'B',
'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
191 $ work, 1, iwork, info )
192 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
194 CALL dtrsna(
'B',
'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
195 $ work, 1, iwork, info )
196 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
198 CALL dtrsna(
'V',
'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
199 $ work, 2, iwork, info )
200 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
202 CALL dtrsna(
'B',
'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
203 $ work, 2, iwork, info )
204 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
206 CALL dtrsna(
'B',
'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
207 $ work, 2, iwork, info )
208 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
210 CALL dtrsna(
'B',
'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
211 $ work, 1, iwork, info )
212 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
214 CALL dtrsna(
'B',
'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
215 $ work, 2, iwork, info )
216 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
218 CALL dtrsna(
'B',
'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
219 $ work, 1, iwork, info )
220 CALL chkxer(
'DTRSNA', infot, nout, lerr, ok )
228 CALL dtrsen(
'X',
'N', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
229 $ sep( 1 ), work, 1, iwork, 1, info )
230 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
232 CALL dtrsen(
'N',
'X', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
233 $ sep( 1 ), work, 1, iwork, 1, info )
234 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
236 CALL dtrsen(
'N',
'N', sel, -1, a, 1, b, 1, wr, wi, m, s( 1 ),
237 $ sep( 1 ), work, 1, iwork, 1, info )
238 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
240 CALL dtrsen(
'N',
'N', sel, 2, a, 1, b, 1, wr, wi, m, s( 1 ),
241 $ sep( 1 ), work, 2, iwork, 1, info )
242 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
244 CALL dtrsen(
'N',
'V', sel, 2, a, 2, b, 1, wr, wi, m, s( 1 ),
245 $ sep( 1 ), work, 1, iwork, 1, info )
246 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
248 CALL dtrsen(
'N',
'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
249 $ sep( 1 ), work, 0, iwork, 1, info )
250 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
252 CALL dtrsen(
'E',
'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
253 $ sep( 1 ), work, 1, iwork, 1, info )
254 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
256 CALL dtrsen(
'V',
'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
257 $ sep( 1 ), work, 3, iwork, 2, info )
258 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
260 CALL dtrsen(
'E',
'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
261 $ sep( 1 ), work, 1, iwork, 0, info )
262 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
264 CALL dtrsen(
'V',
'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
265 $ sep( 1 ), work, 4, iwork, 1, info )
266 CALL chkxer(
'DTRSEN', infot, nout, lerr, ok )
272 WRITE( nout, fmt = 9999 )path, nt
274 WRITE( nout, fmt = 9998 )path
278 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits (',
279 $ i3,
' tests done)' )
280 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ex',
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine derrec(PATH, NUNIT)
DERREC
subroutine dtrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO)
DTREXC
subroutine dtrsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO)
DTRSNA
subroutine dtrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
DTRSEN
subroutine dtrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
DTRSYL