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