165 CHARACTER diag, trans, uplo
166 INTEGER info, lda, ldb, n, nrhs
170 COMPLEX a( lda, * ),
b( ldb, * )
177 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
182 COMPLEX d11, d12, d21, d22, t1, t2
192 INTRINSIC abs, conjg, max
199 IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
201 ELSE IF( .NOT.
lsame( trans,
'N' ) .AND. .NOT.
lsame( trans,
'C' ) )
204 ELSE IF( .NOT.
lsame( diag,
'U' ) .AND. .NOT.
lsame( diag,
'N' ) )
207 ELSE IF( n.LT.0 )
THEN
209 ELSE IF( lda.LT.max( 1, n ) )
THEN
211 ELSE IF( ldb.LT.max( 1, n ) )
THEN
215 CALL
xerbla(
'CLAVHE_ROOK ', -info )
224 nounit =
lsame( diag,
'N' )
230 IF(
lsame( trans,
'N' ) )
THEN
235 IF(
lsame( uplo,
'U' ) )
THEN
243 IF( ipiv( k ).GT.0 )
THEN
250 $ CALL
cscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
258 CALL
cgeru( k-1, nrhs, cone, a( 1, k ), 1,
b( k, 1 ),
259 $ ldb,
b( 1, 1 ), ldb )
265 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
282 b( k,
j ) = d11*t1 + d12*t2
283 b( k+1,
j ) = d21*t1 + d22*t2
293 CALL
cgeru( k-1, nrhs, cone, a( 1, k ), 1,
b( k, 1 ),
294 $ ldb,
b( 1, 1 ), ldb )
295 CALL
cgeru( k-1, nrhs, cone, a( 1, k+1 ), 1,
296 $
b( k+1, 1 ), ldb,
b( 1, 1 ), ldb )
303 kp = abs( ipiv( k ) )
305 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
309 kp = abs( ipiv( k+1 ) )
311 $ CALL
cswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
334 IF( ipiv( k ).GT.0 )
THEN
341 $ CALL
cscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
350 CALL
cgeru( n-k, nrhs, cone, a( k+1, k ), 1,
351 $
b( k, 1 ), ldb,
b( k+1, 1 ), ldb )
357 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
375 b( k-1,
j ) = d11*t1 + d12*t2
376 b( k,
j ) = d21*t1 + d22*t2
386 CALL
cgeru( n-k, nrhs, cone, a( k+1, k ), 1,
387 $
b( k, 1 ), ldb,
b( k+1, 1 ), ldb )
388 CALL
cgeru( n-k, nrhs, cone, a( k+1, k-1 ), 1,
389 $
b( k-1, 1 ), ldb,
b( k+1, 1 ), ldb )
397 kp = abs( ipiv( k ) )
399 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
403 kp = abs( ipiv( k-1 ) )
405 $ CALL
cswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
425 IF(
lsame( uplo,
'U' ) )
THEN
435 IF( ipiv( k ).GT.0 )
THEN
442 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
448 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
449 CALL
cgemv(
'Conjugate', k-1, nrhs, cone,
b, ldb,
450 $ a( 1, k ), 1, cone,
b( k, 1 ), ldb )
451 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
454 $ CALL
cscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
464 kp = abs( ipiv( k ) )
466 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
470 kp = abs( ipiv( k-1 ) )
472 $ CALL
cswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
480 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
481 CALL
cgemv(
'Conjugate', k-2, nrhs, cone,
b, ldb,
482 $ a( 1, k ), 1, cone,
b( k, 1 ), ldb )
483 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
485 CALL
clacgv( nrhs,
b( k-1, 1 ), ldb )
486 CALL
cgemv(
'Conjugate', k-2, nrhs, cone,
b, ldb,
487 $ a( 1, k-1 ), 1, cone,
b( k-1, 1 ), ldb )
488 CALL
clacgv( nrhs,
b( k-1, 1 ), ldb )
501 b( k-1,
j ) = d11*t1 + d12*t2
502 b( k,
j ) = d21*t1 + d22*t2
525 IF( ipiv( k ).GT.0 )
THEN
532 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
536 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
537 CALL
cgemv(
'Conjugate', n-k, nrhs, cone,
b( k+1, 1 ),
538 $ ldb, a( k+1, k ), 1, cone,
b( k, 1 ), ldb )
539 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
542 $ CALL
cscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
552 kp = abs( ipiv( k ) )
554 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
558 kp = abs( ipiv( k+1 ) )
560 $ CALL
cswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
565 CALL
clacgv( nrhs,
b( k+1, 1 ), ldb )
566 CALL
cgemv(
'Conjugate', n-k-1, nrhs, cone,
567 $
b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
569 CALL
clacgv( nrhs,
b( k+1, 1 ), ldb )
571 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
572 CALL
cgemv(
'Conjugate', n-k-1, nrhs, cone,
573 $
b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
575 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
588 b( k,
j ) = d11*t1 + d12*t2
589 b( k+1,
j ) = d21*t1 + d22*t2
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
logical function lsame(CA, CB)
LSAME
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine clavhe_rook(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CLAVHE_ROOK
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERU