131 SUBROUTINE zlavsp( UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB,
140 CHARACTER diag, trans, uplo
141 INTEGER info, ldb, n, nrhs
145 COMPLEX*16 a( * ),
b( ldb, * )
152 parameter( one = ( 1.0d+0, 0.0d+0 ) )
156 INTEGER j, k, kc, kcnext, kp
157 COMPLEX*16 d11, d12, d21, d22, t1, t2
174 IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
176 ELSE IF( .NOT.
lsame( trans,
'N' ) .AND. .NOT.
lsame( trans,
'T' ) )
179 ELSE IF( .NOT.
lsame( diag,
'U' ) .AND. .NOT.
lsame( diag,
'N' ) )
182 ELSE IF( n.LT.0 )
THEN
184 ELSE IF( ldb.LT.max( 1, n ) )
THEN
188 CALL
xerbla(
'ZLAVSP ', -info )
197 nounit =
lsame( diag,
'N' )
203 IF(
lsame( trans,
'N' ) )
THEN
208 IF(
lsame( uplo,
'U' ) )
THEN
220 IF( ipiv( k ).GT.0 )
THEN
225 $ CALL
zscal( nrhs, a( kc+k-1 ),
b( k, 1 ), ldb )
233 CALL
zgeru( k-1, nrhs, one, a( kc ), 1,
b( k, 1 ),
234 $ ldb,
b( 1, 1 ), ldb )
240 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
255 d12 = a( kcnext+k-1 )
260 b( k,
j ) = d11*t1 + d12*t2
261 b( k+1,
j ) = d21*t1 + d22*t2
271 CALL
zgeru( k-1, nrhs, one, a( kc ), 1,
b( k, 1 ),
272 $ ldb,
b( 1, 1 ), ldb )
273 CALL
zgeru( k-1, nrhs, one, a( kcnext ), 1,
274 $
b( k+1, 1 ), ldb,
b( 1, 1 ), ldb )
278 kp = abs( ipiv( k ) )
280 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
296 kc = n*( n+1 ) / 2 + 1
305 IF( ipiv( k ).GT.0 )
THEN
312 $ CALL
zscal( nrhs, a( kc ),
b( k, 1 ), ldb )
321 CALL
zgeru( n-k, nrhs, one, a( kc+1 ), 1,
b( k, 1 ),
322 $ ldb,
b( k+1, 1 ), ldb )
328 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
336 kcnext = kc - ( n-k+2 )
348 b( k-1,
j ) = d11*t1 + d12*t2
349 b( k,
j ) = d21*t1 + d22*t2
359 CALL
zgeru( n-k, nrhs, one, a( kc+1 ), 1,
b( k, 1 ),
360 $ ldb,
b( k+1, 1 ), ldb )
361 CALL
zgeru( n-k, nrhs, one, a( kcnext+2 ), 1,
362 $
b( k-1, 1 ), ldb,
b( k+1, 1 ), ldb )
367 kp = abs( ipiv( k ) )
369 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
388 IF(
lsame( uplo,
'U' ) )
THEN
393 kc = n*( n+1 ) / 2 + 1
401 IF( ipiv( k ).GT.0 )
THEN
408 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
414 CALL
zgemv(
'Transpose', k-1, nrhs, one,
b, ldb,
415 $ a( kc ), 1, one,
b( k, 1 ), ldb )
418 $ CALL
zscal( nrhs, a( kc+k-1 ),
b( k, 1 ), ldb )
424 kcnext = kc - ( k-1 )
429 kp = abs( ipiv( k ) )
431 $ CALL
zswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
436 CALL
zgemv(
'Transpose', k-2, nrhs, one,
b, ldb,
437 $ a( kc ), 1, one,
b( k, 1 ), ldb )
439 CALL
zgemv(
'Transpose', k-2, nrhs, one,
b, ldb,
440 $ a( kcnext ), 1, one,
b( k-1, 1 ), ldb )
453 b( k-1,
j ) = d11*t1 + d12*t2
454 b( k,
j ) = d21*t1 + d22*t2
479 IF( ipiv( k ).GT.0 )
THEN
486 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
490 CALL
zgemv(
'Transpose', n-k, nrhs, one,
b( k+1, 1 ),
491 $ ldb, a( kc+1 ), 1, one,
b( k, 1 ), ldb )
494 $ CALL
zscal( nrhs, a( kc ),
b( k, 1 ), ldb )
501 kcnext = kc + n - k + 1
506 kp = abs( ipiv( k ) )
508 $ CALL
zswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
513 CALL
zgemv(
'Transpose', n-k-1, nrhs, one,
514 $
b( k+2, 1 ), ldb, a( kcnext+1 ), 1, one,
517 CALL
zgemv(
'Transpose', n-k-1, nrhs, one,
518 $
b( k+2, 1 ), ldb, a( kc+2 ), 1, one,
532 b( k,
j ) = d11*t1 + d12*t2
533 b( k+1,
j ) = d21*t1 + d22*t2
536 kc = kcnext + ( n-k )
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
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 zlavsp(UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
ZLAVSP
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
subroutine zgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERU