155 SUBROUTINE clavsy_rook( UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV,
164 CHARACTER DIAG, TRANS, UPLO
165 INTEGER INFO, LDA, LDB, N, NRHS
169 COMPLEX A( lda, * ), B( ldb, * )
176 parameter ( cone = ( 1.0e+0, 0.0e+0 ) )
181 COMPLEX D11, D12, D21, D22, T1, T2
198 IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
200 ELSE IF( .NOT.lsame( trans,
'N' ) .AND. .NOT.lsame( trans,
'T' ) )
203 ELSE IF( .NOT.lsame( diag,
'U' ) .AND. .NOT.lsame( diag,
'N' ) )
206 ELSE IF( n.LT.0 )
THEN
208 ELSE IF( lda.LT.max( 1, n ) )
THEN
210 ELSE IF( ldb.LT.max( 1, n ) )
THEN
214 CALL xerbla(
'CLAVSY_ROOK ', -info )
223 nounit = lsame( diag,
'N' )
229 IF( lsame( trans,
'N' ) )
THEN
234 IF( lsame( uplo,
'U' ) )
THEN
242 IF( ipiv( k ).GT.0 )
THEN
249 $
CALL cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
257 CALL cgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
258 $ ldb, b( 1, 1 ), ldb )
264 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
281 b( k, j ) = d11*t1 + d12*t2
282 b( k+1, j ) = d21*t1 + d22*t2
292 CALL cgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
293 $ ldb, b( 1, 1 ), ldb )
294 CALL cgeru( k-1, nrhs, cone, a( 1, k+1 ), 1,
295 $ b( k+1, 1 ), ldb, b( 1, 1 ), ldb )
302 kp = abs( ipiv( k ) )
304 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
308 kp = abs( ipiv( k+1 ) )
310 $
CALL cswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
333 IF( ipiv( k ).GT.0 )
THEN
340 $
CALL cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
349 CALL cgeru( n-k, nrhs, cone, a( k+1, k ), 1,
350 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
356 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
374 b( k-1, j ) = d11*t1 + d12*t2
375 b( k, j ) = d21*t1 + d22*t2
385 CALL cgeru( n-k, nrhs, cone, a( k+1, k ), 1,
386 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
387 CALL cgeru( n-k, nrhs, cone, a( k+1, k-1 ), 1,
388 $ b( k-1, 1 ), ldb, b( k+1, 1 ), ldb )
395 kp = abs( ipiv( k ) )
397 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
401 kp = abs( ipiv( k-1 ) )
403 $
CALL cswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
416 ELSE IF( lsame( trans,
'T' ) )
THEN
422 IF( lsame( uplo,
'U' ) )
THEN
432 IF( ipiv( k ).GT.0 )
THEN
439 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
443 CALL cgemv(
'Transpose', k-1, nrhs, cone, b, ldb,
444 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
447 $
CALL cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
457 kp = abs( ipiv( k ) )
459 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
463 kp = abs( ipiv( k-1 ) )
465 $
CALL cswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
470 CALL cgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
471 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
472 CALL cgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
473 $ a( 1, k-1 ), 1, cone, b( k-1, 1 ), ldb )
486 b( k-1, j ) = d11*t1 + d12*t2
487 b( k, j ) = d21*t1 + d22*t2
510 IF( ipiv( k ).GT.0 )
THEN
517 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
521 CALL cgemv(
'Transpose', n-k, nrhs, cone, b( k+1, 1 ),
522 $ ldb, a( k+1, k ), 1, cone, b( k, 1 ), ldb )
525 $
CALL cscal( nrhs, a( k, k ), b( k, 1 ), ldb )
535 kp = abs( ipiv( k ) )
537 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
541 kp = abs( ipiv( k+1 ) )
543 $
CALL cswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
548 CALL cgemv(
'Transpose', n-k-1, nrhs, cone,
549 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
551 CALL cgemv(
'Transpose', n-k-1, nrhs, cone,
552 $ b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
566 b( k, j ) = d11*t1 + d12*t2
567 b( k+1, j ) = d21*t1 + d22*t2
subroutine clavsy_rook(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CLAVSY_ROOK
subroutine cscal(N, CA, CX, INCX)
CSCAL
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