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 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 zscal(N, ZA, ZX, INCX)
ZSCAL
subroutine zgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERU