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 zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zlavhe(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVHE
subroutine zgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERU
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL