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( 1x, 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
logical function lsamen(N, CA, CB)
LSAMEN
subroutine zunmbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMBR
subroutine zgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
ZGEBRD
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine zbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, RWORK, INFO)
ZBDSQR