166 CHARACTER DIAG, TRANS, UPLO
167 INTEGER INFO, LDA, LDB, N, NRHS
171 DOUBLE PRECISION A( lda, * ), B( ldb, * )
178 parameter( one = 1.0d+0 )
183 DOUBLE PRECISION 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(
'DLAVSY_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
dscal( nrhs, a( k, k ), b( k, 1 ), ldb )
259 CALL
dger( k-1, nrhs, one, a( 1, k ), 1, b( k, 1 ),
260 $ ldb, b( 1, 1 ), ldb )
266 $ CALL
dswap( 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
dger( k-1, nrhs, one, a( 1, k ), 1, b( k, 1 ),
295 $ ldb, b( 1, 1 ), ldb )
296 CALL
dger( 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
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
310 kp = abs( ipiv( k+1 ) )
312 $ CALL
dswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
335 IF( ipiv( k ).GT.0 )
THEN
342 $ CALL
dscal( nrhs, a( k, k ), b( k, 1 ), ldb )
351 CALL
dger( n-k, nrhs, one, a( k+1, k ), 1, b( k, 1 ),
352 $ ldb, b( k+1, 1 ), ldb )
358 $ CALL
dswap( 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
dger( n-k, nrhs, one, a( k+1, k ), 1, b( k, 1 ),
388 $ ldb, b( k+1, 1 ), ldb )
389 CALL
dger( 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
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
403 kp = abs( ipiv( k-1 ) )
405 $ CALL
dswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
424 IF( lsame( uplo,
'U' ) )
THEN
435 IF( ipiv( k ).GT.0 )
THEN
442 $ CALL
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
446 CALL
dgemv(
'Transpose', k-1, nrhs, one, b, ldb,
447 $ a( 1, k ), 1, one, b( k, 1 ), ldb )
450 $ CALL
dscal( nrhs, a( k, k ), b( k, 1 ), ldb )
460 kp = abs( ipiv( k ) )
462 $ CALL
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
466 kp = abs( ipiv( k-1 ) )
468 $ CALL
dswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
473 CALL
dgemv(
'Transpose', k-2, nrhs, one, b, ldb,
474 $ a( 1, k ), 1, one, b( k, 1 ), ldb )
475 CALL
dgemv(
'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
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
524 CALL
dgemv(
'Transpose', n-k, nrhs, one, b( k+1, 1 ),
525 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
528 $ CALL
dscal( nrhs, a( k, k ), b( k, 1 ), ldb )
538 kp = abs( ipiv( k ) )
540 $ CALL
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
544 kp = abs( ipiv( k+1 ) )
546 $ CALL
dswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
551 CALL
dgemv(
'Transpose', n-k-1, nrhs, one,
552 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, one,
554 CALL
dgemv(
'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 dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
subroutine dlavsy_rook(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DLAVSY_ROOK
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV