130 SUBROUTINE dlavsp( UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB,
139 CHARACTER diag, trans, uplo
140 INTEGER info, ldb, n, nrhs
144 DOUBLE PRECISION a( * ),
b( ldb, * )
151 parameter( one = 1.0d+0 )
155 INTEGER j, k, kc, kcnext, kp
156 DOUBLE PRECISION d11, d12, d21, d22, t1, t2
173 IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
175 ELSE IF( .NOT.
lsame( trans,
'N' ) .AND. .NOT.
176 $
lsame( trans,
'T' ) .AND. .NOT.
lsame( trans,
'C' ) )
THEN
178 ELSE IF( .NOT.
lsame( diag,
'U' ) .AND. .NOT.
lsame( diag,
'N' ) )
181 ELSE IF( n.LT.0 )
THEN
183 ELSE IF( ldb.LT.max( 1, n ) )
THEN
187 CALL
xerbla(
'DLAVSP ', -info )
196 nounit =
lsame( diag,
'N' )
202 IF(
lsame( trans,
'N' ) )
THEN
207 IF(
lsame( uplo,
'U' ) )
THEN
219 IF( ipiv( k ).GT.0 )
THEN
224 $ CALL
dscal( nrhs, a( kc+k-1 ),
b( k, 1 ), ldb )
232 CALL
dger( k-1, nrhs, one, a( kc ), 1,
b( k, 1 ), ldb,
239 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
254 d12 = a( kcnext+k-1 )
259 b( k,
j ) = d11*t1 + d12*t2
260 b( k+1,
j ) = d21*t1 + d22*t2
270 CALL
dger( k-1, nrhs, one, a( kc ), 1,
b( k, 1 ), ldb,
272 CALL
dger( k-1, nrhs, one, a( kcnext ), 1,
273 $
b( k+1, 1 ), ldb,
b( 1, 1 ), ldb )
277 kp = abs( ipiv( k ) )
279 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
295 kc = n*( n+1 ) / 2 + 1
304 IF( ipiv( k ).GT.0 )
THEN
311 $ CALL
dscal( nrhs, a( kc ),
b( k, 1 ), ldb )
320 CALL
dger( n-k, nrhs, one, a( kc+1 ), 1,
b( k, 1 ),
321 $ ldb,
b( k+1, 1 ), ldb )
327 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
335 kcnext = kc - ( n-k+2 )
347 b( k-1,
j ) = d11*t1 + d12*t2
348 b( k,
j ) = d21*t1 + d22*t2
358 CALL
dger( n-k, nrhs, one, a( kc+1 ), 1,
b( k, 1 ),
359 $ ldb,
b( k+1, 1 ), ldb )
360 CALL
dger( n-k, nrhs, one, a( kcnext+2 ), 1,
361 $
b( k-1, 1 ), ldb,
b( k+1, 1 ), ldb )
366 kp = abs( ipiv( k ) )
368 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
387 IF(
lsame( uplo,
'U' ) )
THEN
392 kc = n*( n+1 ) / 2 + 1
400 IF( ipiv( k ).GT.0 )
THEN
407 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
411 CALL
dgemv(
'Transpose', k-1, nrhs, one,
b, ldb,
412 $ a( kc ), 1, one,
b( k, 1 ), ldb )
415 $ CALL
dscal( nrhs, a( kc+k-1 ),
b( k, 1 ), ldb )
421 kcnext = kc - ( k-1 )
426 kp = abs( ipiv( k ) )
428 $ CALL
dswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
433 CALL
dgemv(
'Transpose', k-2, nrhs, one,
b, ldb,
434 $ a( kc ), 1, one,
b( k, 1 ), ldb )
435 CALL
dgemv(
'Transpose', k-2, nrhs, one,
b, ldb,
436 $ a( kcnext ), 1, one,
b( k-1, 1 ), ldb )
449 b( k-1,
j ) = d11*t1 + d12*t2
450 b( k,
j ) = d21*t1 + d22*t2
475 IF( ipiv( k ).GT.0 )
THEN
482 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
486 CALL
dgemv(
'Transpose', n-k, nrhs, one,
b( k+1, 1 ),
487 $ ldb, a( kc+1 ), 1, one,
b( k, 1 ), ldb )
490 $ CALL
dscal( nrhs, a( kc ),
b( k, 1 ), ldb )
497 kcnext = kc + n - k + 1
502 kp = abs( ipiv( k ) )
504 $ CALL
dswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
509 CALL
dgemv(
'Transpose', n-k-1, nrhs, one,
510 $
b( k+2, 1 ), ldb, a( kcnext+1 ), 1, one,
512 CALL
dgemv(
'Transpose', n-k-1, nrhs, one,
513 $
b( k+2, 1 ), ldb, a( kc+2 ), 1, one,
527 b( k,
j ) = d11*t1 + d12*t2
528 b( k+1,
j ) = d21*t1 + d22*t2
531 kc = kcnext + ( n-k )
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine dscal(N, DA, DX, INCX)
DSCAL
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dlavsp(UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
DLAVSP
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV