153 SUBROUTINE clavsy( UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B,
162 CHARACTER DIAG, TRANS, UPLO
163 INTEGER INFO, LDA, LDB, N, NRHS
167 COMPLEX A( lda, * ), B( ldb, * )
174 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
179 COMPLEX D11, D12, D21, D22, T1, T2
196 IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
198 ELSE IF( .NOT.lsame( trans,
'N' ) .AND. .NOT.lsame( trans,
'T' ) )
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(
'CLAVSY ', -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
cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
255 CALL
cgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
256 $ ldb, b( 1, 1 ), ldb )
262 $ CALL cswap( 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
cgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
291 $ ldb, b( 1, 1 ), ldb )
292 CALL
cgeru( k-1, nrhs, cone, a( 1, k+1 ), 1,
293 $ b( k+1, 1 ), ldb, b( 1, 1 ), ldb )
297 kp = abs( ipiv( k ) )
299 $ CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
321 IF( ipiv( k ).GT.0 )
THEN
328 $ CALL
cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
337 CALL
cgeru( n-k, nrhs, cone, a( k+1, k ), 1,
338 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
344 $ CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
362 b( k-1, j ) = d11*t1 + d12*t2
363 b( k, j ) = d21*t1 + d22*t2
373 CALL
cgeru( n-k, nrhs, cone, a( k+1, k ), 1,
374 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
375 CALL
cgeru( n-k, nrhs, cone, a( k+1, k-1 ), 1,
376 $ b( k-1, 1 ), ldb, b( k+1, 1 ), ldb )
381 kp = abs( ipiv( k ) )
383 $ CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
395 ELSE IF( lsame( trans,
'T' ) )
THEN
401 IF( lsame( uplo,
'U' ) )
THEN
411 IF( ipiv( k ).GT.0 )
THEN
418 $ CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
422 CALL
cgemv(
'Transpose', k-1, nrhs, cone, b, ldb,
423 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
426 $ CALL
cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
436 kp = abs( ipiv( k ) )
438 $ CALL cswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
443 CALL
cgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
444 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
445 CALL
cgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
446 $ a( 1, k-1 ), 1, cone, b( k-1, 1 ), ldb )
459 b( k-1, j ) = d11*t1 + d12*t2
460 b( k, j ) = d21*t1 + d22*t2
483 IF( ipiv( k ).GT.0 )
THEN
490 $ CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
494 CALL
cgemv(
'Transpose', n-k, nrhs, cone, b( k+1, 1 ),
495 $ ldb, a( k+1, k ), 1, cone, b( k, 1 ), ldb )
498 $ CALL
cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
508 kp = abs( ipiv( k ) )
510 $ CALL cswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
515 CALL
cgemv(
'Transpose', n-k-1, nrhs, cone,
516 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
518 CALL
cgemv(
'Transpose', n-k-1, nrhs, cone,
519 $ b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
533 b( k, j ) = d11*t1 + d12*t2
534 b( k+1, j ) = d21*t1 + d22*t2
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 clavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CLAVSY
subroutine cgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERU