204 SUBROUTINE slarhs( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
205 $ a, lda, x, ldx,
b, ldb, iseed, info )
213 CHARACTER trans, uplo, xtype
215 INTEGER info, kl, ku, lda, ldb, ldx, m, n, nrhs
219 REAL a( lda, * ),
b( ldb, * ), x( ldx, * )
226 parameter( one = 1.0e+0, zero = 0.0e+0 )
229 LOGICAL band, gen, notran, qrs, sym, tran, tri
252 tran =
lsame( trans,
'T' ) .OR.
lsame( trans,
'C' )
254 gen =
lsame( path( 2: 2 ),
'G' )
255 qrs =
lsame( path( 2: 2 ),
'Q' ) .OR.
lsame( path( 3: 3 ),
'Q' )
256 sym =
lsame( path( 2: 2 ),
'P' ) .OR.
lsame( path( 2: 2 ),
'S' )
257 tri =
lsame( path( 2: 2 ),
'T' )
258 band =
lsame( path( 3: 3 ),
'B' )
259 IF( .NOT.
lsame( c1,
'Single precision' ) )
THEN
261 ELSE IF( .NOT.(
lsame( xtype,
'N' ) .OR.
lsame( xtype,
'C' ) ) )
264 ELSE IF( ( sym .OR. tri ) .AND. .NOT.
265 $ (
lsame( uplo,
'U' ) .OR.
lsame( uplo,
'L' ) ) )
THEN
267 ELSE IF( ( gen .OR. qrs ) .AND. .NOT.
268 $ ( tran .OR.
lsame( trans,
'N' ) ) )
THEN
270 ELSE IF( m.LT.0 )
THEN
272 ELSE IF( n.LT.0 )
THEN
274 ELSE IF( band .AND. kl.LT.0 )
THEN
276 ELSE IF( band .AND. ku.LT.0 )
THEN
278 ELSE IF( nrhs.LT.0 )
THEN
280 ELSE IF( ( .NOT.band .AND. lda.LT.max( 1, m ) ) .OR.
281 $ ( band .AND. ( sym .OR. tri ) .AND. lda.LT.kl+1 ) .OR.
282 $ ( band .AND. gen .AND. lda.LT.kl+ku+1 ) )
THEN
284 ELSE IF( ( notran .AND. ldx.LT.max( 1, n ) ) .OR.
285 $ ( tran .AND. ldx.LT.max( 1, m ) ) )
THEN
287 ELSE IF( ( notran .AND. ldb.LT.max( 1, m ) ) .OR.
288 $ ( tran .AND. ldb.LT.max( 1, n ) ) )
THEN
292 CALL
xerbla(
'SLARHS', -info )
305 IF( .NOT.
lsame( xtype,
'C' ) )
THEN
307 CALL
slarnv( 2, iseed, n, x( 1,
j ) )
314 IF(
lsamen( 2, c2,
'GE' ) .OR.
lsamen( 2, c2,
'QR' ) .OR.
316 $
lsamen( 2, c2,
'RQ' ) )
THEN
320 CALL
sgemm( trans,
'N', mb, nrhs, nx, one, a, lda, x, ldx,
323 ELSE IF(
lsamen( 2, c2,
'PO' ) .OR.
lsamen( 2, c2,
'SY' ) )
THEN
327 CALL
ssymm(
'Left', uplo, n, nrhs, one, a, lda, x, ldx, zero,
330 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
335 CALL
sgbmv( trans, mb, nx, kl, ku, one, a, lda, x( 1,
j ),
336 $ 1, zero,
b( 1,
j ), 1 )
339 ELSE IF(
lsamen( 2, c2,
'PB' ) )
THEN
344 CALL
ssbmv( uplo, n, kl, one, a, lda, x( 1,
j ), 1, zero,
348 ELSE IF(
lsamen( 2, c2,
'PP' ) .OR.
lsamen( 2, c2,
'SP' ) )
THEN
353 CALL
sspmv( uplo, n, one, a, x( 1,
j ), 1, zero,
b( 1,
j ),
357 ELSE IF(
lsamen( 2, c2,
'TR' ) )
THEN
363 CALL
slacpy(
'Full', n, nrhs, x, ldx,
b, ldb )
369 CALL
strmm(
'Left', uplo, trans, diag, n, nrhs, one, a, lda,
b,
372 ELSE IF(
lsamen( 2, c2,
'TP' ) )
THEN
376 CALL
slacpy(
'Full', n, nrhs, x, ldx,
b, ldb )
383 CALL
stpmv( uplo, trans, diag, n, a,
b( 1,
j ), 1 )
386 ELSE IF(
lsamen( 2, c2,
'TB' ) )
THEN
390 CALL
slacpy(
'Full', n, nrhs, x, ldx,
b, ldb )
397 CALL
stbmv( uplo, trans, diag, n, kl, a, lda,
b( 1,
j ), 1 )
405 CALL
xerbla(
'SLARHS', -info )
subroutine sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
subroutine ssymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SSYMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine strmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRMM
subroutine stpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPMV
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGBMV
logical function lsamen(N, CA, CB)
LSAMEN
subroutine ssbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSBMV
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine stbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
STBMV