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