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 xerbla(SRNAME, INFO)
XERBLA
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
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