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
LOGICAL function lsame(CA, CB)
LSAME
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
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