72 parameter( nmax = 4, lw = nmax )
76 INTEGER i, info,
j, nt
79 INTEGER iq( nmax, nmax ), iw( nmax )
80 REAL a( nmax, nmax ), d( nmax ), e( nmax ),
81 $ q( nmax, nmax ), tp( nmax ), tq( nmax ),
82 $ u( nmax, nmax ), v( nmax, nmax ), w( lw )
98 COMMON / infoc / infot, nout, ok, lerr
99 COMMON / srnamc / srnamt
107 WRITE( nout, fmt = * )
114 a( i,
j ) = 1. /
REAL( i+
j )
122 IF(
lsamen( 2, c2,
'BD' ) )
THEN
128 CALL
sgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
129 CALL
chkxer(
'SGEBRD', infot, nout, lerr, ok )
131 CALL
sgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
132 CALL
chkxer(
'SGEBRD', infot, nout, lerr, ok )
134 CALL
sgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
135 CALL
chkxer(
'SGEBRD', infot, nout, lerr, ok )
137 CALL
sgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
138 CALL
chkxer(
'SGEBRD', infot, nout, lerr, ok )
145 CALL
sgebd2( -1, 0, a, 1, d, e, tq, tp, w, info )
146 CALL
chkxer(
'SGEBD2', infot, nout, lerr, ok )
148 CALL
sgebd2( 0, -1, a, 1, d, e, tq, tp, w, info )
149 CALL
chkxer(
'SGEBD2', infot, nout, lerr, ok )
151 CALL
sgebd2( 2, 1, a, 1, d, e, tq, tp, w, info )
152 CALL
chkxer(
'SGEBD2', infot, nout, lerr, ok )
159 CALL
sorgbr(
'/', 0, 0, 0, a, 1, tq, w, 1, info )
160 CALL
chkxer(
'SORGBR', infot, nout, lerr, ok )
162 CALL
sorgbr(
'Q', -1, 0, 0, a, 1, tq, w, 1, info )
163 CALL
chkxer(
'SORGBR', infot, nout, lerr, ok )
165 CALL
sorgbr(
'Q', 0, -1, 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', 1, 0, 1, a, 1, tq, w, 1, info )
172 CALL
chkxer(
'SORGBR', infot, nout, lerr, ok )
174 CALL
sorgbr(
'P', 1, 0, 0, a, 1, tq, w, 1, info )
175 CALL
chkxer(
'SORGBR', infot, nout, lerr, ok )
177 CALL
sorgbr(
'P', 0, 1, 1, a, 1, tq, w, 1, info )
178 CALL
chkxer(
'SORGBR', infot, nout, lerr, ok )
180 CALL
sorgbr(
'Q', 0, 0, -1, a, 1, tq, w, 1, info )
181 CALL
chkxer(
'SORGBR', infot, nout, lerr, ok )
183 CALL
sorgbr(
'Q', 2, 1, 1, a, 1, tq, w, 1, info )
184 CALL
chkxer(
'SORGBR', infot, nout, lerr, ok )
186 CALL
sorgbr(
'Q', 2, 2, 1, a, 2, tq, w, 1, info )
187 CALL
chkxer(
'SORGBR', infot, nout, lerr, ok )
194 CALL
sormbr(
'/',
'L',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
196 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
198 CALL
sormbr(
'Q',
'/',
'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
200 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
202 CALL
sormbr(
'Q',
'L',
'/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
204 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
206 CALL
sormbr(
'Q',
'L',
'T', -1, 0, 0, a, 1, tq, u, 1, w, 1,
208 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
210 CALL
sormbr(
'Q',
'L',
'T', 0, -1, 0, a, 1, tq, u, 1, w, 1,
212 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
214 CALL
sormbr(
'Q',
'L',
'T', 0, 0, -1, a, 1, tq, u, 1, w, 1,
216 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
218 CALL
sormbr(
'Q',
'L',
'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
220 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
222 CALL
sormbr(
'Q',
'R',
'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
224 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
226 CALL
sormbr(
'P',
'L',
'T', 2, 0, 2, a, 1, tq, u, 2, w, 1,
228 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
230 CALL
sormbr(
'P',
'R',
'T', 0, 2, 2, a, 1, tq, u, 1, w, 1,
232 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
234 CALL
sormbr(
'Q',
'R',
'T', 2, 0, 0, a, 1, tq, u, 1, w, 1,
236 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
238 CALL
sormbr(
'Q',
'L',
'T', 0, 2, 0, a, 1, tq, u, 1, w, 1,
240 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
242 CALL
sormbr(
'Q',
'R',
'T', 2, 0, 0, a, 1, tq, u, 2, w, 1,
244 CALL
chkxer(
'SORMBR', infot, nout, lerr, ok )
251 CALL
sbdsqr(
'/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
252 CALL
chkxer(
'SBDSQR', infot, nout, lerr, ok )
254 CALL
sbdsqr(
'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, w,
256 CALL
chkxer(
'SBDSQR', infot, nout, lerr, ok )
258 CALL
sbdsqr(
'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, w,
260 CALL
chkxer(
'SBDSQR', infot, nout, lerr, ok )
262 CALL
sbdsqr(
'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, w,
264 CALL
chkxer(
'SBDSQR', infot, nout, lerr, ok )
266 CALL
sbdsqr(
'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, w,
268 CALL
chkxer(
'SBDSQR', infot, nout, lerr, ok )
270 CALL
sbdsqr(
'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, w, info )
271 CALL
chkxer(
'SBDSQR', infot, nout, lerr, ok )
273 CALL
sbdsqr(
'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, w, info )
274 CALL
chkxer(
'SBDSQR', infot, nout, lerr, ok )
276 CALL
sbdsqr(
'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, w, info )
277 CALL
chkxer(
'SBDSQR', infot, nout, lerr, ok )
284 CALL
sbdsdc(
'/',
'N', 0, d, e, u, 1, v, 1, q, iq, w, iw,
286 CALL
chkxer(
'SBDSDC', infot, nout, lerr, ok )
288 CALL
sbdsdc(
'U',
'/', 0, d, e, u, 1, v, 1, q, iq, w, iw,
290 CALL
chkxer(
'SBDSDC', infot, nout, lerr, ok )
292 CALL
sbdsdc(
'U',
'N', -1, d, e, u, 1, v, 1, q, iq, w, iw,
294 CALL
chkxer(
'SBDSDC', infot, nout, lerr, ok )
296 CALL
sbdsdc(
'U',
'I', 2, d, e, u, 1, v, 1, q, iq, w, iw,
298 CALL
chkxer(
'SBDSDC', infot, nout, lerr, ok )
300 CALL
sbdsdc(
'U',
'I', 2, d, e, u, 2, v, 1, q, iq, w, iw,
302 CALL
chkxer(
'SBDSDC', infot, nout, lerr, ok )
309 WRITE( nout, fmt = 9999 )path, nt
311 WRITE( nout, fmt = 9998 )path
314 9999
FORMAT( 1
x, a3,
' routines passed the tests of the error exits',
315 $
' (', i3,
' tests done)' )
316 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
subroutine sgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
SGEBRD
subroutine serrbd(PATH, NUNIT)
SERRBD
subroutine sorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGBR
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
subroutine sbdsdc(UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, WORK, IWORK, INFO)
SBDSDC
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine sgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
SGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
LOGICAL function lsamen(N, CA, CB)
LSAMEN
subroutine sormbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMBR