199 SUBROUTINE dsposv( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK,
200 $ swork, iter, info )
209 INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS
213 DOUBLE PRECISION A( lda, * ), B( ldb, * ), WORK( n, * ),
221 parameter( doitref = .true. )
224 parameter( itermax = 30 )
226 DOUBLE PRECISION BWDMAX
227 parameter( bwdmax = 1.0e+00 )
229 DOUBLE PRECISION NEGONE, ONE
230 parameter( negone = -1.0d+0, one = 1.0d+0 )
233 INTEGER I, IITER, PTSA, PTSX
234 DOUBLE PRECISION ANRM, CTE, EPS, RNRM, XNRM
242 DOUBLE PRECISION DLAMCH, DLANSY
244 EXTERNAL idamax, dlamch, dlansy, lsame
247 INTRINSIC abs, dble, max, sqrt
256 IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
258 ELSE IF( n.LT.0 )
THEN
260 ELSE IF( nrhs.LT.0 )
THEN
262 ELSE IF( lda.LT.max( 1, n ) )
THEN
264 ELSE IF( ldb.LT.max( 1, n ) )
THEN
266 ELSE IF( ldx.LT.max( 1, n ) )
THEN
270 CALL
xerbla(
'DSPOSV', -info )
282 IF( .NOT.doitref )
THEN
289 anrm = dlansy(
'I', uplo, n, a, lda, work )
290 eps = dlamch(
'Epsilon' )
291 cte = anrm*eps*sqrt( dble( n ) )*bwdmax
301 CALL
dlag2s( n, nrhs, b, ldb, swork( ptsx ), n, info )
311 CALL
dlat2s( uplo, n, a, lda, swork( ptsa ), n, info )
320 CALL
spotrf( uplo, n, swork( ptsa ), n, info )
329 CALL
spotrs( uplo, n, nrhs, swork( ptsa ), n, swork( ptsx ), n,
334 CALL
slag2d( n, nrhs, swork( ptsx ), n, x, ldx, info )
338 CALL
dlacpy(
'All', n, nrhs, b, ldb, work, n )
340 CALL
dsymm(
'Left', uplo, n, nrhs, negone, a, lda, x, ldx, one,
347 xnrm = abs( x( idamax( n, x( 1, i ), 1 ), i ) )
348 rnrm = abs( work( idamax( n, work( 1, i ), 1 ), i ) )
349 IF( rnrm.GT.xnrm*cte )
361 DO 30 iiter = 1, itermax
366 CALL
dlag2s( n, nrhs, work, n, swork( ptsx ), n, info )
375 CALL
spotrs( uplo, n, nrhs, swork( ptsa ), n, swork( ptsx ), n,
381 CALL
slag2d( n, nrhs, swork( ptsx ), n, work, n, info )
384 CALL
daxpy( n, one, work( 1, i ), 1, x( 1, i ), 1 )
389 CALL
dlacpy(
'All', n, nrhs, b, ldb, work, n )
391 CALL
dsymm(
'L', uplo, n, nrhs, negone, a, lda, x, ldx, one,
398 xnrm = abs( x( idamax( n, x( 1, i ), 1 ), i ) )
399 rnrm = abs( work( idamax( n, work( 1, i ), 1 ), i ) )
400 IF( rnrm.GT.xnrm*cte )
427 CALL
dpotrf( uplo, n, a, lda, info )
432 CALL
dlacpy(
'All', n, nrhs, b, ldb, x, ldx )
433 CALL
dpotrs( uplo, n, nrhs, a, lda, x, ldx, info )
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOTRS
subroutine dlag2s(M, N, A, LDA, SA, LDSA, INFO)
DLAG2S converts a double precision matrix to a single precision matrix.
subroutine dsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DSYMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slag2d(M, N, SA, LDSA, A, LDA, INFO)
SLAG2D converts a single precision matrix to a double precision matrix.
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine spotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOTRS
subroutine dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
subroutine dlat2s(UPLO, N, A, LDA, SA, LDSA, INFO)
DLAT2S converts a double-precision triangular matrix to a single-precision triangular matrix...
subroutine dsposv(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, SWORK, ITER, INFO)
DSPOSV computes the solution to system of linear equations A * X = B for PO matrices ...