71 parameter( nmax = 4, lw = nmax )
75 INTEGER i, info,
j, nt
78 DOUBLE PRECISION d( nmax ), e( nmax ), rw( 4*nmax )
79 COMPLEX*16 a( nmax, nmax ), tp( nmax ), tq( nmax ),
80 $ u( nmax, nmax ), v( nmax, nmax ), w( lw )
95 COMMON / infoc / infot, nout, ok, lerr
96 COMMON / srnamc / srnamt
104 WRITE( nout, fmt = * )
111 a( i,
j ) = 1.d0 / dble( i+
j )
119 IF(
lsamen( 2, c2,
'BD' ) )
THEN
125 CALL
zgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
126 CALL
chkxer(
'ZGEBRD', infot, nout, lerr, ok )
128 CALL
zgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
129 CALL
chkxer(
'ZGEBRD', infot, nout, lerr, ok )
131 CALL
zgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
132 CALL
chkxer(
'ZGEBRD', infot, nout, lerr, ok )
134 CALL
zgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
135 CALL
chkxer(
'ZGEBRD', infot, nout, lerr, ok )
142 CALL
zungbr(
'/', 0, 0, 0, a, 1, tq, w, 1, info )
143 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
145 CALL
zungbr(
'Q', -1, 0, 0, a, 1, tq, w, 1, info )
146 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
148 CALL
zungbr(
'Q', 0, -1, 0, a, 1, tq, w, 1, info )
149 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
151 CALL
zungbr(
'Q', 0, 1, 0, a, 1, tq, w, 1, info )
152 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
154 CALL
zungbr(
'Q', 1, 0, 1, a, 1, tq, w, 1, info )
155 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
157 CALL
zungbr(
'P', 1, 0, 0, a, 1, tq, w, 1, info )
158 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
160 CALL
zungbr(
'P', 0, 1, 1, a, 1, tq, w, 1, info )
161 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
163 CALL
zungbr(
'Q', 0, 0, -1, a, 1, tq, w, 1, info )
164 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
166 CALL
zungbr(
'Q', 2, 1, 1, a, 1, tq, w, 1, info )
167 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
169 CALL
zungbr(
'Q', 2, 2, 1, a, 2, tq, w, 1, info )
170 CALL
chkxer(
'ZUNGBR', infot, nout, lerr, ok )
177 CALL
zunmbr(
'/',
'L',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
179 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
181 CALL
zunmbr(
'Q',
'/',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
183 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
185 CALL
zunmbr(
'Q',
'L',
'/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
187 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
189 CALL
zunmbr(
'Q',
'L',
'C', -1, 0, 0, a, 1, tq, u, 1, w, 1,
191 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
193 CALL
zunmbr(
'Q',
'L',
'C', 0, -1, 0, a, 1, tq, u, 1, w, 1,
195 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
197 CALL
zunmbr(
'Q',
'L',
'C', 0, 0, -1, a, 1, tq, u, 1, w, 1,
199 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
201 CALL
zunmbr(
'Q',
'L',
'C', 2, 0, 0, a, 1, tq, u, 2, w, 1,
203 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
205 CALL
zunmbr(
'Q',
'R',
'C', 0, 2, 0, a, 1, tq, u, 1, w, 1,
207 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
209 CALL
zunmbr(
'P',
'L',
'C', 2, 0, 2, a, 1, tq, u, 2, w, 1,
211 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
213 CALL
zunmbr(
'P',
'R',
'C', 0, 2, 2, a, 1, tq, u, 1, w, 1,
215 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
217 CALL
zunmbr(
'Q',
'R',
'C', 2, 0, 0, a, 1, tq, u, 1, w, 1,
219 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
221 CALL
zunmbr(
'Q',
'L',
'C', 0, 2, 0, a, 1, tq, u, 1, w, 0,
223 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
225 CALL
zunmbr(
'Q',
'R',
'C', 2, 0, 0, a, 1, tq, u, 2, w, 0,
227 CALL
chkxer(
'ZUNMBR', infot, nout, lerr, ok )
234 CALL
zbdsqr(
'/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
236 CALL
chkxer(
'ZBDSQR', infot, nout, lerr, ok )
238 CALL
zbdsqr(
'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
240 CALL
chkxer(
'ZBDSQR', infot, nout, lerr, ok )
242 CALL
zbdsqr(
'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
244 CALL
chkxer(
'ZBDSQR', infot, nout, lerr, ok )
246 CALL
zbdsqr(
'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, rw,
248 CALL
chkxer(
'ZBDSQR', infot, nout, lerr, ok )
250 CALL
zbdsqr(
'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, rw,
252 CALL
chkxer(
'ZBDSQR', infot, nout, lerr, ok )
254 CALL
zbdsqr(
'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
256 CALL
chkxer(
'ZBDSQR', infot, nout, lerr, ok )
258 CALL
zbdsqr(
'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, rw,
260 CALL
chkxer(
'ZBDSQR', infot, nout, lerr, ok )
262 CALL
zbdsqr(
'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, rw,
264 CALL
chkxer(
'ZBDSQR', infot, nout, lerr, ok )
271 WRITE( nout, fmt = 9999 )path, nt
273 WRITE( nout, fmt = 9998 )path
276 9999
FORMAT( 1
x, a3,
' routines passed the tests of the error exits (',
277 $ i3,
' tests done)' )
278 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
subroutine zungbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGBR
subroutine zbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, RWORK, INFO)
ZBDSQR
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine zerrbd(PATH, NUNIT)
ZERRBD
subroutine zunmbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMBR
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
LOGICAL function lsamen(N, CA, CB)
LSAMEN
subroutine zgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
ZGEBRD