155 SUBROUTINE dlavsy( UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B,
164 CHARACTER DIAG, TRANS, UPLO
165 INTEGER INFO, LDA, LDB, N, NRHS
169 DOUBLE PRECISION A( lda, * ), B( ldb, * )
176 parameter( one = 1.0d+0 )
181 DOUBLE PRECISION 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(
'DLAVSY ', -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
dscal( nrhs, a( k, k ), b( k, 1 ), ldb )
257 CALL
dger( k-1, nrhs, one, a( 1, k ), 1, b( k, 1 ),
258 $ ldb, b( 1, 1 ), ldb )
264 $ CALL
dswap( 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
dger( k-1, nrhs, one, a( 1, k ), 1, b( k, 1 ),
293 $ ldb, b( 1, 1 ), ldb )
294 CALL
dger( 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
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
323 IF( ipiv( k ).GT.0 )
THEN
330 $ CALL
dscal( nrhs, a( k, k ), b( k, 1 ), ldb )
339 CALL
dger( n-k, nrhs, one, a( k+1, k ), 1, b( k, 1 ),
340 $ ldb, b( k+1, 1 ), ldb )
346 $ CALL
dswap( 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
dger( n-k, nrhs, one, a( k+1, k ), 1, b( k, 1 ),
376 $ ldb, b( k+1, 1 ), ldb )
377 CALL
dger( 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
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
403 IF( lsame( uplo,
'U' ) )
THEN
414 IF( ipiv( k ).GT.0 )
THEN
421 $ CALL
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
425 CALL
dgemv(
'Transpose', k-1, nrhs, one, b, ldb,
426 $ a( 1, k ), 1, one, b( k, 1 ), ldb )
429 $ CALL
dscal( nrhs, a( k, k ), b( k, 1 ), ldb )
439 kp = abs( ipiv( k ) )
441 $ CALL
dswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
446 CALL
dgemv(
'Transpose', k-2, nrhs, one, b, ldb,
447 $ a( 1, k ), 1, one, b( k, 1 ), ldb )
448 CALL
dgemv(
'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
dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
497 CALL
dgemv(
'Transpose', n-k, nrhs, one, b( k+1, 1 ),
498 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
501 $ CALL
dscal( nrhs, a( k, k ), b( k, 1 ), ldb )
511 kp = abs( ipiv( k ) )
513 $ CALL
dswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
518 CALL
dgemv(
'Transpose', n-k-1, nrhs, one,
519 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, one,
521 CALL
dgemv(
'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 dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dlavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DLAVSY
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV