164 CHARACTER DIAG, TRANS, UPLO
165 INTEGER INFO, LDA, LDB, N, NRHS
169 COMPLEX*16 A( lda, * ), B( ldb, * )
176 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
181 COMPLEX*16 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(
'ZLAVSY_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
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
257 CALL
zgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
258 $ ldb, b( 1, 1 ), ldb )
264 $ CALL zswap( 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
zgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
293 $ ldb, b( 1, 1 ), ldb )
294 CALL
zgeru( 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 zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
308 kp = abs( ipiv( k+1 ) )
310 $ CALL zswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
333 IF( ipiv( k ).GT.0 )
THEN
340 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
349 CALL
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
350 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
356 $ CALL zswap( 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
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
386 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
387 CALL
zgeru( 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 zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
401 kp = abs( ipiv( k-1 ) )
403 $ CALL zswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
416 ELSE IF( lsame( trans,
'T' ) )
THEN
422 IF( lsame( uplo,
'U' ) )
THEN
433 IF( ipiv( k ).GT.0 )
THEN
440 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
444 CALL
zgemv(
'Transpose', k-1, nrhs, cone, b, ldb,
445 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
448 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
458 kp = abs( ipiv( k ) )
460 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
464 kp = abs( ipiv( k-1 ) )
466 $ CALL zswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
471 CALL
zgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
472 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
473 CALL
zgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
474 $ a( 1, k-1 ), 1, cone, b( k-1, 1 ), ldb )
487 b( k-1, j ) = d11*t1 + d12*t2
488 b( k, j ) = d21*t1 + d22*t2
511 IF( ipiv( k ).GT.0 )
THEN
518 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
522 CALL
zgemv(
'Transpose', n-k, nrhs, cone, b( k+1, 1 ),
523 $ ldb, a( k+1, k ), 1, cone, b( k, 1 ), ldb )
526 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
536 kp = abs( ipiv( k ) )
538 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
542 kp = abs( ipiv( k+1 ) )
544 $ CALL zswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
549 CALL
zgemv(
'Transpose', n-k-1, nrhs, cone,
550 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
552 CALL
zgemv(
'Transpose', n-k-1, nrhs, cone,
553 $ b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
567 b( k, j ) = d11*t1 + d12*t2
568 b( k+1, j ) = d21*t1 + d22*t2
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlavsy_rook(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVSY_ROOK
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
subroutine zgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERU