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 sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SLAVSY
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP