166 CHARACTER diag, trans, uplo
167 INTEGER info, lda, ldb, n, nrhs
171 DOUBLE PRECISION a( lda, * ),
b( ldb, * )
178 parameter( one = 1.0d+0 )
183 DOUBLE PRECISION d11, d12, d21, d22, t1, t2
200 IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
202 ELSE IF( .NOT.
lsame( trans,
'N' ) .AND. .NOT.
203 $
lsame( trans,
'T' ) .AND. .NOT.
lsame( trans,
'C' ) )
THEN
205 ELSE IF( .NOT.
lsame( diag,
'U' ) .AND. .NOT.
lsame( diag,
'N' ) )
208 ELSE IF( n.LT.0 )
THEN
210 ELSE IF( lda.LT.max( 1, n ) )
THEN
212 ELSE IF( ldb.LT.max( 1, n ) )
THEN
216 CALL
xerbla(
'DLAVSY_ROOK ', -info )
225 nounit =
lsame( diag,
'N' )
231 IF(
lsame( trans,
'N' ) )
THEN
236 IF(
lsame( uplo,
'U' ) )
THEN
244 IF( ipiv( k ).GT.0 )
THEN
251 $ CALL
dscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
259 CALL
dger( k-1, nrhs, one, a( 1, k ), 1,
b( k, 1 ),
260 $ ldb,
b( 1, 1 ), ldb )
266 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
283 b( k,
j ) = d11*t1 + d12*t2
284 b( k+1,
j ) = d21*t1 + d22*t2
294 CALL
dger( k-1, nrhs, one, a( 1, k ), 1,
b( k, 1 ),
295 $ ldb,
b( 1, 1 ), ldb )
296 CALL
dger( k-1, nrhs, one, a( 1, k+1 ), 1,
297 $
b( k+1, 1 ), ldb,
b( 1, 1 ), ldb )
304 kp = abs( ipiv( k ) )
306 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
310 kp = abs( ipiv( k+1 ) )
312 $ CALL
dswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
335 IF( ipiv( k ).GT.0 )
THEN
342 $ CALL
dscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
351 CALL
dger( n-k, nrhs, one, a( k+1, k ), 1,
b( k, 1 ),
352 $ ldb,
b( k+1, 1 ), ldb )
358 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
376 b( k-1,
j ) = d11*t1 + d12*t2
377 b( k,
j ) = d21*t1 + d22*t2
387 CALL
dger( n-k, nrhs, one, a( k+1, k ), 1,
b( k, 1 ),
388 $ ldb,
b( k+1, 1 ), ldb )
389 CALL
dger( n-k, nrhs, one, a( k+1, k-1 ), 1,
390 $
b( k-1, 1 ), ldb,
b( k+1, 1 ), ldb )
397 kp = abs( ipiv( k ) )
399 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
403 kp = abs( ipiv( k-1 ) )
405 $ CALL
dswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
424 IF(
lsame( uplo,
'U' ) )
THEN
435 IF( ipiv( k ).GT.0 )
THEN
442 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
446 CALL
dgemv(
'Transpose', k-1, nrhs, one,
b, ldb,
447 $ a( 1, k ), 1, one,
b( k, 1 ), ldb )
450 $ CALL
dscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
460 kp = abs( ipiv( k ) )
462 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
466 kp = abs( ipiv( k-1 ) )
468 $ CALL
dswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ),
473 CALL
dgemv(
'Transpose', k-2, nrhs, one,
b, ldb,
474 $ a( 1, k ), 1, one,
b( k, 1 ), ldb )
475 CALL
dgemv(
'Transpose', k-2, nrhs, one,
b, ldb,
476 $ a( 1, k-1 ), 1, one,
b( k-1, 1 ), ldb )
489 b( k-1,
j ) = d11*t1 + d12*t2
490 b( k,
j ) = d21*t1 + d22*t2
513 IF( ipiv( k ).GT.0 )
THEN
520 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
524 CALL
dgemv(
'Transpose', n-k, nrhs, one,
b( k+1, 1 ),
525 $ ldb, a( k+1, k ), 1, one,
b( k, 1 ), ldb )
528 $ CALL
dscal( nrhs, a( k, k ),
b( k, 1 ), ldb )
538 kp = abs( ipiv( k ) )
540 $ CALL
dswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
544 kp = abs( ipiv( k+1 ) )
546 $ CALL
dswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ),
551 CALL
dgemv(
'Transpose', n-k-1, nrhs, one,
552 $
b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, one,
554 CALL
dgemv(
'Transpose', n-k-1, nrhs, one,
555 $
b( k+2, 1 ), ldb, a( k+2, k ), 1, one,
569 b( k,
j ) = d11*t1 + d12*t2
570 b( k+1,
j ) = d21*t1 + d22*t2