72 parameter ( nmax = 4, lw = nmax )
73 DOUBLE PRECISION zero, one
74 parameter ( zero = 0.0d0, one = 1.0d0 )
78 INTEGER i, info, j, ns, nt
81 INTEGER iq( nmax, nmax ), iw( nmax )
82 DOUBLE PRECISION a( nmax, nmax ), d( nmax ), e( nmax ),
83 $ q( nmax, nmax ), s( nmax ), tp( nmax ),
84 $ tq( nmax ), u( nmax, nmax ),
85 $ v( nmax, nmax ), w( lw )
101 COMMON / infoc / infot, nout, ok, lerr
102 COMMON / srnamc / srnamt
110 WRITE( nout, fmt = * )
117 a( i, j ) = 1.d0 / dble( i+j )
125 IF(
lsamen( 2, c2,
'BD' ) )
THEN
131 CALL dgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
132 CALL chkxer(
'DGEBRD', infot, nout, lerr, ok )
134 CALL dgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
135 CALL chkxer(
'DGEBRD', infot, nout, lerr, ok )
137 CALL dgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
138 CALL chkxer(
'DGEBRD', infot, nout, lerr, ok )
140 CALL dgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
141 CALL chkxer(
'DGEBRD', infot, nout, lerr, ok )
148 CALL dgebd2( -1, 0, a, 1, d, e, tq, tp, w, info )
149 CALL chkxer(
'DGEBD2', infot, nout, lerr, ok )
151 CALL dgebd2( 0, -1, a, 1, d, e, tq, tp, w, info )
152 CALL chkxer(
'DGEBD2', infot, nout, lerr, ok )
154 CALL dgebd2( 2, 1, a, 1, d, e, tq, tp, w, info )
155 CALL chkxer(
'DGEBD2', infot, nout, lerr, ok )
162 CALL dorgbr(
'/', 0, 0, 0, a, 1, tq, w, 1, info )
163 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
165 CALL dorgbr(
'Q', -1, 0, 0, a, 1, tq, w, 1, info )
166 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
168 CALL dorgbr(
'Q', 0, -1, 0, a, 1, tq, w, 1, info )
169 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
171 CALL dorgbr(
'Q', 0, 1, 0, a, 1, tq, w, 1, info )
172 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
174 CALL dorgbr(
'Q', 1, 0, 1, a, 1, tq, w, 1, info )
175 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
177 CALL dorgbr(
'P', 1, 0, 0, a, 1, tq, w, 1, info )
178 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
180 CALL dorgbr(
'P', 0, 1, 1, a, 1, tq, w, 1, info )
181 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
183 CALL dorgbr(
'Q', 0, 0, -1, a, 1, tq, w, 1, info )
184 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
186 CALL dorgbr(
'Q', 2, 1, 1, a, 1, tq, w, 1, info )
187 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
189 CALL dorgbr(
'Q', 2, 2, 1, a, 2, tq, w, 1, info )
190 CALL chkxer(
'DORGBR', infot, nout, lerr, ok )
197 CALL dormbr(
'/',
'L',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
199 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
201 CALL dormbr(
'Q',
'/',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
203 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
205 CALL dormbr(
'Q',
'L',
'/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
207 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
209 CALL dormbr(
'Q',
'L',
'T', -1, 0, 0, a, 1, tq, u, 1, w, 1,
211 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
213 CALL dormbr(
'Q',
'L',
'T', 0, -1, 0, a, 1, tq, u, 1, w, 1,
215 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
217 CALL dormbr(
'Q',
'L',
'T', 0, 0, -1, a, 1, tq, u, 1, w, 1,
219 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
221 CALL dormbr(
'Q',
'L',
'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
223 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
225 CALL dormbr(
'Q',
'R',
'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
227 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
229 CALL dormbr(
'P',
'L',
'T', 2, 0, 2, a, 1, tq, u, 2, w, 1,
231 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
233 CALL dormbr(
'P',
'R',
'T', 0, 2, 2, a, 1, tq, u, 1, w, 1,
235 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
237 CALL dormbr(
'Q',
'R',
'T', 2, 0, 0, a, 1, tq, u, 1, w, 1,
239 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
241 CALL dormbr(
'Q',
'L',
'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
243 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
245 CALL dormbr(
'Q',
'R',
'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
247 CALL chkxer(
'DORMBR', infot, nout, lerr, ok )
254 CALL dbdsqr(
'/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
255 CALL chkxer(
'DBDSQR', infot, nout, lerr, ok )
257 CALL dbdsqr(
'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w,
259 CALL chkxer(
'DBDSQR', infot, nout, lerr, ok )
261 CALL dbdsqr(
'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, w,
263 CALL chkxer(
'DBDSQR', infot, nout, lerr, ok )
265 CALL dbdsqr(
'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, w,
267 CALL chkxer(
'DBDSQR', infot, nout, lerr, ok )
269 CALL dbdsqr(
'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, w,
271 CALL chkxer(
'DBDSQR', infot, nout, lerr, ok )
273 CALL dbdsqr(
'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
274 CALL chkxer(
'DBDSQR', infot, nout, lerr, ok )
276 CALL dbdsqr(
'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, w, info )
277 CALL chkxer(
'DBDSQR', infot, nout, lerr, ok )
279 CALL dbdsqr(
'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, w, info )
280 CALL chkxer(
'DBDSQR', infot, nout, lerr, ok )
287 CALL dbdsdc(
'/',
'N', 0, d, e, u, 1, v, 1, q, iq, w, iw,
289 CALL chkxer(
'DBDSDC', infot, nout, lerr, ok )
291 CALL dbdsdc(
'U',
'/', 0, d, e, u, 1, v, 1, q, iq, w, iw,
293 CALL chkxer(
'DBDSDC', infot, nout, lerr, ok )
295 CALL dbdsdc(
'U',
'N', -1, d, e, u, 1, v, 1, q, iq, w, iw,
297 CALL chkxer(
'DBDSDC', infot, nout, lerr, ok )
299 CALL dbdsdc(
'U',
'I', 2, d, e, u, 1, v, 1, q, iq, w, iw,
301 CALL chkxer(
'DBDSDC', infot, nout, lerr, ok )
303 CALL dbdsdc(
'U',
'I', 2, d, e, u, 2, v, 1, q, iq, w, iw,
305 CALL chkxer(
'DBDSDC', infot, nout, lerr, ok )
312 CALL dbdsvdx(
'X',
'N',
'A', 1, d, e, zero, one, 0, 0,
313 $ ns, s, q, 1, w, iw, info)
314 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
316 CALL dbdsvdx(
'U',
'X',
'A', 1, d, e, zero, one, 0, 0,
317 $ ns, s, q, 1, w, iw, info)
318 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
320 CALL dbdsvdx(
'U',
'V',
'X', 1, d, e, zero, one, 0, 0,
321 $ ns, s, q, 1, w, iw, info)
322 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
324 CALL dbdsvdx(
'U',
'V',
'A', -1, d, e, zero, one, 0, 0,
325 $ ns, s, q, 1, w, iw, info)
326 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
328 CALL dbdsvdx(
'U',
'V',
'V', 2, d, e, -one, zero, 0, 0,
329 $ ns, s, q, 1, w, iw, info)
330 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
332 CALL dbdsvdx(
'U',
'V',
'V', 2, d, e, one, zero, 0, 0,
333 $ ns, s, q, 1, w, iw, info)
334 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
336 CALL dbdsvdx(
'L',
'V',
'I', 2, d, e, zero, zero, 0, 2,
337 $ ns, s, q, 1, w, iw, info)
338 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
340 CALL dbdsvdx(
'L',
'V',
'I', 4, d, e, zero, zero, 5, 2,
341 $ ns, s, q, 1, w, iw, info)
342 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
344 CALL dbdsvdx(
'L',
'V',
'I', 4, d, e, zero, zero, 3, 2,
345 $ ns, s, q, 1, w, iw, info)
346 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
348 CALL dbdsvdx(
'L',
'V',
'I', 4, d, e, zero, zero, 3, 5,
349 $ ns, s, q, 1, w, iw, info)
350 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
352 CALL dbdsvdx(
'L',
'V',
'A', 4, d, e, zero, zero, 0, 0,
353 $ ns, s, q, 0, w, iw, info)
354 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
356 CALL dbdsvdx(
'L',
'V',
'A', 4, d, e, zero, zero, 0, 0,
357 $ ns, s, q, 2, w, iw, info)
358 CALL chkxer(
'DBDSVDX', infot, nout, lerr, ok )
365 WRITE( nout, fmt = 9999 )path, nt
367 WRITE( nout, fmt = 9998 )path
370 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits',
371 $
' (', i3,
' tests done)' )
372 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
subroutine dgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
DGEBRD
logical function lsamen(N, CA, CB)
LSAMEN
subroutine dormbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMBR
subroutine dbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
DBDSQR
subroutine dgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
DGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine dorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGBR
subroutine dbdsdc(UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, WORK, IWORK, INFO)
DBDSDC
subroutine dbdsvdx(UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, NS, S, Z, LDZ, WORK, IWORK, INFO)
DBDSVDX