version 1.8, 2010/12/21 13:53:42
|
version 1.9, 2011/07/22 07:38:13
|
Line 1
|
Line 1
|
SUBROUTINE ZCGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, |
SUBROUTINE ZCGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, |
+ SWORK, RWORK, ITER, INFO ) |
$ SWORK, RWORK, ITER, INFO ) |
* |
* |
* -- LAPACK PROTOTYPE driver routine (version 3.2.2) -- |
* -- LAPACK PROTOTYPE driver routine (version 3.3.1) -- |
* -- 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..-- |
* January 2007 |
* -- April 2011 -- |
* |
* |
* .. |
* .. |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
Line 15
|
Line 15
|
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 125
|
Line 125
|
* factor U is exactly singular, so the solution |
* factor U is exactly singular, so the solution |
* could not be computed. |
* could not be computed. |
* |
* |
* ========= |
* ===================================================================== |
* |
* |
* .. Parameters .. |
* .. Parameters .. |
LOGICAL DOITREF |
LOGICAL DOITREF |
Line 139
|
Line 139
|
* |
* |
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 148
|
Line 148
|
* |
* |
* .. External Subroutines .. |
* .. External Subroutines .. |
EXTERNAL CGETRS, CGETRF, CLAG2Z, XERBLA, ZAXPY, ZGEMM, |
EXTERNAL CGETRS, CGETRF, CLAG2Z, XERBLA, ZAXPY, ZGEMM, |
+ ZLACPY, ZLAG2C |
$ ZLACPY, ZLAG2C |
* .. |
* .. |
* .. External Functions .. |
* .. External Functions .. |
INTEGER IZAMAX |
INTEGER IZAMAX |
Line 190
|
Line 190
|
* 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 243
|
Line 243
|
* Solve the system SA*SX = SB. |
* Solve the system SA*SX = SB. |
* |
* |
CALL CGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, IPIV, |
CALL CGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, IPIV, |
+ SWORK( PTSX ), N, INFO ) |
$ SWORK( PTSX ), N, INFO ) |
* |
* |
* Convert SX back to double precision |
* Convert SX back to double precision |
* |
* |
Line 254
|
Line 254
|
CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
* |
* |
CALL ZGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, A, |
CALL ZGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, A, |
+ LDA, X, LDX, ONE, WORK, N ) |
$ LDA, X, LDX, ONE, 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 263
|
Line 263
|
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 289
|
Line 289
|
* Solve the system SA*SX = SR. |
* Solve the system SA*SX = SR. |
* |
* |
CALL CGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, IPIV, |
CALL CGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, IPIV, |
+ SWORK( PTSX ), N, INFO ) |
$ SWORK( PTSX ), N, INFO ) |
* |
* |
* Convert SX back to double precision and update the current |
* Convert SX back to double precision and update the current |
* iterate. |
* iterate. |
Line 305
|
Line 305
|
CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) |
* |
* |
CALL ZGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, |
CALL ZGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, |
+ A, LDA, X, LDX, ONE, WORK, N ) |
$ A, LDA, X, LDX, ONE, 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 314
|
Line 314
|
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 343
|
Line 343
|
CALL ZGETRF( N, N, A, LDA, IPIV, INFO ) |
CALL ZGETRF( N, N, A, LDA, IPIV, 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 ZGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, X, LDX, |
CALL ZGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, X, LDX, |
+ INFO ) |
$ INFO ) |
* |
* |
RETURN |
RETURN |
* |
* |