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 )
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine clavsp(UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
CLAVSP
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine cgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERU