73 parameter( nmax = 4, lw = nmax*( nmax+2 ) )
74 DOUBLE PRECISION one, zero
75 parameter( one = 1.0d0, zero = 0.0d0 )
78 INTEGER i, ifst, ilst, info,
j, m, nt
79 DOUBLE PRECISION scale
83 DOUBLE PRECISION rw( lw ), s( nmax ), sep( nmax )
84 COMPLEX*16 a( nmax, nmax ),
b( nmax, nmax ),
85 $ c( nmax, nmax ), work( lw ),
x( nmax )
96 COMMON / infoc / infot, nout, ok, lerr
97 COMMON / srnamc / srnamt
122 CALL
ztrsyl(
'X',
'N', 1, 0, 0, a, 1,
b, 1, c, 1, scale, info )
123 CALL
chkxer(
'ZTRSYL', infot, nout, lerr, ok )
125 CALL
ztrsyl(
'N',
'X', 1, 0, 0, a, 1,
b, 1, c, 1, scale, info )
126 CALL
chkxer(
'ZTRSYL', infot, nout, lerr, ok )
128 CALL
ztrsyl(
'N',
'N', 0, 0, 0, a, 1,
b, 1, c, 1, scale, info )
129 CALL
chkxer(
'ZTRSYL', infot, nout, lerr, ok )
131 CALL
ztrsyl(
'N',
'N', 1, -1, 0, a, 1,
b, 1, c, 1, scale, info )
132 CALL
chkxer(
'ZTRSYL', infot, nout, lerr, ok )
134 CALL
ztrsyl(
'N',
'N', 1, 0, -1, a, 1,
b, 1, c, 1, scale, info )
135 CALL
chkxer(
'ZTRSYL', infot, nout, lerr, ok )
137 CALL
ztrsyl(
'N',
'N', 1, 2, 0, a, 1,
b, 1, c, 2, scale, info )
138 CALL
chkxer(
'ZTRSYL', infot, nout, lerr, ok )
140 CALL
ztrsyl(
'N',
'N', 1, 0, 2, a, 1,
b, 1, c, 1, scale, info )
141 CALL
chkxer(
'ZTRSYL', infot, nout, lerr, ok )
143 CALL
ztrsyl(
'N',
'N', 1, 2, 0, a, 2,
b, 1, c, 1, scale, info )
144 CALL
chkxer(
'ZTRSYL', infot, nout, lerr, ok )
153 CALL
ztrexc(
'X', 1, a, 1,
b, 1, ifst, ilst, info )
154 CALL
chkxer(
'ZTREXC', infot, nout, lerr, ok )
156 CALL
ztrexc(
'N', 0, a, 1,
b, 1, ifst, ilst, info )
157 CALL
chkxer(
'ZTREXC', infot, nout, lerr, ok )
160 CALL
ztrexc(
'N', 2, a, 1,
b, 1, ifst, ilst, info )
161 CALL
chkxer(
'ZTREXC', infot, nout, lerr, ok )
163 CALL
ztrexc(
'V', 2, a, 2,
b, 1, ifst, ilst, info )
164 CALL
chkxer(
'ZTREXC', infot, nout, lerr, ok )
168 CALL
ztrexc(
'V', 1, a, 1,
b, 1, ifst, ilst, info )
169 CALL
chkxer(
'ZTREXC', infot, nout, lerr, ok )
172 CALL
ztrexc(
'V', 1, a, 1,
b, 1, ifst, ilst, info )
173 CALL
chkxer(
'ZTREXC', infot, nout, lerr, ok )
177 CALL
ztrexc(
'V', 1, a, 1,
b, 1, ifst, ilst, info )
178 CALL
chkxer(
'ZTREXC', infot, nout, lerr, ok )
181 CALL
ztrexc(
'V', 1, a, 1,
b, 1, ifst, ilst, info )
182 CALL
chkxer(
'ZTREXC', infot, nout, lerr, ok )
189 CALL
ztrsna(
'X',
'A', sel, 0, a, 1,
b, 1, c, 1, s, sep, 1, m,
190 $ work, 1, rw, info )
191 CALL
chkxer(
'ZTRSNA', infot, nout, lerr, ok )
193 CALL
ztrsna(
'B',
'X', sel, 0, a, 1,
b, 1, c, 1, s, sep, 1, m,
194 $ work, 1, rw, info )
195 CALL
chkxer(
'ZTRSNA', infot, nout, lerr, ok )
197 CALL
ztrsna(
'B',
'A', sel, -1, a, 1,
b, 1, c, 1, s, sep, 1, m,
198 $ work, 1, rw, info )
199 CALL
chkxer(
'ZTRSNA', infot, nout, lerr, ok )
201 CALL
ztrsna(
'V',
'A', sel, 2, a, 1,
b, 1, c, 1, s, sep, 2, m,
202 $ work, 2, rw, info )
203 CALL
chkxer(
'ZTRSNA', infot, nout, lerr, ok )
205 CALL
ztrsna(
'B',
'A', sel, 2, a, 2,
b, 1, c, 2, s, sep, 2, m,
206 $ work, 2, rw, info )
207 CALL
chkxer(
'ZTRSNA', infot, nout, lerr, ok )
209 CALL
ztrsna(
'B',
'A', sel, 2, a, 2,
b, 2, c, 1, s, sep, 2, m,
210 $ work, 2, rw, info )
211 CALL
chkxer(
'ZTRSNA', infot, nout, lerr, ok )
213 CALL
ztrsna(
'B',
'A', sel, 1, a, 1,
b, 1, c, 1, s, sep, 0, m,
214 $ work, 1, rw, info )
215 CALL
chkxer(
'ZTRSNA', infot, nout, lerr, ok )
217 CALL
ztrsna(
'B',
'S', sel, 2, a, 2,
b, 2, c, 2, s, sep, 1, m,
218 $ work, 1, rw, info )
219 CALL
chkxer(
'ZTRSNA', infot, nout, lerr, ok )
221 CALL
ztrsna(
'B',
'A', sel, 2, a, 2,
b, 2, c, 2, s, sep, 2, m,
222 $ work, 1, rw, info )
223 CALL
chkxer(
'ZTRSNA', infot, nout, lerr, ok )
231 CALL
ztrsen(
'X',
'N', sel, 0, a, 1,
b, 1,
x, m, s( 1 ), sep( 1 ),
233 CALL
chkxer(
'ZTRSEN', infot, nout, lerr, ok )
235 CALL
ztrsen(
'N',
'X', sel, 0, a, 1,
b, 1,
x, m, s( 1 ), sep( 1 ),
237 CALL
chkxer(
'ZTRSEN', infot, nout, lerr, ok )
239 CALL
ztrsen(
'N',
'N', sel, -1, a, 1,
b, 1,
x, m, s( 1 ),
240 $ sep( 1 ), work, 1, info )
241 CALL
chkxer(
'ZTRSEN', infot, nout, lerr, ok )
243 CALL
ztrsen(
'N',
'N', sel, 2, a, 1,
b, 1,
x, m, s( 1 ), sep( 1 ),
245 CALL
chkxer(
'ZTRSEN', infot, nout, lerr, ok )
247 CALL
ztrsen(
'N',
'V', sel, 2, a, 2,
b, 1,
x, m, s( 1 ), sep( 1 ),
249 CALL
chkxer(
'ZTRSEN', infot, nout, lerr, ok )
251 CALL
ztrsen(
'N',
'V', sel, 2, a, 2,
b, 2,
x, m, s( 1 ), sep( 1 ),
253 CALL
chkxer(
'ZTRSEN', infot, nout, lerr, ok )
255 CALL
ztrsen(
'E',
'V', sel, 3, a, 3,
b, 3,
x, m, s( 1 ), sep( 1 ),
257 CALL
chkxer(
'ZTRSEN', infot, nout, lerr, ok )
259 CALL
ztrsen(
'V',
'V', sel, 3, a, 3,
b, 3,
x, m, s( 1 ), sep( 1 ),
261 CALL
chkxer(
'ZTRSEN', infot, nout, lerr, ok )
267 WRITE( nout, fmt = 9999 )path, nt
269 WRITE( nout, fmt = 9998 )path
272 9999
FORMAT( 1
x, a3,
' routines passed the tests of the error exits (',
273 $ i3,
' tests done)' )
274 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
subroutine zerrec(PATH, NUNIT)
ZERREC
subroutine ztrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
ZTRSEN
subroutine ztrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
ZTRSYL
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine ztrsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, RWORK, INFO)
ZTRSNA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ztrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
ZTREXC