153 SUBROUTINE zlavsy( UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B,
162 CHARACTER diag, trans, uplo
163 INTEGER info, lda, ldb, n, nrhs
167 COMPLEX*16 a( lda, * ),
b( ldb, * )
174 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
179 COMPLEX*16 d11, d12, d21, d22, t1, t2
196 IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
198 ELSE IF( .NOT.
lsame( trans,
'N' ) .AND. .NOT.
lsame( trans,
'T' ) )
201 ELSE IF( .NOT.
lsame( diag,
'U' ) .AND. .NOT.
lsame( diag,
'N' ) )
204 ELSE IF( n.LT.0 )
THEN
206 ELSE IF( lda.LT.max( 1, n ) )
THEN
208 ELSE IF( ldb.LT.max( 1, n ) )
THEN
212 CALL
xerbla(
'ZLAVSY ', -info )
221 nounit =
lsame( diag,
'N' )
227 IF(
lsame( trans,
'N' ) )
THEN
232 IF(
lsame( uplo,
'U' ) )
THEN
240 IF( ipiv( k ).GT.0 )
THEN
247 $ CALL
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
255 CALL
zgeru( k-1, nrhs, cone, a( 1, k ), 1,
b( k, 1 ),
256 $ ldb,
b( 1, 1 ), ldb )
262 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
279 b( k,
j ) = d11*t1 + d12*t2
280 b( k+1,
j ) = d21*t1 + d22*t2
290 CALL
zgeru( k-1, nrhs, cone, a( 1, k ), 1,
b( k, 1 ),
291 $ ldb,
b( 1, 1 ), ldb )
292 CALL
zgeru( k-1, nrhs, cone, a( 1, k+1 ), 1,
293 $
b( k+1, 1 ), ldb,
b( 1, 1 ), ldb )
297 kp = abs( ipiv( k ) )
299 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
321 IF( ipiv( k ).GT.0 )
THEN
328 $ CALL
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
337 CALL
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
338 $
b( k, 1 ), ldb,
b( k+1, 1 ), ldb )
344 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
362 b( k-1,
j ) = d11*t1 + d12*t2
363 b( k,
j ) = d21*t1 + d22*t2
373 CALL
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
374 $
b( k, 1 ), ldb,
b( k+1, 1 ), ldb )
375 CALL
zgeru( n-k, nrhs, cone, a( k+1, k-1 ), 1,
376 $
b( k-1, 1 ), ldb,
b( k+1, 1 ), ldb )
381 kp = abs( ipiv( k ) )
383 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
395 ELSE IF(
lsame( trans,
'T' ) )
THEN
401 IF(
lsame( uplo,
'U' ) )
THEN
412 IF( ipiv( k ).GT.0 )
THEN
419 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
423 CALL
zgemv(
'Transpose', k-1, nrhs, cone,
b, ldb,
424 $ a( 1, k ), 1, cone,
b( k, 1 ), ldb )
427 $ CALL
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
437 kp = abs( ipiv( k ) )
439 $ CALL
zswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
444 CALL
zgemv(
'Transpose', k-2, nrhs, cone,
b, ldb,
445 $ a( 1, k ), 1, cone,
b( k, 1 ), ldb )
446 CALL
zgemv(
'Transpose', k-2, nrhs, cone,
b, ldb,
447 $ a( 1, k-1 ), 1, cone,
b( k-1, 1 ), ldb )
460 b( k-1,
j ) = d11*t1 + d12*t2
461 b( k,
j ) = d21*t1 + d22*t2
484 IF( ipiv( k ).GT.0 )
THEN
491 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
495 CALL
zgemv(
'Transpose', n-k, nrhs, cone,
b( k+1, 1 ),
496 $ ldb, a( k+1, k ), 1, cone,
b( k, 1 ), ldb )
499 $ CALL
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
509 kp = abs( ipiv( k ) )
511 $ CALL
zswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
516 CALL
zgemv(
'Transpose', n-k-1, nrhs, cone,
517 $
b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
519 CALL
zgemv(
'Transpose', n-k-1, nrhs, cone,
520 $
b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
534 b( k,
j ) = d11*t1 + d12*t2
535 b( k+1,
j ) = d21*t1 + d22*t2
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zlavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVSY
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
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