161 CHARACTER DIAG, TRANS, UPLO
162 INTEGER INFO, LDA, LDB, N, NRHS
166 COMPLEX*16 A( LDA, * ), B( LDB, * )
173 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
178 COMPLEX*16 D11, D12, D21, D22, T1, T2
195 IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
197 ELSE IF( .NOT.lsame( trans,
'N' ) .AND. .NOT.lsame( trans,
'T' ) )
200 ELSE IF( .NOT.lsame( diag,
'U' ) .AND. .NOT.lsame( diag,
'N' ) )
203 ELSE IF( n.LT.0 )
THEN
205 ELSE IF( lda.LT.max( 1, n ) )
THEN
207 ELSE IF( ldb.LT.max( 1, n ) )
THEN
211 CALL xerbla(
'ZLAVSY_ROOK ', -info )
220 nounit = lsame( diag,
'N' )
226 IF( lsame( trans,
'N' ) )
THEN
231 IF( lsame( uplo,
'U' ) )
THEN
239 IF( ipiv( k ).GT.0 )
THEN
246 $
CALL zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
254 CALL zgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
255 $ ldb, b( 1, 1 ), ldb )
261 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
278 b( k, j ) = d11*t1 + d12*t2
279 b( k+1, j ) = d21*t1 + d22*t2
289 CALL zgeru( k-1, nrhs, cone, a( 1, k ), 1, b( k, 1 ),
290 $ ldb, b( 1, 1 ), ldb )
291 CALL zgeru( k-1, nrhs, cone, a( 1, k+1 ), 1,
292 $ b( k+1, 1 ), ldb, b( 1, 1 ), ldb )
299 kp = abs( ipiv( k ) )
301 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
305 kp = abs( ipiv( k+1 ) )
307 $
CALL zswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
330 IF( ipiv( k ).GT.0 )
THEN
337 $
CALL zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
346 CALL zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
347 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
353 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
371 b( k-1, j ) = d11*t1 + d12*t2
372 b( k, j ) = d21*t1 + d22*t2
382 CALL zgeru( n-k, nrhs, cone, a( k+1, k ), 1,
383 $ b( k, 1 ), ldb, b( k+1, 1 ), ldb )
384 CALL zgeru( n-k, nrhs, cone, a( k+1, k-1 ), 1,
385 $ b( k-1, 1 ), ldb, b( k+1, 1 ), ldb )
392 kp = abs( ipiv( k ) )
394 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
398 kp = abs( ipiv( k-1 ) )
400 $
CALL zswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
413 ELSE IF( lsame( trans,
'T' ) )
THEN
419 IF( lsame( uplo,
'U' ) )
THEN
430 IF( ipiv( k ).GT.0 )
THEN
437 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
441 CALL zgemv(
'Transpose', k-1, nrhs, cone, b, ldb,
442 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
445 $
CALL zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
455 kp = abs( ipiv( k ) )
457 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
461 kp = abs( ipiv( k-1 ) )
463 $
CALL zswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ),
468 CALL zgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
469 $ a( 1, k ), 1, cone, b( k, 1 ), ldb )
470 CALL zgemv(
'Transpose', k-2, nrhs, cone, b, ldb,
471 $ a( 1, k-1 ), 1, cone, b( k-1, 1 ), ldb )
484 b( k-1, j ) = d11*t1 + d12*t2
485 b( k, j ) = d21*t1 + d22*t2
508 IF( ipiv( k ).GT.0 )
THEN
515 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
519 CALL zgemv(
'Transpose', n-k, nrhs, cone, b( k+1, 1 ),
520 $ ldb, a( k+1, k ), 1, cone, b( k, 1 ), ldb )
523 $
CALL zscal( nrhs, a( k, k ), b( k, 1 ), ldb )
533 kp = abs( ipiv( k ) )
535 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
539 kp = abs( ipiv( k+1 ) )
541 $
CALL zswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ),
546 CALL zgemv(
'Transpose', n-k-1, nrhs, cone,
547 $ b( k+2, 1 ), ldb, a( k+2, k+1 ), 1, cone,
549 CALL zgemv(
'Transpose', n-k-1, nrhs, cone,
550 $ b( k+2, 1 ), ldb, a( k+2, k ), 1, cone,
564 b( k, j ) = d11*t1 + d12*t2
565 b( k+1, j ) = d21*t1 + d22*t2