version 1.5, 2010/12/21 13:53:38
|
version 1.6, 2011/07/22 07:38:11
|
Line 1
|
Line 1
|
SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, |
SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, |
+ SWORK, ITER, INFO ) |
$ SWORK, ITER, INFO ) |
* |
* |
* -- LAPACK PROTOTYPE driver routine (version 3.3.0) -- |
* -- LAPACK PROTOTYPE driver routine (version 3.3.1) -- |
* Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd.. |
* Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd.. |
* November 2010 |
* -- April 2011 -- |
* |
* |
* .. |
* .. |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
Line 13
|
Line 13
|
* .. Array Arguments .. |
* .. Array Arguments .. |
REAL SWORK( * ) |
REAL SWORK( * ) |
DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( N, * ), |
DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( N, * ), |
+ X( LDX, * ) |
$ X( LDX, * ) |
* .. |
* .. |
* |
* |
* Purpose |
* Purpose |
Line 126
|
Line 126
|
* factorization could not be completed, and the solution |
* factorization could not be completed, and the solution |
* has not been computed. |
* has not been computed. |
* |
* |
* ========= |
* ===================================================================== |
* |
* |
* .. Parameters .. |
* .. Parameters .. |
LOGICAL DOITREF |
LOGICAL DOITREF |
Line 147
|
Line 147
|
* |
* |
* .. External Subroutines .. |
* .. External Subroutines .. |
EXTERNAL DAXPY, DSYMM, DLACPY, DLAT2S, DLAG2S, SLAG2D, |
EXTERNAL DAXPY, DSYMM, DLACPY, DLAT2S, DLAG2S, SLAG2D, |
+ SPOTRF, SPOTRS, XERBLA |
$ SPOTRF, SPOTRS, XERBLA |
* .. |
* .. |
* .. External Functions .. |
* .. External Functions .. |
INTEGER IDAMAX |
INTEGER IDAMAX |
Line 186
|
Line 186
|
* Quick return if (N.EQ.0). |
* Quick return if (N.EQ.0). |
* |
* |
IF( N.EQ.0 ) |
IF( N.EQ.0 ) |
+ RETURN |
$ RETURN |
* |
* |
* Skip single precision iterative refinement if a priori slower |
* Skip single precision iterative refinement if a priori slower |
* than double precision factorization. |
* than double precision factorization. |
Line 239
|
Line 239
|
* Solve the system SA*SX = SB. |
* Solve the system SA*SX = SB. |
* |
* |
CALL SPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N, |
CALL SPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N, |
+ INFO ) |
$ INFO ) |
* |
* |
* Convert SX back to double precision |
* Convert SX back to double precision |
* |
* |
Line 250
|
Line 250
|
CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
* |
* |
CALL DSYMM( 'Left', UPLO, N, NRHS, NEGONE, A, LDA, X, LDX, ONE, |
CALL DSYMM( 'Left', UPLO, N, NRHS, NEGONE, A, LDA, X, LDX, ONE, |
+ WORK, N ) |
$ WORK, N ) |
* |
* |
* Check whether the NRHS normwise backward errors satisfy the |
* Check whether the NRHS normwise backward errors satisfy the |
* stopping criterion. If yes, set ITER=0 and return. |
* stopping criterion. If yes, set ITER=0 and return. |
Line 259
|
Line 259
|
XNRM = ABS( X( IDAMAX( N, X( 1, I ), 1 ), I ) ) |
XNRM = ABS( X( IDAMAX( N, X( 1, I ), 1 ), I ) ) |
RNRM = ABS( WORK( IDAMAX( N, WORK( 1, I ), 1 ), I ) ) |
RNRM = ABS( WORK( IDAMAX( N, WORK( 1, I ), 1 ), I ) ) |
IF( RNRM.GT.XNRM*CTE ) |
IF( RNRM.GT.XNRM*CTE ) |
+ GO TO 10 |
$ GO TO 10 |
END DO |
END DO |
* |
* |
* If we are here, the NRHS normwise backward errors satisfy the |
* If we are here, the NRHS normwise backward errors satisfy the |
Line 285
|
Line 285
|
* Solve the system SA*SX = SR. |
* Solve the system SA*SX = SR. |
* |
* |
CALL SPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N, |
CALL SPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N, |
+ INFO ) |
$ INFO ) |
* |
* |
* Convert SX back to double precision and update the current |
* Convert SX back to double precision and update the current |
* iterate. |
* iterate. |
Line 301
|
Line 301
|
CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
* |
* |
CALL DSYMM( 'L', UPLO, N, NRHS, NEGONE, A, LDA, X, LDX, ONE, |
CALL DSYMM( 'L', UPLO, N, NRHS, NEGONE, A, LDA, X, LDX, ONE, |
+ WORK, N ) |
$ WORK, N ) |
* |
* |
* Check whether the NRHS normwise backward errors satisfy the |
* Check whether the NRHS normwise backward errors satisfy the |
* stopping criterion. If yes, set ITER=IITER>0 and return. |
* stopping criterion. If yes, set ITER=IITER>0 and return. |
Line 310
|
Line 310
|
XNRM = ABS( X( IDAMAX( N, X( 1, I ), 1 ), I ) ) |
XNRM = ABS( X( IDAMAX( N, X( 1, I ), 1 ), I ) ) |
RNRM = ABS( WORK( IDAMAX( N, WORK( 1, I ), 1 ), I ) ) |
RNRM = ABS( WORK( IDAMAX( N, WORK( 1, I ), 1 ), I ) ) |
IF( RNRM.GT.XNRM*CTE ) |
IF( RNRM.GT.XNRM*CTE ) |
+ GO TO 20 |
$ GO TO 20 |
END DO |
END DO |
* |
* |
* If we are here, the NRHS normwise backward errors satisfy the |
* If we are here, the NRHS normwise backward errors satisfy the |
Line 339
|
Line 339
|
CALL DPOTRF( UPLO, N, A, LDA, INFO ) |
CALL DPOTRF( UPLO, N, A, LDA, INFO ) |
* |
* |
IF( INFO.NE.0 ) |
IF( INFO.NE.0 ) |
+ RETURN |
$ RETURN |
* |
* |
CALL DLACPY( 'All', N, NRHS, B, LDB, X, LDX ) |
CALL DLACPY( 'All', N, NRHS, B, LDB, X, LDX ) |
CALL DPOTRS( UPLO, N, NRHS, A, LDA, X, LDX, INFO ) |
CALL DPOTRS( UPLO, N, NRHS, A, LDA, X, LDX, INFO ) |