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',