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
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.
logical function lsame(CA, CB)
LSAME
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