131 SUBROUTINE clavsp( 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
174 IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
176 ELSE IF( .NOT.
lsame( trans,
'N' ) .AND. .NOT.
lsame( trans,
'T' ) )
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(
'CLAVSP ', -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
cgemv(
'Transpose', k-1, nrhs, one,
b, ldb,
414 $ a( kc ), 1, one,
b( k, 1 ), ldb )
417 $ CALL
cscal( nrhs, a( kc+k-1 ),
b( k, 1 ), ldb )
423 kcnext = kc - ( k-1 )
428 kp = abs( ipiv( k ) )
430 $ CALL
cswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
435 CALL
cgemv(
'Transpose', k-2, nrhs, one,
b, ldb,
436 $ a( kc ), 1, one,
b( k, 1 ), ldb )
438 CALL
cgemv(
'Transpose', k-2, nrhs, one,
b, ldb,
439 $ a( kcnext ), 1, one,
b( k-1, 1 ), ldb )
452 b( k-1,
j ) = d11*t1 + d12*t2
453 b( k,
j ) = d21*t1 + d22*t2
478 IF( ipiv( k ).GT.0 )
THEN
485 $ CALL
cswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
489 CALL
cgemv(
'Transpose', n-k, nrhs, one,
b( k+1, 1 ),
490 $ ldb, a( kc+1 ), 1, one,
b( k, 1 ), ldb )
493 $ CALL
cscal( nrhs, a( kc ),
b( k, 1 ), ldb )
500 kcnext = kc + n - k + 1
505 kp = abs( ipiv( k ) )
507 $ CALL
cswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
512 CALL
cgemv(
'Transpose', n-k-1, nrhs, one,
513 $
b( k+2, 1 ), ldb, a( kcnext+1 ), 1, one,
516 CALL
cgemv(
'Transpose', n-k-1, nrhs, one,
517 $
b( k+2, 1 ), ldb, a( kc+2 ), 1, one,
531 b( k,
j ) = d11*t1 + d12*t2
532 b( k+1,
j ) = d21*t1 + d22*t2
535 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 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 clavsp(UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
CLAVSP
subroutine cgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERU