153 SUBROUTINE clavhe( UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B,
162 CHARACTER diag, trans, uplo
163 INTEGER info, lda, ldb, n, nrhs
167 COMPLEX a( lda, * ),
b( ldb, * )
174 parameter( one = ( 1.0e+0, 0.0e+0 ) )
179 COMPLEX d11, d12, d21, d22, t1, t2
189 INTRINSIC abs, conjg, max
196 IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
198 ELSE IF( .NOT.
lsame( trans,
'N' ) .AND. .NOT.
lsame( trans,
'C' ) )
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(
'CLAVHE ', -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
cscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
255 CALL
cgeru( k-1, nrhs, one, a( 1, k ), 1,
b( k, 1 ),
256 $ ldb,
b( 1, 1 ), ldb )
262 $ CALL
cswap( 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
cgeru( k-1, nrhs, one, a( 1, k ), 1,
b( k, 1 ),
291 $ ldb,
b( 1, 1 ), ldb )
292 CALL
cgeru( k-1, nrhs, one, a( 1, k+1 ), 1,
293 $
b( k+1, 1 ), ldb,
b( 1, 1 ), ldb )
297 kp = abs( ipiv( k ) )
299 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
321 IF( ipiv( k ).GT.0 )
THEN
328 $ CALL
cscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
337 CALL
cgeru( n-k, nrhs, one, a( k+1, k ), 1,
338 $
b( k, 1 ), ldb,
b( k+1, 1 ), ldb )
344 $ CALL
cswap( 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
cgeru( n-k, nrhs, one, a( k+1, k ), 1,
374 $
b( k, 1 ), ldb,
b( k+1, 1 ), ldb )
375 CALL
cgeru( n-k, nrhs, one, a( k+1, k-1 ), 1,
376 $
b( k-1, 1 ), ldb,
b( k+1, 1 ), ldb )
381 kp = abs( ipiv( k ) )
383 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
401 IF(
lsame( uplo,
'U' ) )
THEN
411 IF( ipiv( k ).GT.0 )
THEN
418 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
424 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
425 CALL
cgemv(
'Conjugate', k-1, nrhs, one,
b, ldb,
426 $ a( 1, k ), 1, one,
b( k, 1 ), ldb )
427 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
430 $ CALL
cscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
440 kp = abs( ipiv( k ) )
442 $ CALL
cswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
450 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
451 CALL
cgemv(
'Conjugate', k-2, nrhs, one,
b, ldb,
452 $ a( 1, k ), 1, one,
b( k, 1 ), ldb )
453 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
455 CALL
clacgv( nrhs,
b( k-1, 1 ), ldb )
456 CALL
cgemv(
'Conjugate', k-2, nrhs, one,
b, ldb,
457 $ a( 1, k-1 ), 1, one,
b( k-1, 1 ), ldb )
458 CALL
clacgv( nrhs,
b( k-1, 1 ), ldb )
471 b( k-1,
j ) = d11*t1 + d12*t2
472 b( k,
j ) = d21*t1 + d22*t2
495 IF( ipiv( k ).GT.0 )
THEN
502 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
506 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
507 CALL
cgemv(
'Conjugate', n-k, nrhs, one,
b( k+1, 1 ),
508 $ ldb, a( k+1, k ), 1, one,
b( k, 1 ), ldb )
509 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
512 $ CALL
cscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
522 kp = abs( ipiv( k ) )
524 $ CALL
cswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
529 CALL
clacgv( nrhs,
b( k+1, 1 ), ldb )
530 CALL
cgemv(
'Conjugate', n-k-1, nrhs, one,
531 $
b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, one,
533 CALL
clacgv( nrhs,
b( k+1, 1 ), ldb )
535 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
536 CALL
cgemv(
'Conjugate', n-k-1, nrhs, one,
537 $
b( k+2, 1 ), ldb, a( k+2, k ), 1, one,
539 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
552 b( k,
j ) = d11*t1 + d12*t2
553 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 clavhe(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CLAVHE
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
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