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 cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine clavhe(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CLAVHE
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine cgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERU