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
LOGICAL function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dlavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DLAVSY
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV