69 parameter( nmax = 4, lw = nmax )
73 INTEGER I, INFO, J, NT
76 DOUBLE PRECISION D( NMAX ), E( NMAX ), RW( 4*NMAX )
77 COMPLEX*16 A( NMAX, NMAX ), TP( NMAX ), TQ( NMAX ),
78 $ U( NMAX, NMAX ), V( NMAX, NMAX ), W( LW )
94 COMMON / infoc / infot, nout, ok, lerr
95 COMMON / srnamc / srnamt
103 WRITE( nout, fmt = * )
110 a( i, j ) = 1.d0 / dble( i+j )
118 IF( lsamen( 2, c2,
'BD' ) )
THEN
124 CALL zgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
125 CALL chkxer(
'ZGEBRD', infot, nout, lerr, ok )
127 CALL zgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
128 CALL chkxer(
'ZGEBRD', infot, nout, lerr, ok )
130 CALL zgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
131 CALL chkxer(
'ZGEBRD', infot, nout, lerr, ok )
133 CALL zgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
134 CALL chkxer(
'ZGEBRD', infot, nout, lerr, ok )
141 CALL zgebd2( -1, 0, a, 1, d, e, tq, tp, w, info )
142 CALL chkxer(
'ZGEBD2', infot, nout, lerr, ok )
144 CALL zgebd2( 0, -1, a, 1, d, e, tq, tp, w, info )
145 CALL chkxer(
'ZGEBD2', infot, nout, lerr, ok )
147 CALL zgebd2( 2, 1, a, 1, d, e, tq, tp, w, info )
148 CALL chkxer(
'ZGEBD2', infot, nout, lerr, ok )
155 CALL zungbr(
'/', 0, 0, 0, a, 1, tq, w, 1, info )
156 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
158 CALL zungbr(
'Q', -1, 0, 0, a, 1, tq, w, 1, info )
159 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
161 CALL zungbr(
'Q', 0, -1, 0, a, 1, tq, w, 1, info )
162 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
164 CALL zungbr(
'Q', 0, 1, 0, a, 1, tq, w, 1, info )
165 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
167 CALL zungbr(
'Q', 1, 0, 1, a, 1, tq, w, 1, info )
168 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
170 CALL zungbr(
'P', 1, 0, 0, a, 1, tq, w, 1, info )
171 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
173 CALL zungbr(
'P', 0, 1, 1, a, 1, tq, w, 1, info )
174 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
176 CALL zungbr(
'Q', 0, 0, -1, a, 1, tq, w, 1, info )
177 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
179 CALL zungbr(
'Q', 2, 1, 1, a, 1, tq, w, 1, info )
180 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
182 CALL zungbr(
'Q', 2, 2, 1, a, 2, tq, w, 1, info )
183 CALL chkxer(
'ZUNGBR', infot, nout, lerr, ok )
190 CALL zunmbr(
'/',
'L',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
192 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
194 CALL zunmbr(
'Q',
'/',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
196 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
198 CALL zunmbr(
'Q',
'L',
'/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
200 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
202 CALL zunmbr(
'Q',
'L',
'C', -1, 0, 0, a, 1, tq, u, 1, w, 1,
204 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
206 CALL zunmbr(
'Q',
'L',
'C', 0, -1, 0, a, 1, tq, u, 1, w, 1,
208 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
210 CALL zunmbr(
'Q',
'L',
'C', 0, 0, -1, a, 1, tq, u, 1, w, 1,
212 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
214 CALL zunmbr(
'Q',
'L',
'C', 2, 0, 0, a, 1, tq, u, 2, w, 1,
216 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
218 CALL zunmbr(
'Q',
'R',
'C', 0, 2, 0, a, 1, tq, u, 1, w, 1,
220 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
222 CALL zunmbr(
'P',
'L',
'C', 2, 0, 2, a, 1, tq, u, 2, w, 1,
224 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
226 CALL zunmbr(
'P',
'R',
'C', 0, 2, 2, a, 1, tq, u, 1, w, 1,
228 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
230 CALL zunmbr(
'Q',
'R',
'C', 2, 0, 0, a, 1, tq, u, 1, w, 1,
232 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
234 CALL zunmbr(
'Q',
'L',
'C', 0, 2, 0, a, 1, tq, u, 1, w, 0,
236 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
238 CALL zunmbr(
'Q',
'R',
'C', 2, 0, 0, a, 1, tq, u, 2, w, 0,
240 CALL chkxer(
'ZUNMBR', infot, nout, lerr, ok )
247 CALL zbdsqr(
'/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
249 CALL chkxer(
'ZBDSQR', infot, nout, lerr, ok )
251 CALL zbdsqr(
'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
253 CALL chkxer(
'ZBDSQR', infot, nout, lerr, ok )
255 CALL zbdsqr(
'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
257 CALL chkxer(
'ZBDSQR', infot, nout, lerr, ok )
259 CALL zbdsqr(
'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, rw,
261 CALL chkxer(
'ZBDSQR', infot, nout, lerr, ok )
263 CALL zbdsqr(
'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, rw,
265 CALL chkxer(
'ZBDSQR', infot, nout, lerr, ok )
267 CALL zbdsqr(
'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
269 CALL chkxer(
'ZBDSQR', infot, nout, lerr, ok )
271 CALL zbdsqr(
'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, rw,
273 CALL chkxer(
'ZBDSQR', infot, nout, lerr, ok )
275 CALL zbdsqr(
'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, rw,
277 CALL chkxer(
'ZBDSQR', infot, nout, lerr, ok )
284 WRITE( nout, fmt = 9999 )path, nt
286 WRITE( nout, fmt = 9998 )path
289 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits (',
290 $ i3,
' tests done)' )
291 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
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
subroutine zgebd2(m, n, a, lda, d, e, tauq, taup, work, info)
ZGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
subroutine zgebrd(m, n, a, lda, d, e, tauq, taup, work, lwork, info)
ZGEBRD
subroutine zungbr(vect, m, n, k, a, lda, tau, work, lwork, info)
ZUNGBR
subroutine zunmbr(vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
ZUNMBR
subroutine zerrbd(path, nunit)
ZERRBD