162 CHARACTER DIAG, TRANS, UPLO
163 INTEGER INFO, LDA, LDB, N, NRHS
167 COMPLEX*16 A( lda, * ), B( ldb, * )
174 parameter( cone = ( 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_ROOK ', -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, cone, 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, cone, a( 1, k ), 1, b( k, 1 ),
291 $ ldb, b( 1, 1 ), ldb )
292 CALL
zgeru( k-1, nrhs, cone, a( 1, k+1 ), 1,
293 $ b( k+1, 1 ), ldb, b( 1, 1 ), ldb )
300 kp = abs( ipiv( k ) )
302 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
306 kp = abs( ipiv( k+1 ) )
308 $ CALL zswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
331 IF( ipiv( k ).GT.0 )
THEN
338 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
347 CALL
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
348 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
354 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
372 b( k-1, j ) = d11*t1 + d12*t2
373 b( k, j ) = d21*t1 + d22*t2
383 CALL
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
384 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
385 CALL
zgeru( n-k, nrhs, cone, a( k+1, k-1 ), 1,
386 $ b( k-1, 1 ), ldb, b( k+1, 1 ), ldb )
394 kp = abs( ipiv( k ) )
396 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
400 kp = abs( ipiv( k-1 ) )
402 $ CALL zswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
422 IF( lsame( uplo,
'U' ) )
THEN
432 IF( ipiv( k ).GT.0 )
THEN
439 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
445 CALL
zlacgv( nrhs, b( k, 1 ), ldb )
446 CALL
zgemv(
'Conjugate', k-1, nrhs, cone, b, ldb,
447 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
448 CALL
zlacgv( nrhs, b( k, 1 ), ldb )
451 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
461 kp = abs( ipiv( k ) )
463 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
467 kp = abs( ipiv( k-1 ) )
469 $ CALL zswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
477 CALL
zlacgv( nrhs, b( k, 1 ), ldb )
478 CALL
zgemv(
'Conjugate', k-2, nrhs, cone, b, ldb,
479 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
480 CALL
zlacgv( nrhs, b( k, 1 ), ldb )
482 CALL
zlacgv( nrhs, b( k-1, 1 ), ldb )
483 CALL
zgemv(
'Conjugate', k-2, nrhs, cone, b, ldb,
484 $ a( 1, k-1 ), 1, cone, b( k-1, 1 ), ldb )
485 CALL
zlacgv( nrhs, b( k-1, 1 ), ldb )
498 b( k-1, j ) = d11*t1 + d12*t2
499 b( k, j ) = d21*t1 + d22*t2
522 IF( ipiv( k ).GT.0 )
THEN
529 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
533 CALL
zlacgv( nrhs, b( k, 1 ), ldb )
534 CALL
zgemv(
'Conjugate', n-k, nrhs, cone, b( k+1, 1 ),
535 $ ldb, a( k+1, k ), 1, cone, b( k, 1 ), ldb )
536 CALL
zlacgv( nrhs, b( k, 1 ), ldb )
539 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
549 kp = abs( ipiv( k ) )
551 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
555 kp = abs( ipiv( k+1 ) )
557 $ CALL zswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
562 CALL
zlacgv( nrhs, b( k+1, 1 ), ldb )
563 CALL
zgemv(
'Conjugate', n-k-1, nrhs, cone,
564 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
566 CALL
zlacgv( nrhs, b( k+1, 1 ), ldb )
568 CALL
zlacgv( nrhs, b( k, 1 ), ldb )
569 CALL
zgemv(
'Conjugate', n-k-1, nrhs, cone,
570 $ b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
572 CALL
zlacgv( nrhs, b( k, 1 ), ldb )
585 b( k, j ) = d11*t1 + d12*t2
586 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_rook(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVHE_ROOK
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
subroutine zgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERU