71 parameter ( nmax = 4, lw = nmax )
75 INTEGER i, info, j, nt
78 REAL d( nmax ), e( nmax ), rw( 4*nmax )
79 COMPLEX 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. /
REAL( i+j )
119 IF(
lsamen( 2, c2,
'BD' ) )
THEN
125 CALL cgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
126 CALL chkxer(
'CGEBRD', infot, nout, lerr, ok )
128 CALL cgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
129 CALL chkxer(
'CGEBRD', infot, nout, lerr, ok )
131 CALL cgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
132 CALL chkxer(
'CGEBRD', infot, nout, lerr, ok )
134 CALL cgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
135 CALL chkxer(
'CGEBRD', infot, nout, lerr, ok )
142 CALL cungbr(
'/', 0, 0, 0, a, 1, tq, w, 1, info )
143 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
145 CALL cungbr(
'Q', -1, 0, 0, a, 1, tq, w, 1, info )
146 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
148 CALL cungbr(
'Q', 0, -1, 0, a, 1, tq, w, 1, info )
149 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
151 CALL cungbr(
'Q', 0, 1, 0, a, 1, tq, w, 1, info )
152 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
154 CALL cungbr(
'Q', 1, 0, 1, a, 1, tq, w, 1, info )
155 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
157 CALL cungbr(
'P', 1, 0, 0, a, 1, tq, w, 1, info )
158 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
160 CALL cungbr(
'P', 0, 1, 1, a, 1, tq, w, 1, info )
161 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
163 CALL cungbr(
'Q', 0, 0, -1, a, 1, tq, w, 1, info )
164 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
166 CALL cungbr(
'Q', 2, 1, 1, a, 1, tq, w, 1, info )
167 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
169 CALL cungbr(
'Q', 2, 2, 1, a, 2, tq, w, 1, info )
170 CALL chkxer(
'CUNGBR', infot, nout, lerr, ok )
177 CALL cunmbr(
'/',
'L',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
179 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
181 CALL cunmbr(
'Q',
'/',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
183 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
185 CALL cunmbr(
'Q',
'L',
'/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
187 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
189 CALL cunmbr(
'Q',
'L',
'C', -1, 0, 0, a, 1, tq, u, 1, w, 1,
191 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
193 CALL cunmbr(
'Q',
'L',
'C', 0, -1, 0, a, 1, tq, u, 1, w, 1,
195 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
197 CALL cunmbr(
'Q',
'L',
'C', 0, 0, -1, a, 1, tq, u, 1, w, 1,
199 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
201 CALL cunmbr(
'Q',
'L',
'C', 2, 0, 0, a, 1, tq, u, 2, w, 1,
203 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
205 CALL cunmbr(
'Q',
'R',
'C', 0, 2, 0, a, 1, tq, u, 1, w, 1,
207 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
209 CALL cunmbr(
'P',
'L',
'C', 2, 0, 2, a, 1, tq, u, 2, w, 1,
211 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
213 CALL cunmbr(
'P',
'R',
'C', 0, 2, 2, a, 1, tq, u, 1, w, 1,
215 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
217 CALL cunmbr(
'Q',
'R',
'C', 2, 0, 0, a, 1, tq, u, 1, w, 1,
219 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
221 CALL cunmbr(
'Q',
'L',
'C', 0, 2, 0, a, 1, tq, u, 1, w, 0,
223 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
225 CALL cunmbr(
'Q',
'R',
'C', 2, 0, 0, a, 1, tq, u, 2, w, 0,
227 CALL chkxer(
'CUNMBR', infot, nout, lerr, ok )
234 CALL cbdsqr(
'/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
236 CALL chkxer(
'CBDSQR', infot, nout, lerr, ok )
238 CALL cbdsqr(
'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
240 CALL chkxer(
'CBDSQR', infot, nout, lerr, ok )
242 CALL cbdsqr(
'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
244 CALL chkxer(
'CBDSQR', infot, nout, lerr, ok )
246 CALL cbdsqr(
'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, rw,
248 CALL chkxer(
'CBDSQR', infot, nout, lerr, ok )
250 CALL cbdsqr(
'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, rw,
252 CALL chkxer(
'CBDSQR', infot, nout, lerr, ok )
254 CALL cbdsqr(
'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
256 CALL chkxer(
'CBDSQR', infot, nout, lerr, ok )
258 CALL cbdsqr(
'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, rw,
260 CALL chkxer(
'CBDSQR', infot, nout, lerr, ok )
262 CALL cbdsqr(
'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, rw,
264 CALL chkxer(
'CBDSQR', 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 cungbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGBR
subroutine cbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, RWORK, INFO)
CBDSQR
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
logical function lsamen(N, CA, CB)
LSAMEN
subroutine cgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
CGEBRD
subroutine cunmbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMBR