153 SUBROUTINE zlavsy( UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B,
162 CHARACTER DIAG, TRANS, UPLO
163 INTEGER INFO, LDA, LDB, N, NRHS
167 COMPLEX*16 A( lda, * ), B( ldb, * )
174 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
179 COMPLEX*16 D11, D12, D21, D22, T1, T2
196 IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
198 ELSE IF( .NOT.lsame( trans,
'N' ) .AND. .NOT.lsame( trans,
'T' ) )
201 ELSE IF( .NOT.lsame( diag,
'U' ) .AND. .NOT.lsame( diag,
'N' ) )
204 ELSE IF( n.LT.0 )
THEN
206 ELSE IF( lda.LT.max( 1, n ) )
THEN
208 ELSE IF( ldb.LT.max( 1, n ) )
THEN
212 CALL
xerbla(
'ZLAVSY ', -info )
221 nounit = lsame( diag,
'N' )
227 IF( lsame( trans,
'N' ) )
THEN
232 IF( lsame( uplo,
'U' ) )
THEN
240 IF( ipiv( k ).GT.0 )
THEN
247 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
255 CALL
zgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
256 $ ldb, b( 1, 1 ), ldb )
262 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
279 b( k, j ) = d11*t1 + d12*t2
280 b( k+1, j ) = d21*t1 + d22*t2
290 CALL
zgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
291 $ ldb, b( 1, 1 ), ldb )
292 CALL
zgeru( k-1, nrhs, cone, a( 1, k+1 ), 1,
293 $ b( k+1, 1 ), ldb, b( 1, 1 ), ldb )
297 kp = abs( ipiv( k ) )
299 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
321 IF( ipiv( k ).GT.0 )
THEN
328 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
337 CALL
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
338 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
344 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
362 b( k-1, j ) = d11*t1 + d12*t2
363 b( k, j ) = d21*t1 + d22*t2
373 CALL
zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
374 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
375 CALL
zgeru( n-k, nrhs, cone, a( k+1, k-1 ), 1,
376 $ b( k-1, 1 ), ldb, b( k+1, 1 ), ldb )
381 kp = abs( ipiv( k ) )
383 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
395 ELSE IF( lsame( trans,
'T' ) )
THEN
401 IF( lsame( uplo,
'U' ) )
THEN
412 IF( ipiv( k ).GT.0 )
THEN
419 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
423 CALL
zgemv(
'Transpose', k-1, nrhs, cone, b, ldb,
424 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
427 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
437 kp = abs( ipiv( k ) )
439 $ CALL zswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
444 CALL
zgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
445 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
446 CALL
zgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
447 $ a( 1, k-1 ), 1, cone, b( k-1, 1 ), ldb )
460 b( k-1, j ) = d11*t1 + d12*t2
461 b( k, j ) = d21*t1 + d22*t2
484 IF( ipiv( k ).GT.0 )
THEN
491 $ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
495 CALL
zgemv(
'Transpose', n-k, nrhs, cone, b( k+1, 1 ),
496 $ ldb, a( k+1, k ), 1, cone, b( k, 1 ), ldb )
499 $ CALL
zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
509 kp = abs( ipiv( k ) )
511 $ CALL zswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
516 CALL
zgemv(
'Transpose', n-k-1, nrhs, cone,
517 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
519 CALL
zgemv(
'Transpose', n-k-1, nrhs, cone,
520 $ b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
534 b( k, j ) = d11*t1 + d12*t2
535 b( k+1, j ) = d21*t1 + d22*t2
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zlavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVSY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
subroutine zgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERU