56 SUBROUTINE serrbd( PATH, NUNIT )
72 parameter ( nmax = 4, lw = nmax )
74 parameter ( zero = 0.0e0, one = 1.0e0 )
78 INTEGER I, INFO, J, NS, NT
81 INTEGER IQ( nmax, nmax ), IW( nmax )
82 REAL 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 /
REAL( i+j )
125 IF( lsamen( 2, c2,
'BD' ) )
THEN
131 CALL sgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
132 CALL chkxer(
'SGEBRD', infot, nout, lerr, ok )
134 CALL sgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
135 CALL chkxer(
'SGEBRD', infot, nout, lerr, ok )
137 CALL sgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
138 CALL chkxer(
'SGEBRD', infot, nout, lerr, ok )
140 CALL sgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
141 CALL chkxer(
'SGEBRD', infot, nout, lerr, ok )
148 CALL sgebd2( -1, 0, a, 1, d, e, tq, tp, w, info )
149 CALL chkxer(
'SGEBD2', infot, nout, lerr, ok )
151 CALL sgebd2( 0, -1, a, 1, d, e, tq, tp, w, info )
152 CALL chkxer(
'SGEBD2', infot, nout, lerr, ok )
154 CALL sgebd2( 2, 1, a, 1, d, e, tq, tp, w, info )
155 CALL chkxer(
'SGEBD2', infot, nout, lerr, ok )
162 CALL sorgbr(
'/', 0, 0, 0, a, 1, tq, w, 1, info )
163 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
165 CALL sorgbr(
'Q', -1, 0, 0, a, 1, tq, w, 1, info )
166 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
168 CALL sorgbr(
'Q', 0, -1, 0, a, 1, tq, w, 1, info )
169 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
171 CALL sorgbr(
'Q', 0, 1, 0, a, 1, tq, w, 1, info )
172 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
174 CALL sorgbr(
'Q', 1, 0, 1, a, 1, tq, w, 1, info )
175 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
177 CALL sorgbr(
'P', 1, 0, 0, a, 1, tq, w, 1, info )
178 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
180 CALL sorgbr(
'P', 0, 1, 1, a, 1, tq, w, 1, info )
181 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
183 CALL sorgbr(
'Q', 0, 0, -1, a, 1, tq, w, 1, info )
184 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
186 CALL sorgbr(
'Q', 2, 1, 1, a, 1, tq, w, 1, info )
187 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
189 CALL sorgbr(
'Q', 2, 2, 1, a, 2, tq, w, 1, info )
190 CALL chkxer(
'SORGBR', infot, nout, lerr, ok )
197 CALL sormbr(
'/',
'L',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
199 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
201 CALL sormbr(
'Q',
'/',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
203 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
205 CALL sormbr(
'Q',
'L',
'/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
207 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
209 CALL sormbr(
'Q',
'L',
'T', -1, 0, 0, a, 1, tq, u, 1, w, 1,
211 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
213 CALL sormbr(
'Q',
'L',
'T', 0, -1, 0, a, 1, tq, u, 1, w, 1,
215 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
217 CALL sormbr(
'Q',
'L',
'T', 0, 0, -1, a, 1, tq, u, 1, w, 1,
219 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
221 CALL sormbr(
'Q',
'L',
'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
223 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
225 CALL sormbr(
'Q',
'R',
'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
227 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
229 CALL sormbr(
'P',
'L',
'T', 2, 0, 2, a, 1, tq, u, 2, w, 1,
231 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
233 CALL sormbr(
'P',
'R',
'T', 0, 2, 2, a, 1, tq, u, 1, w, 1,
235 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
237 CALL sormbr(
'Q',
'R',
'T', 2, 0, 0, a, 1, tq, u, 1, w, 1,
239 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
241 CALL sormbr(
'Q',
'L',
'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
243 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
245 CALL sormbr(
'Q',
'R',
'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
247 CALL chkxer(
'SORMBR', infot, nout, lerr, ok )
254 CALL sbdsqr(
'/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
255 CALL chkxer(
'SBDSQR', infot, nout, lerr, ok )
257 CALL sbdsqr(
'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w,
259 CALL chkxer(
'SBDSQR', infot, nout, lerr, ok )
261 CALL sbdsqr(
'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, w,
263 CALL chkxer(
'SBDSQR', infot, nout, lerr, ok )
265 CALL sbdsqr(
'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, w,
267 CALL chkxer(
'SBDSQR', infot, nout, lerr, ok )
269 CALL sbdsqr(
'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, w,
271 CALL chkxer(
'SBDSQR', infot, nout, lerr, ok )
273 CALL sbdsqr(
'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
274 CALL chkxer(
'SBDSQR', infot, nout, lerr, ok )
276 CALL sbdsqr(
'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, w, info )
277 CALL chkxer(
'SBDSQR', infot, nout, lerr, ok )
279 CALL sbdsqr(
'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, w, info )
280 CALL chkxer(
'SBDSQR', infot, nout, lerr, ok )
287 CALL sbdsdc(
'/',
'N', 0, d, e, u, 1, v, 1, q, iq, w, iw,
289 CALL chkxer(
'SBDSDC', infot, nout, lerr, ok )
291 CALL sbdsdc(
'U',
'/', 0, d, e, u, 1, v, 1, q, iq, w, iw,
293 CALL chkxer(
'SBDSDC', infot, nout, lerr, ok )
295 CALL sbdsdc(
'U',
'N', -1, d, e, u, 1, v, 1, q, iq, w, iw,
297 CALL chkxer(
'SBDSDC', infot, nout, lerr, ok )
299 CALL sbdsdc(
'U',
'I', 2, d, e, u, 1, v, 1, q, iq, w, iw,
301 CALL chkxer(
'SBDSDC', infot, nout, lerr, ok )
303 CALL sbdsdc(
'U',
'I', 2, d, e, u, 2, v, 1, q, iq, w, iw,
305 CALL chkxer(
'SBDSDC', infot, nout, lerr, ok )
312 CALL sbdsvdx(
'X',
'N',
'A', 1, d, e, zero, one, 0, 0,
313 $ ns, s, q, 1, w, iw, info)
314 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
316 CALL sbdsvdx(
'U',
'X',
'A', 1, d, e, zero, one, 0, 0,
317 $ ns, s, q, 1, w, iw, info)
318 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
320 CALL sbdsvdx(
'U',
'V',
'X', 1, d, e, zero, one, 0, 0,
321 $ ns, s, q, 1, w, iw, info)
322 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
324 CALL sbdsvdx(
'U',
'V',
'A', -1, d, e, zero, one, 0, 0,
325 $ ns, s, q, 1, w, iw, info)
326 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
328 CALL sbdsvdx(
'U',
'V',
'V', 2, d, e, -one, zero, 0, 0,
329 $ ns, s, q, 1, w, iw, info)
330 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
332 CALL sbdsvdx(
'U',
'V',
'V', 2, d, e, one, zero, 0, 0,
333 $ ns, s, q, 1, w, iw, info)
334 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
336 CALL sbdsvdx(
'L',
'V',
'I', 2, d, e, zero, zero, 0, 2,
337 $ ns, s, q, 1, w, iw, info)
338 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
340 CALL sbdsvdx(
'L',
'V',
'I', 4, d, e, zero, zero, 5, 2,
341 $ ns, s, q, 1, w, iw, info)
342 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
344 CALL sbdsvdx(
'L',
'V',
'I', 4, d, e, zero, zero, 3, 2,
345 $ ns, s, q, 1, w, iw, info)
346 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
348 CALL sbdsvdx(
'L',
'V',
'I', 4, d, e, zero, zero, 3, 5,
349 $ ns, s, q, 1, w, iw, info)
350 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
352 CALL sbdsvdx(
'L',
'V',
'A', 4, d, e, zero, zero, 0, 0,
353 $ ns, s, q, 0, w, iw, info)
354 CALL chkxer(
'SBDSVDX', infot, nout, lerr, ok )
356 CALL sbdsvdx(
'L',
'V',
'A', 4, d, e, zero, zero, 0, 0,
357 $ ns, s, q, 2, w, iw, info)
358 CALL chkxer(
'SBDSVDX', 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 sbdsvdx(UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, NS, S, Z, LDZ, WORK, IWORK, INFO)
SBDSVDX
subroutine sbdsdc(UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, WORK, IWORK, INFO)
SBDSDC
subroutine sgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
SGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
subroutine sgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
SGEBRD
subroutine sormbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMBR
subroutine serrbd(PATH, NUNIT)
SERRBD
subroutine sorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGBR