74 parameter( nmax = 4, one = 1.0e0, zero = 0.0e0 )
77 INTEGER i, ifst, ilst, info,
j, m, nt
83 REAL 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
strsyl(
'X',
'N', 1, 0, 0, a, 1,
b, 1, c, 1, scale, info )
123 CALL
chkxer(
'STRSYL', infot, nout, lerr, ok )
125 CALL
strsyl(
'N',
'X', 1, 0, 0, a, 1,
b, 1, c, 1, scale, info )
126 CALL
chkxer(
'STRSYL', infot, nout, lerr, ok )
128 CALL
strsyl(
'N',
'N', 0, 0, 0, a, 1,
b, 1, c, 1, scale, info )
129 CALL
chkxer(
'STRSYL', infot, nout, lerr, ok )
131 CALL
strsyl(
'N',
'N', 1, -1, 0, a, 1,
b, 1, c, 1, scale, info )
132 CALL
chkxer(
'STRSYL', infot, nout, lerr, ok )
134 CALL
strsyl(
'N',
'N', 1, 0, -1, a, 1,
b, 1, c, 1, scale, info )
135 CALL
chkxer(
'STRSYL', infot, nout, lerr, ok )
137 CALL
strsyl(
'N',
'N', 1, 2, 0, a, 1,
b, 1, c, 2, scale, info )
138 CALL
chkxer(
'STRSYL', infot, nout, lerr, ok )
140 CALL
strsyl(
'N',
'N', 1, 0, 2, a, 1,
b, 1, c, 1, scale, info )
141 CALL
chkxer(
'STRSYL', infot, nout, lerr, ok )
143 CALL
strsyl(
'N',
'N', 1, 2, 0, a, 2,
b, 1, c, 1, scale, info )
144 CALL
chkxer(
'STRSYL', infot, nout, lerr, ok )
153 CALL
strexc(
'X', 1, a, 1,
b, 1, ifst, ilst, work, info )
154 CALL
chkxer(
'STREXC', infot, nout, lerr, ok )
156 CALL
strexc(
'N', 0, a, 1,
b, 1, ifst, ilst, work, info )
157 CALL
chkxer(
'STREXC', infot, nout, lerr, ok )
160 CALL
strexc(
'N', 2, a, 1,
b, 1, ifst, ilst, work, info )
161 CALL
chkxer(
'STREXC', infot, nout, lerr, ok )
163 CALL
strexc(
'V', 2, a, 2,
b, 1, ifst, ilst, work, info )
164 CALL
chkxer(
'STREXC', infot, nout, lerr, ok )
168 CALL
strexc(
'V', 1, a, 1,
b, 1, ifst, ilst, work, info )
169 CALL
chkxer(
'STREXC', infot, nout, lerr, ok )
172 CALL
strexc(
'V', 1, a, 1,
b, 1, ifst, ilst, work, info )
173 CALL
chkxer(
'STREXC', infot, nout, lerr, ok )
177 CALL
strexc(
'V', 1, a, 1,
b, 1, ifst, ilst, work, info )
178 CALL
chkxer(
'STREXC', infot, nout, lerr, ok )
181 CALL
strexc(
'V', 1, a, 1,
b, 1, ifst, ilst, work, info )
182 CALL
chkxer(
'STREXC', infot, nout, lerr, ok )
189 CALL
strsna(
'X',
'A', sel, 0, a, 1,
b, 1, c, 1, s, sep, 1, m,
190 $ work, 1, iwork, info )
191 CALL
chkxer(
'STRSNA', infot, nout, lerr, ok )
193 CALL
strsna(
'B',
'X', sel, 0, a, 1,
b, 1, c, 1, s, sep, 1, m,
194 $ work, 1, iwork, info )
195 CALL
chkxer(
'STRSNA', infot, nout, lerr, ok )
197 CALL
strsna(
'B',
'A', sel, -1, a, 1,
b, 1, c, 1, s, sep, 1, m,
198 $ work, 1, iwork, info )
199 CALL
chkxer(
'STRSNA', infot, nout, lerr, ok )
201 CALL
strsna(
'V',
'A', sel, 2, a, 1,
b, 1, c, 1, s, sep, 2, m,
202 $ work, 2, iwork, info )
203 CALL
chkxer(
'STRSNA', infot, nout, lerr, ok )
205 CALL
strsna(
'B',
'A', sel, 2, a, 2,
b, 1, c, 2, s, sep, 2, m,
206 $ work, 2, iwork, info )
207 CALL
chkxer(
'STRSNA', infot, nout, lerr, ok )
209 CALL
strsna(
'B',
'A', sel, 2, a, 2,
b, 2, c, 1, s, sep, 2, m,
210 $ work, 2, iwork, info )
211 CALL
chkxer(
'STRSNA', infot, nout, lerr, ok )
213 CALL
strsna(
'B',
'A', sel, 1, a, 1,
b, 1, c, 1, s, sep, 0, m,
214 $ work, 1, iwork, info )
215 CALL
chkxer(
'STRSNA', infot, nout, lerr, ok )
217 CALL
strsna(
'B',
'S', sel, 2, a, 2,
b, 2, c, 2, s, sep, 1, m,
218 $ work, 2, iwork, info )
219 CALL
chkxer(
'STRSNA', infot, nout, lerr, ok )
221 CALL
strsna(
'B',
'A', sel, 2, a, 2,
b, 2, c, 2, s, sep, 2, m,
222 $ work, 1, iwork, info )
223 CALL
chkxer(
'STRSNA', infot, nout, lerr, ok )
231 CALL
strsen(
'X',
'N', sel, 0, a, 1,
b, 1, wr, wi, m, s( 1 ),
232 $ sep( 1 ), work, 1, iwork, 1, info )
233 CALL
chkxer(
'STRSEN', infot, nout, lerr, ok )
235 CALL
strsen(
'N',
'X', sel, 0, a, 1,
b, 1, wr, wi, m, s( 1 ),
236 $ sep( 1 ), work, 1, iwork, 1, info )
237 CALL
chkxer(
'STRSEN', infot, nout, lerr, ok )
239 CALL
strsen(
'N',
'N', sel, -1, a, 1,
b, 1, wr, wi, m, s( 1 ),
240 $ sep( 1 ), work, 1, iwork, 1, info )
241 CALL
chkxer(
'STRSEN', infot, nout, lerr, ok )
243 CALL
strsen(
'N',
'N', sel, 2, a, 1,
b, 1, wr, wi, m, s( 1 ),
244 $ sep( 1 ), work, 2, iwork, 1, info )
245 CALL
chkxer(
'STRSEN', infot, nout, lerr, ok )
247 CALL
strsen(
'N',
'V', sel, 2, a, 2,
b, 1, wr, wi, m, s( 1 ),
248 $ sep( 1 ), work, 1, iwork, 1, info )
249 CALL
chkxer(
'STRSEN', infot, nout, lerr, ok )
251 CALL
strsen(
'N',
'V', sel, 2, a, 2,
b, 2, wr, wi, m, s( 1 ),
252 $ sep( 1 ), work, 0, iwork, 1, info )
253 CALL
chkxer(
'STRSEN', infot, nout, lerr, ok )
255 CALL
strsen(
'E',
'V', sel, 3, a, 3,
b, 3, wr, wi, m, s( 1 ),
256 $ sep( 1 ), work, 1, iwork, 1, info )
257 CALL
chkxer(
'STRSEN', infot, nout, lerr, ok )
259 CALL
strsen(
'V',
'V', sel, 3, a, 3,
b, 3, wr, wi, m, s( 1 ),
260 $ sep( 1 ), work, 3, iwork, 2, info )
261 CALL
chkxer(
'STRSEN', infot, nout, lerr, ok )
263 CALL
strsen(
'E',
'V', sel, 2, a, 2,
b, 2, wr, wi, m, s( 1 ),
264 $ sep( 1 ), work, 1, iwork, 0, info )
265 CALL
chkxer(
'STRSEN', infot, nout, lerr, ok )
267 CALL
strsen(
'V',
'V', sel, 3, a, 3,
b, 3, wr, wi, m, s( 1 ),
268 $ sep( 1 ), work, 4, iwork, 1, info )
269 CALL
chkxer(
'STRSEN', 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 strsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO)
STRSNA
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine strsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
STRSEN
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine strsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
STRSYL
subroutine strexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO)
STREXC
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine serrec(PATH, NUNIT)
SERREC