|
version 1.5, 2010/12/21 13:53:42
|
version 1.6, 2011/07/22 07:38:13
|
|
Line 1
|
Line 1
|
| SUBROUTINE ZCPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, |
SUBROUTINE ZCPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, |
| + SWORK, RWORK, ITER, INFO ) |
$ SWORK, RWORK, ITER, INFO ) |
| * |
* |
| * -- LAPACK PROTOTYPE driver routine (version 3.3.0) -- |
* -- LAPACK PROTOTYPE driver routine (version 3.3.1) -- |
| * |
* |
| * November 2010 |
* -- April 2011 -- |
| * |
* |
| * -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
| * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
|
Line 16
|
Line 16
|
| DOUBLE PRECISION RWORK( * ) |
DOUBLE PRECISION RWORK( * ) |
| COMPLEX SWORK( * ) |
COMPLEX SWORK( * ) |
| COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( N, * ), |
COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( N, * ), |
| + X( LDX, * ) |
$ X( LDX, * ) |
| * .. |
* .. |
| * |
* |
| * Purpose |
* Purpose |
|
Line 134
|
Line 134
|
| * 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 148
|
Line 148
|
| * |
* |
| COMPLEX*16 NEGONE, ONE |
COMPLEX*16 NEGONE, ONE |
| PARAMETER ( NEGONE = ( -1.0D+00, 0.0D+00 ), |
PARAMETER ( NEGONE = ( -1.0D+00, 0.0D+00 ), |
| + ONE = ( 1.0D+00, 0.0D+00 ) ) |
$ ONE = ( 1.0D+00, 0.0D+00 ) ) |
| * |
* |
| * .. Local Scalars .. |
* .. Local Scalars .. |
| INTEGER I, IITER, PTSA, PTSX |
INTEGER I, IITER, PTSA, PTSX |
|
Line 157
|
Line 157
|
| * |
* |
| * .. External Subroutines .. |
* .. External Subroutines .. |
| EXTERNAL ZAXPY, ZHEMM, ZLACPY, ZLAT2C, ZLAG2C, CLAG2Z, |
EXTERNAL ZAXPY, ZHEMM, ZLACPY, ZLAT2C, ZLAG2C, CLAG2Z, |
| + CPOTRF, CPOTRS, XERBLA |
$ CPOTRF, CPOTRS, XERBLA |
| * .. |
* .. |
| * .. External Functions .. |
* .. External Functions .. |
| INTEGER IZAMAX |
INTEGER IZAMAX |
|
Line 201
|
Line 201
|
| * 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 254
|
Line 254
|
| * Solve the system SA*SX = SB. |
* Solve the system SA*SX = SB. |
| * |
* |
| CALL CPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N, |
CALL CPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N, |
| + INFO ) |
$ INFO ) |
| * |
* |
| * Convert SX back to COMPLEX*16 |
* Convert SX back to COMPLEX*16 |
| * |
* |
|
Line 265
|
Line 265
|
| CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
| * |
* |
| CALL ZHEMM( 'Left', UPLO, N, NRHS, NEGONE, A, LDA, X, LDX, ONE, |
CALL ZHEMM( '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 274
|
Line 274
|
| XNRM = CABS1( X( IZAMAX( N, X( 1, I ), 1 ), I ) ) |
XNRM = CABS1( X( IZAMAX( N, X( 1, I ), 1 ), I ) ) |
| RNRM = CABS1( WORK( IZAMAX( N, WORK( 1, I ), 1 ), I ) ) |
RNRM = CABS1( WORK( IZAMAX( 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 300
|
Line 300
|
| * Solve the system SA*SX = SR. |
* Solve the system SA*SX = SR. |
| * |
* |
| CALL CPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N, |
CALL CPOTRS( 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 316
|
Line 316
|
| CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
| * |
* |
| CALL ZHEMM( 'L', UPLO, N, NRHS, NEGONE, A, LDA, X, LDX, ONE, |
CALL ZHEMM( '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 325
|
Line 325
|
| XNRM = CABS1( X( IZAMAX( N, X( 1, I ), 1 ), I ) ) |
XNRM = CABS1( X( IZAMAX( N, X( 1, I ), 1 ), I ) ) |
| RNRM = CABS1( WORK( IZAMAX( N, WORK( 1, I ), 1 ), I ) ) |
RNRM = CABS1( WORK( IZAMAX( 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 354
|
Line 354
|
| CALL ZPOTRF( UPLO, N, A, LDA, INFO ) |
CALL ZPOTRF( UPLO, N, A, LDA, INFO ) |
| * |
* |
| IF( INFO.NE.0 ) |
IF( INFO.NE.0 ) |
| + RETURN |
$ RETURN |
| * |
* |
| CALL ZLACPY( 'All', N, NRHS, B, LDB, X, LDX ) |
CALL ZLACPY( 'All', N, NRHS, B, LDB, X, LDX ) |
| CALL ZPOTRS( UPLO, N, NRHS, A, LDA, X, LDX, INFO ) |
CALL ZPOTRS( UPLO, N, NRHS, A, LDA, X, LDX, INFO ) |
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zcposv.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack