151 SUBROUTINE clavsy( UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B,
159 CHARACTER DIAG, TRANS, UPLO
160 INTEGER INFO, LDA, LDB, N, NRHS
164 COMPLEX A( LDA, * ), B( LDB, * )
171 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
176 COMPLEX D11, D12, D21, D22, T1, T2
193 IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
195 ELSE IF( .NOT.lsame( trans,
'N' ) .AND. .NOT.lsame( trans,
'T' ) )
198 ELSE IF( .NOT.lsame( diag,
'U' ) .AND. .NOT.lsame( diag,
'N' ) )
201 ELSE IF( n.LT.0 )
THEN
203 ELSE IF( lda.LT.max( 1, n ) )
THEN
205 ELSE IF( ldb.LT.max( 1, n ) )
THEN
209 CALL xerbla(
'CLAVSY ', -info )
218 nounit = lsame( diag,
'N' )
224 IF( lsame( trans,
'N' ) )
THEN
229 IF( lsame( uplo,
'U' ) )
THEN
237 IF( ipiv( k ).GT.0 )
THEN
244 $
CALL cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
252 CALL cgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
253 $ ldb, b( 1, 1 ), ldb )
259 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
276 b( k, j ) = d11*t1 + d12*t2
277 b( k+1, j ) = d21*t1 + d22*t2
287 CALL cgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
288 $ ldb, b( 1, 1 ), ldb )
289 CALL cgeru( k-1, nrhs, cone, a( 1, k+1 ), 1,
290 $ b( k+1, 1 ), ldb, b( 1, 1 ), ldb )
294 kp = abs( ipiv( k ) )
296 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
318 IF( ipiv( k ).GT.0 )
THEN
325 $
CALL cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
334 CALL cgeru( n-k, nrhs, cone, a( k+1, k ), 1,
335 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
341 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
359 b( k-1, j ) = d11*t1 + d12*t2
360 b( k, j ) = d21*t1 + d22*t2
370 CALL cgeru( n-k, nrhs, cone, a( k+1, k ), 1,
371 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
372 CALL cgeru( n-k, nrhs, cone, a( k+1, k-1 ), 1,
373 $ b( k-1, 1 ), ldb, b( k+1, 1 ), ldb )
378 kp = abs( ipiv( k ) )
380 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
392 ELSE IF( lsame( trans,
'T' ) )
THEN
398 IF( lsame( uplo,
'U' ) )
THEN
408 IF( ipiv( k ).GT.0 )
THEN
415 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
419 CALL cgemv(
'Transpose', k-1, nrhs, cone, b, ldb,
420 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
423 $
CALL cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
433 kp = abs( ipiv( k ) )
435 $
CALL cswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
440 CALL cgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
441 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
442 CALL cgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
443 $ a( 1, k-1 ), 1, cone, b( k-1, 1 ), ldb )
456 b( k-1, j ) = d11*t1 + d12*t2
457 b( k, j ) = d21*t1 + d22*t2
480 IF( ipiv( k ).GT.0 )
THEN
487 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
491 CALL cgemv(
'Transpose', n-k, nrhs, cone, b( k+1, 1 ),
492 $ ldb, a( k+1, k ), 1, cone, b( k, 1 ), ldb )
495 $
CALL cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
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, cone,
513 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
515 CALL cgemv(
'Transpose', n-k-1, nrhs, cone,
516 $ b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
530 b( k, j ) = d11*t1 + d12*t2
531 b( k+1, j ) = d21*t1 + d22*t2