204 SUBROUTINE dlarhs( 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 DOUBLE PRECISION A( lda, * ), B( ldb, * ), X( ldx, * )
225 DOUBLE PRECISION ONE, ZERO
226 parameter( one = 1.0d+0, zero = 0.0d+0 )
229 LOGICAL BAND, GEN, NOTRAN, QRS, SYM, TRAN, TRI
235 LOGICAL LSAME, LSAMEN
236 EXTERNAL lsame, lsamen
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,
'Double 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(
'DLARHS', -info )
305 IF( .NOT.lsame( xtype,
'C' ) )
THEN
307 CALL
dlarnv( 2, iseed, n, x( 1, j ) )
314 IF( lsamen( 2, c2,
'GE' ) .OR. lsamen( 2, c2,
'QR' ) .OR.
315 $ lsamen( 2, c2,
'LQ' ) .OR. lsamen( 2, c2,
'QL' ) .OR.
316 $ lsamen( 2, c2,
'RQ' ) )
THEN
320 CALL
dgemm( 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
dsymm(
'Left', uplo, n, nrhs, one, a, lda, x, ldx, zero,
330 ELSE IF( lsamen( 2, c2,
'GB' ) )
THEN
335 CALL
dgbmv( 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
dsbmv( 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
dspmv( uplo, n, one, a, x( 1, j ), 1, zero, b( 1, j ),
357 ELSE IF( lsamen( 2, c2,
'TR' ) )
THEN
363 CALL
dlacpy(
'Full', n, nrhs, x, ldx, b, ldb )
369 CALL
dtrmm(
'Left', uplo, trans, diag, n, nrhs, one, a, lda, b,
372 ELSE IF( lsamen( 2, c2,
'TP' ) )
THEN
376 CALL
dlacpy(
'Full', n, nrhs, x, ldx, b, ldb )
383 CALL
dtpmv( uplo, trans, diag, n, a, b( 1, j ), 1 )
386 ELSE IF( lsamen( 2, c2,
'TB' ) )
THEN
390 CALL
dlacpy(
'Full', n, nrhs, x, ldx, b, ldb )
397 CALL
dtbmv( uplo, trans, diag, n, kl, a, lda, b( 1, j ), 1 )
405 CALL
xerbla(
'DLARHS', -info )
subroutine dsbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DSBMV
subroutine dspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
DSPMV
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine dsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DSYMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGBMV
subroutine dtbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
DTBMV
subroutine dtpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPMV
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM