153 SUBROUTINE zlavhe( 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( one = ( 1.0d+0, 0.0d+0 ) )
179 COMPLEX*16 d11, d12, d21, d22, t1, t2
189 INTRINSIC abs, dconjg, 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(
'ZLAVHE ', -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, one, 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, one, a( 1, k ), 1,
b( k, 1 ),
291 $ ldb,
b( 1, 1 ), ldb )
292 CALL
zgeru( 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
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, one, a( k+1, k ), 1,
b( k, 1 ),
338 $ 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, one, a( k+1, k ), 1,
b( k, 1 ),
374 $ ldb,
b( k+1, 1 ), ldb )
375 CALL
zgeru( 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
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
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 )
425 CALL
zlacgv( nrhs,
b( k, 1 ), ldb )
426 CALL
zgemv(
'Conjugate', k-1, nrhs, one,
b, ldb,
427 $ a( 1, k ), 1, one,
b( k, 1 ), ldb )
428 CALL
zlacgv( nrhs,
b( k, 1 ), ldb )
431 $ CALL
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
441 kp = abs( ipiv( k ) )
443 $ CALL
zswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
451 CALL
zlacgv( nrhs,
b( k, 1 ), ldb )
452 CALL
zgemv(
'Conjugate', k-2, nrhs, one,
b, ldb,
453 $ a( 1, k ), 1, one,
b( k, 1 ), ldb )
454 CALL
zlacgv( nrhs,
b( k, 1 ), ldb )
456 CALL
zlacgv( nrhs,
b( k-1, 1 ), ldb )
457 CALL
zgemv(
'Conjugate', k-2, nrhs, one,
b, ldb,
458 $ a( 1, k-1 ), 1, one,
b( k-1, 1 ), ldb )
459 CALL
zlacgv( nrhs,
b( k-1, 1 ), ldb )
472 b( k-1,
j ) = d11*t1 + d12*t2
473 b( k,
j ) = d21*t1 + d22*t2
496 IF( ipiv( k ).GT.0 )
THEN
503 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
507 CALL
zlacgv( nrhs,
b( k, 1 ), ldb )
508 CALL
zgemv(
'Conjugate', n-k, nrhs, one,
b( k+1, 1 ),
509 $ ldb, a( k+1, k ), 1, one,
b( k, 1 ), ldb )
510 CALL
zlacgv( nrhs,
b( k, 1 ), ldb )
513 $ CALL
zscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
523 kp = abs( ipiv( k ) )
525 $ CALL
zswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
530 CALL
zlacgv( nrhs,
b( k+1, 1 ), ldb )
531 CALL
zgemv(
'Conjugate', n-k-1, nrhs, one,
532 $
b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, one,
534 CALL
zlacgv( nrhs,
b( k+1, 1 ), ldb )
536 CALL
zlacgv( nrhs,
b( k, 1 ), ldb )
537 CALL
zgemv(
'Conjugate', n-k-1, nrhs, one,
538 $
b( k+2, 1 ), ldb, a( k+2, k ), 1, one,
540 CALL
zlacgv( nrhs,
b( k, 1 ), ldb )
553 b( k,
j ) = d11*t1 + d12*t2
554 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 zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zlavhe(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVHE
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
subroutine zgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERU