166 CHARACTER DIAG, TRANS, UPLO
167 INTEGER INFO, LDA, LDB, N, NRHS
171 REAL A( lda, * ), B( ldb, * )
178 parameter( one = 1.0e+0 )
183 REAL D11, D12, D21, D22, T1, T2
200 IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
202 ELSE IF( .NOT.lsame( trans,
'N' ) .AND. .NOT.
203 $ lsame( trans,
'T' ) .AND. .NOT.lsame( trans,
'C' ) )
THEN
205 ELSE IF( .NOT.lsame( diag,
'U' ) .AND. .NOT.lsame( diag,
'N' ) )
208 ELSE IF( n.LT.0 )
THEN
210 ELSE IF( lda.LT.max( 1, n ) )
THEN
212 ELSE IF( ldb.LT.max( 1, n ) )
THEN
216 CALL
xerbla(
'SLAVSY_ROOK ', -info )
225 nounit = lsame( diag,
'N' )
231 IF( lsame( trans,
'N' ) )
THEN
236 IF( lsame( uplo,
'U' ) )
THEN
244 IF( ipiv( k ).GT.0 )
THEN
251 $ CALL
sscal( nrhs, a( k, k ), b( k, 1 ), ldb )
259 CALL
sger( k-1, nrhs, one, a( 1, k ), 1, b( k, 1 ),
260 $ ldb, b( 1, 1 ), ldb )
266 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
283 b( k, j ) = d11*t1 + d12*t2
284 b( k+1, j ) = d21*t1 + d22*t2
294 CALL
sger( k-1, nrhs, one, a( 1, k ), 1, b( k, 1 ),
295 $ ldb, b( 1, 1 ), ldb )
296 CALL
sger( k-1, nrhs, one, a( 1, k+1 ), 1,
297 $ b( k+1, 1 ), ldb, b( 1, 1 ), ldb )
304 kp = abs( ipiv( k ) )
306 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
310 kp = abs( ipiv( k+1 ) )
312 $ CALL
sswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
335 IF( ipiv( k ).GT.0 )
THEN
342 $ CALL
sscal( nrhs, a( k, k ), b( k, 1 ), ldb )
351 CALL
sger( n-k, nrhs, one, a( k+1, k ), 1, b( k, 1 ),
352 $ ldb, b( k+1, 1 ), ldb )
358 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
376 b( k-1, j ) = d11*t1 + d12*t2
377 b( k, j ) = d21*t1 + d22*t2
387 CALL
sger( n-k, nrhs, one, a( k+1, k ), 1, b( k, 1 ),
388 $ ldb, b( k+1, 1 ), ldb )
389 CALL
sger( n-k, nrhs, one, a( k+1, k-1 ), 1,
390 $ b( k-1, 1 ), ldb, b( k+1, 1 ), ldb )
397 kp = abs( ipiv( k ) )
399 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
403 kp = abs( ipiv( k-1 ) )
405 $ CALL
sswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
424 IF( lsame( uplo,
'U' ) )
THEN
435 IF( ipiv( k ).GT.0 )
THEN
442 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
446 CALL
sgemv(
'Transpose', k-1, nrhs, one, b, ldb,
447 $ a( 1, k ), 1, one, b( k, 1 ), ldb )
450 $ CALL
sscal( nrhs, a( k, k ), b( k, 1 ), ldb )
460 kp = abs( ipiv( k ) )
462 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
466 kp = abs( ipiv( k-1 ) )
468 $ CALL
sswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
473 CALL
sgemv(
'Transpose', k-2, nrhs, one, b, ldb,
474 $ a( 1, k ), 1, one, b( k, 1 ), ldb )
475 CALL
sgemv(
'Transpose', k-2, nrhs, one, b, ldb,
476 $ a( 1, k-1 ), 1, one, b( k-1, 1 ), ldb )
489 b( k-1, j ) = d11*t1 + d12*t2
490 b( k, j ) = d21*t1 + d22*t2
513 IF( ipiv( k ).GT.0 )
THEN
520 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
524 CALL
sgemv(
'Transpose', n-k, nrhs, one, b( k+1, 1 ),
525 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
528 $ CALL
sscal( nrhs, a( k, k ), b( k, 1 ), ldb )
538 kp = abs( ipiv( k ) )
540 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
544 kp = abs( ipiv( k+1 ) )
546 $ CALL
sswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
551 CALL
sgemv(
'Transpose', n-k-1, nrhs, one,
552 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, one,
554 CALL
sgemv(
'Transpose', n-k-1, nrhs, one,
555 $ b( k+2, 1 ), ldb, a( k+2, k ), 1, one,
569 b( k, j ) = d11*t1 + d12*t2
570 b( k+1, j ) = d21*t1 + d22*t2
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slavsy_rook(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SLAVSY_ROOK
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 sscal(N, SA, SX, INCX)
SSCAL