164 CHARACTER diag, trans, uplo
165 INTEGER info, lda, ldb, n, nrhs
169 COMPLEX*16 a( lda, * ),
b( ldb, * )
176 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
181 COMPLEX*16 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.
lsame( trans,
'T' ) )
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(
'ZLAVSY_ROOK ', -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
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
257 CALL
zgeru( k-1, nrhs, cone, a( 1, k ), 1,
b( k, 1 ),
258 $ ldb,
b( 1, 1 ), ldb )
264 $ CALL
zswap( 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
zgeru( k-1, nrhs, cone, a( 1, k ), 1,
b( k, 1 ),
293 $ ldb,
b( 1, 1 ), ldb )
294 CALL
zgeru( k-1, nrhs, cone, a( 1, k+1 ), 1,
295 $
b( k+1, 1 ), ldb,
b( 1, 1 ), ldb )
302 kp = abs( ipiv( k ) )
304 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
308 kp = abs( ipiv( k+1 ) )
310 $ CALL
zswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
333 IF( ipiv( k ).GT.0 )
THEN
340 $ CALL
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
349 CALL
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
350 $
b( k, 1 ), ldb,
b( k+1, 1 ), ldb )
356 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
374 b( k-1,
j ) = d11*t1 + d12*t2
375 b( k,
j ) = d21*t1 + d22*t2
385 CALL
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
386 $
b( k, 1 ), ldb,
b( k+1, 1 ), ldb )
387 CALL
zgeru( n-k, nrhs, cone, a( k+1, k-1 ), 1,
388 $
b( k-1, 1 ), ldb,
b( k+1, 1 ), ldb )
395 kp = abs( ipiv( k ) )
397 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
401 kp = abs( ipiv( k-1 ) )
403 $ CALL
zswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
416 ELSE IF(
lsame( trans,
'T' ) )
THEN
422 IF(
lsame( uplo,
'U' ) )
THEN
433 IF( ipiv( k ).GT.0 )
THEN
440 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
444 CALL
zgemv(
'Transpose', k-1, nrhs, cone,
b, ldb,
445 $ a( 1, k ), 1, cone,
b( k, 1 ), ldb )
448 $ CALL
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
458 kp = abs( ipiv( k ) )
460 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
464 kp = abs( ipiv( k-1 ) )
466 $ CALL
zswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
471 CALL
zgemv(
'Transpose', k-2, nrhs, cone,
b, ldb,
472 $ a( 1, k ), 1, cone,
b( k, 1 ), ldb )
473 CALL
zgemv(
'Transpose', k-2, nrhs, cone,
b, ldb,
474 $ a( 1, k-1 ), 1, cone,
b( k-1, 1 ), ldb )
487 b( k-1,
j ) = d11*t1 + d12*t2
488 b( k,
j ) = d21*t1 + d22*t2
511 IF( ipiv( k ).GT.0 )
THEN
518 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
522 CALL
zgemv(
'Transpose', n-k, nrhs, cone,
b( k+1, 1 ),
523 $ ldb, a( k+1, k ), 1, cone,
b( k, 1 ), ldb )
526 $ CALL
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
536 kp = abs( ipiv( k ) )
538 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
542 kp = abs( ipiv( k+1 ) )
544 $ CALL
zswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
549 CALL
zgemv(
'Transpose', n-k-1, nrhs, cone,
550 $
b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
552 CALL
zgemv(
'Transpose', n-k-1, nrhs, cone,
553 $
b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
567 b( k,
j ) = d11*t1 + d12*t2
568 b( k+1,
j ) = d21*t1 + d22*t2
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 zlavsy_rook(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVSY_ROOK
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