131 SUBROUTINE clavhp( UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB,
140 CHARACTER diag, trans, uplo
141 INTEGER info, ldb, n, nrhs
145 COMPLEX a( * ),
b( ldb, * )
152 parameter( one = ( 1.0e+0, 0.0e+0 ) )
156 INTEGER j, k, kc, kcnext, kp
157 COMPLEX d11, d12, d21, d22, t1, t2
167 INTRINSIC abs, conjg, max
174 IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
176 ELSE IF( .NOT.
lsame( trans,
'N' ) .AND. .NOT.
lsame( trans,
'C' ) )
179 ELSE IF( .NOT.
lsame( diag,
'U' ) .AND. .NOT.
lsame( diag,
'N' ) )
182 ELSE IF( n.LT.0 )
THEN
184 ELSE IF( ldb.LT.max( 1, n ) )
THEN
188 CALL
xerbla(
'CLAVHP ', -info )
197 nounit =
lsame( diag,
'N' )
203 IF(
lsame( trans,
'N' ) )
THEN
208 IF(
lsame( uplo,
'U' ) )
THEN
220 IF( ipiv( k ).GT.0 )
THEN
225 $ CALL
cscal( nrhs, a( kc+k-1 ),
b( k, 1 ), ldb )
233 CALL
cgeru( k-1, nrhs, one, a( kc ), 1,
b( k, 1 ),
234 $ ldb,
b( 1, 1 ), ldb )
240 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
255 d12 = a( kcnext+k-1 )
260 b( k,
j ) = d11*t1 + d12*t2
261 b( k+1,
j ) = d21*t1 + d22*t2
271 CALL
cgeru( k-1, nrhs, one, a( kc ), 1,
b( k, 1 ),
272 $ ldb,
b( 1, 1 ), ldb )
273 CALL
cgeru( k-1, nrhs, one, a( kcnext ), 1,
274 $
b( k+1, 1 ), ldb,
b( 1, 1 ), ldb )
278 kp = abs( ipiv( k ) )
280 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
296 kc = n*( n+1 ) / 2 + 1
305 IF( ipiv( k ).GT.0 )
THEN
312 $ CALL
cscal( nrhs, a( kc ),
b( k, 1 ), ldb )
321 CALL
cgeru( n-k, nrhs, one, a( kc+1 ), 1,
b( k, 1 ),
322 $ ldb,
b( k+1, 1 ), ldb )
328 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
336 kcnext = kc - ( n-k+2 )
348 b( k-1,
j ) = d11*t1 + d12*t2
349 b( k,
j ) = d21*t1 + d22*t2
359 CALL
cgeru( n-k, nrhs, one, a( kc+1 ), 1,
b( k, 1 ),
360 $ ldb,
b( k+1, 1 ), ldb )
361 CALL
cgeru( n-k, nrhs, one, a( kcnext+2 ), 1,
362 $
b( k-1, 1 ), ldb,
b( k+1, 1 ), ldb )
367 kp = abs( ipiv( k ) )
369 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
388 IF(
lsame( uplo,
'U' ) )
THEN
393 kc = n*( n+1 ) / 2 + 1
400 IF( ipiv( k ).GT.0 )
THEN
407 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
413 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
414 CALL
cgemv(
'Conjugate', k-1, nrhs, one,
b, ldb,
415 $ a( kc ), 1, one,
b( k, 1 ), ldb )
416 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
419 $ CALL
cscal( nrhs, a( kc+k-1 ),
b( k, 1 ), ldb )
425 kcnext = kc - ( k-1 )
430 kp = abs( ipiv( k ) )
432 $ CALL
cswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
437 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
438 CALL
cgemv(
'Conjugate', k-2, nrhs, one,
b, ldb,
439 $ a( kc ), 1, one,
b( k, 1 ), ldb )
440 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
442 CALL
clacgv( nrhs,
b( k-1, 1 ), ldb )
443 CALL
cgemv(
'Conjugate', k-2, nrhs, one,
b, ldb,
444 $ a( kcnext ), 1, one,
b( k-1, 1 ), ldb )
445 CALL
clacgv( nrhs,
b( k-1, 1 ), ldb )
458 b( k-1,
j ) = d11*t1 + d12*t2
459 b( k,
j ) = d21*t1 + d22*t2
484 IF( ipiv( k ).GT.0 )
THEN
491 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
495 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
496 CALL
cgemv(
'Conjugate', n-k, nrhs, one,
b( k+1, 1 ),
497 $ ldb, a( kc+1 ), 1, one,
b( k, 1 ), ldb )
498 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
501 $ CALL
cscal( nrhs, a( kc ),
b( k, 1 ), ldb )
508 kcnext = kc + n - k + 1
513 kp = abs( ipiv( k ) )
515 $ CALL
cswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
520 CALL
clacgv( nrhs,
b( k+1, 1 ), ldb )
521 CALL
cgemv(
'Conjugate', n-k-1, nrhs, one,
522 $
b( k+2, 1 ), ldb, a( kcnext+1 ), 1, one,
524 CALL
clacgv( nrhs,
b( k+1, 1 ), ldb )
526 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
527 CALL
cgemv(
'Conjugate', n-k-1, nrhs, one,
528 $
b( k+2, 1 ), ldb, a( kc+2 ), 1, one,
530 CALL
clacgv( nrhs,
b( k, 1 ), ldb )
543 b( k,
j ) = d11*t1 + d12*t2
544 b( k+1,
j ) = d21*t1 + d22*t2
547 kc = kcnext + ( n-k )
LOGICAL function lsame(CA, CB)
LSAME
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine clavhp(UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
CLAVHP
subroutine cgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERU