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