Diff for /rpl/lapack/lapack/zcgesv.f between versions 1.8 and 1.9

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
 *  *

Removed from v.1.8  
changed lines
  Added in v.1.9


CVSweb interface <joel.bertrand@systella.fr>