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', 0, 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 derrec(PATH, NUNIT)
DERREC
subroutine dtrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO)
DTREXC
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine dtrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
DTRSYL
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dtrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
DTRSEN
subroutine dtrsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO)
DTRSNA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j