155 SUBROUTINE slavsy( UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B,
164 CHARACTER DIAG, TRANS, UPLO
165 INTEGER INFO, LDA, LDB, N, NRHS
169 REAL A( lda, * ), B( ldb, * )
176 parameter( one = 1.0e+0 )
181 REAL D11, D12, D21, D22, T1, T2
198 IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
200 ELSE IF( .NOT.lsame( trans,
'N' ) .AND. .NOT.
201 $ lsame( trans,
'T' ) .AND. .NOT.lsame( trans,
'C' ) )
THEN
203 ELSE IF( .NOT.lsame( diag,
'U' ) .AND. .NOT.lsame( diag,
'N' ) )
206 ELSE IF( n.LT.0 )
THEN
208 ELSE IF( lda.LT.max( 1, n ) )
THEN
210 ELSE IF( ldb.LT.max( 1, n ) )
THEN
214 CALL
xerbla(
'SLAVSY ', -info )
223 nounit = lsame( diag,
'N' )
229 IF( lsame( trans,
'N' ) )
THEN
234 IF( lsame( uplo,
'U' ) )
THEN
242 IF( ipiv( k ).GT.0 )
THEN
249 $ CALL
sscal( nrhs, a( k, k ), b( k, 1 ), ldb )
257 CALL
sger( k-1, nrhs, one, a( 1, k ), 1, b( k, 1 ),
258 $ ldb, b( 1, 1 ), ldb )
264 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
281 b( k, j ) = d11*t1 + d12*t2
282 b( k+1, j ) = d21*t1 + d22*t2
292 CALL
sger( k-1, nrhs, one, a( 1, k ), 1, b( k, 1 ),
293 $ ldb, b( 1, 1 ), ldb )
294 CALL
sger( k-1, nrhs, one, a( 1, k+1 ), 1,
295 $ b( k+1, 1 ), ldb, b( 1, 1 ), ldb )
299 kp = abs( ipiv( k ) )
301 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
323 IF( ipiv( k ).GT.0 )
THEN
330 $ CALL
sscal( nrhs, a( k, k ), b( k, 1 ), ldb )
339 CALL
sger( n-k, nrhs, one, a( k+1, k ), 1, b( k, 1 ),
340 $ ldb, b( k+1, 1 ), ldb )
346 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
364 b( k-1, j ) = d11*t1 + d12*t2
365 b( k, j ) = d21*t1 + d22*t2
375 CALL
sger( n-k, nrhs, one, a( k+1, k ), 1, b( k, 1 ),
376 $ ldb, b( k+1, 1 ), ldb )
377 CALL
sger( n-k, nrhs, one, a( k+1, k-1 ), 1,
378 $ b( k-1, 1 ), ldb, b( k+1, 1 ), ldb )
383 kp = abs( ipiv( k ) )
385 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
403 IF( lsame( uplo,
'U' ) )
THEN
414 IF( ipiv( k ).GT.0 )
THEN
421 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
425 CALL
sgemv(
'Transpose', k-1, nrhs, one, b, ldb,
426 $ a( 1, k ), 1, one, b( k, 1 ), ldb )
429 $ CALL
sscal( nrhs, a( k, k ), b( k, 1 ), ldb )
439 kp = abs( ipiv( k ) )
441 $ CALL
sswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
446 CALL
sgemv(
'Transpose', k-2, nrhs, one, b, ldb,
447 $ a( 1, k ), 1, one, b( k, 1 ), ldb )
448 CALL
sgemv(
'Transpose', k-2, nrhs, one, b, ldb,
449 $ a( 1, k-1 ), 1, one, b( k-1, 1 ), ldb )
462 b( k-1, j ) = d11*t1 + d12*t2
463 b( k, j ) = d21*t1 + d22*t2
486 IF( ipiv( k ).GT.0 )
THEN
493 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
497 CALL
sgemv(
'Transpose', n-k, nrhs, one, b( k+1, 1 ),
498 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
501 $ CALL
sscal( nrhs, a( k, k ), b( k, 1 ), ldb )
511 kp = abs( ipiv( k ) )
513 $ CALL
sswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
518 CALL
sgemv(
'Transpose', n-k-1, nrhs, one,
519 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, one,
521 CALL
sgemv(
'Transpose', n-k-1, nrhs, one,
522 $ b( k+2, 1 ), ldb, a( k+2, k ), 1, one,
536 b( k, j ) = d11*t1 + d12*t2
537 b( k+1, j ) = d21*t1 + d22*t2
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
subroutine slavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SLAVSY
subroutine sscal(N, SA, SX, INCX)
SSCAL