165 SUBROUTINE dsytrs_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
175 INTEGER INFO, LDA, LDB, N, NRHS
179 DOUBLE PRECISION A( lda, * ), B( ldb, * ), E( * )
186 parameter ( one = 1.0d+0 )
191 DOUBLE PRECISION AK, AKM1, AKM1K, BK, BKM1, DENOM
206 upper = lsame( uplo,
'U' )
207 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
209 ELSE IF( n.LT.0 )
THEN
211 ELSE IF( nrhs.LT.0 )
THEN
213 ELSE IF( lda.LT.max( 1, n ) )
THEN
215 ELSE IF( ldb.LT.max( 1, n ) )
THEN
219 CALL xerbla(
'DSYTRS_3', -info )
225 IF( n.EQ.0 .OR. nrhs.EQ.0 )
244 kp = abs( ipiv( k ) )
246 CALL dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
252 CALL dtrsm(
'L',
'U',
'N',
'U', n, nrhs, one, a, lda, b, ldb )
258 IF( ipiv( i ).GT.0 )
THEN
259 CALL dscal( nrhs, one / a( i, i ), b( i, 1 ), ldb )
260 ELSE IF ( i.GT.1 )
THEN
262 akm1 = a( i-1, i-1 ) / akm1k
263 ak = a( i, i ) / akm1k
264 denom = akm1*ak - one
266 bkm1 = b( i-1, j ) / akm1k
267 bk = b( i, j ) / akm1k
268 b( i-1, j ) = ( ak*bkm1-bk ) / denom
269 b( i, j ) = ( akm1*bk-bkm1 ) / denom
278 CALL dtrsm(
'L',
'U',
'T',
'U', n, nrhs, one, a, lda, b, ldb )
290 kp = abs( ipiv( k ) )
292 CALL dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
311 kp = abs( ipiv( k ) )
313 CALL dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
319 CALL dtrsm(
'L',
'L',
'N',
'U', n, nrhs, one, a, lda, b, ldb )
325 IF( ipiv( i ).GT.0 )
THEN
326 CALL dscal( nrhs, one / a( i, i ), b( i, 1 ), ldb )
327 ELSE IF( i.LT.n )
THEN
329 akm1 = a( i, i ) / akm1k
330 ak = a( i+1, i+1 ) / akm1k
331 denom = akm1*ak - one
333 bkm1 = b( i, j ) / akm1k
334 bk = b( i+1, j ) / akm1k
335 b( i, j ) = ( ak*bkm1-bk ) / denom
336 b( i+1, j ) = ( akm1*bk-bkm1 ) / denom
345 CALL dtrsm(
'L',
'L',
'T',
'U', n, nrhs, one, a, lda, b, ldb )
357 kp = abs( ipiv( k ) )
359 CALL dswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dsytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
DSYTRS_3