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