132 SUBROUTINE zsytrs2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
142 INTEGER INFO, LDA, LDB, N, NRHS
146 COMPLEX*16 A( lda, * ), B( ldb, * ), WORK( * )
153 parameter ( one = (1.0d+0,0.0d+0) )
157 INTEGER I, IINFO, J, K, KP
158 COMPLEX*16 AK, AKM1, AKM1K, BK, BKM1, DENOM
173 upper = lsame( uplo,
'U' )
174 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
176 ELSE IF( n.LT.0 )
THEN
178 ELSE IF( nrhs.LT.0 )
THEN
180 ELSE IF( lda.LT.max( 1, n ) )
THEN
182 ELSE IF( ldb.LT.max( 1, n ) )
THEN
186 CALL xerbla(
'ZSYTRS2', -info )
192 IF( n.EQ.0 .OR. nrhs.EQ.0 )
197 CALL zsyconv( uplo,
'C', n, a, lda, ipiv, work, iinfo )
205 DO WHILE ( k .GE. 1 )
206 IF( ipiv( k ).GT.0 )
THEN
211 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
217 IF( kp.EQ.-ipiv( k-1 ) )
218 $
CALL zswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ), ldb )
225 CALL ztrsm(
'L',
'U',
'N',
'U',n,nrhs,one,a,lda,b,ldb)
230 DO WHILE ( i .GE. 1 )
231 IF( ipiv(i) .GT. 0 )
THEN
232 CALL zscal( nrhs, one / a( i, i ), b( i, 1 ), ldb )
233 ELSEIF ( i .GT. 1)
THEN
234 IF ( ipiv(i-1) .EQ. ipiv(i) )
THEN
236 akm1 = a( i-1, i-1 ) / akm1k
237 ak = a( i, i ) / akm1k
238 denom = akm1*ak - one
240 bkm1 = b( i-1, j ) / akm1k
241 bk = b( i, j ) / akm1k
242 b( i-1, j ) = ( ak*bkm1-bk ) / denom
243 b( i, j ) = ( akm1*bk-bkm1 ) / denom
253 CALL ztrsm(
'L',
'U',
'T',
'U',n,nrhs,one,a,lda,b,ldb)
258 DO WHILE ( k .LE. n )
259 IF( ipiv( k ).GT.0 )
THEN
264 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
270 IF( k .LT. n .AND. kp.EQ.-ipiv( k+1 ) )
271 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
282 DO WHILE ( k .LE. n )
283 IF( ipiv( k ).GT.0 )
THEN
288 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
294 IF( kp.EQ.-ipiv( k ) )
295 $
CALL zswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ), ldb )
302 CALL ztrsm(
'L',
'L',
'N',
'U',n,nrhs,one,a,lda,b,ldb)
307 DO WHILE ( i .LE. n )
308 IF( ipiv(i) .GT. 0 )
THEN
309 CALL zscal( nrhs, one / a( i, i ), b( i, 1 ), ldb )
312 akm1 = a( i, i ) / akm1k
313 ak = a( i+1, i+1 ) / akm1k
314 denom = akm1*ak - one
316 bkm1 = b( i, j ) / akm1k
317 bk = b( i+1, j ) / akm1k
318 b( i, j ) = ( ak*bkm1-bk ) / denom
319 b( i+1, j ) = ( akm1*bk-bkm1 ) / denom
328 CALL ztrsm(
'L',
'L',
'T',
'U',n,nrhs,one,a,lda,b,ldb)
333 DO WHILE ( k .GE. 1 )
334 IF( ipiv( k ).GT.0 )
THEN
339 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
345 IF( k.GT.1 .AND. kp.EQ.-ipiv( k-1 ) )
346 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
355 CALL zsyconv( uplo,
'R', n, a, lda, ipiv, work, iinfo )
subroutine zsyconv(UPLO, WAY, N, A, LDA, IPIV, E, INFO)
ZSYCONV
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zsytrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
ZSYTRS2
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL