zgesvx.f.html

来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 506 行 · 第 1/3 页

            ELSE
               ROWCND = ONE
            END IF
         END IF
         IF( COLEQU .AND. INFO.EQ.0 ) THEN
            RCMIN = BIGNUM
            RCMAX = ZERO
            DO 20 J = 1, N
               RCMIN = MIN( RCMIN, C( J ) )
               RCMAX = MAX( RCMAX, C( J ) )
   20       CONTINUE
            IF( RCMIN.LE.ZERO ) THEN
               INFO = -12
            ELSE IF( N.GT.0 ) THEN
               COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
            ELSE
               COLCND = ONE
            END IF
         END IF
         IF( INFO.EQ.0 ) THEN
            IF( LDB.LT.MAX( 1, N ) ) THEN
               INFO = -14
            ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
               INFO = -16
            END IF
         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( INFO.NE.0 ) THEN
         CALL <a name="XERBLA.349"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="ZGESVX.349"></a><a href="zgesvx.f.html#ZGESVX.1">ZGESVX</a>'</span>, -INFO )
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( EQUIL ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Compute row and column scalings to equilibrate the matrix A.
</span><span class="comment">*</span><span class="comment">
</span>         CALL <a name="ZGEEQU.357"></a><a href="zgeequ.f.html#ZGEEQU.1">ZGEEQU</a>( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU )
         IF( INFEQU.EQ.0 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Equilibrate the matrix.
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="ZLAQGE.362"></a><a href="zlaqge.f.html#ZLAQGE.1">ZLAQGE</a>( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
     $                   EQUED )
            ROWEQU = <a name="LSAME.364"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( EQUED, <span class="string">'R'</span> ) .OR. <a name="LSAME.364"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( EQUED, <span class="string">'B'</span> )
            COLEQU = <a name="LSAME.365"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( EQUED, <span class="string">'C'</span> ) .OR. <a name="LSAME.365"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( EQUED, <span class="string">'B'</span> )
         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Scale the right hand side.
</span><span class="comment">*</span><span class="comment">
</span>      IF( NOTRAN ) THEN
         IF( ROWEQU ) THEN
            DO 40 J = 1, NRHS
               DO 30 I = 1, N
                  B( I, J ) = R( I )*B( I, J )
   30          CONTINUE
   40       CONTINUE
         END IF
      ELSE IF( COLEQU ) THEN
         DO 60 J = 1, NRHS
            DO 50 I = 1, N
               B( I, J ) = C( I )*B( I, J )
   50       CONTINUE
   60    CONTINUE
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( NOFACT .OR. EQUIL ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Compute the LU factorization of A.
</span><span class="comment">*</span><span class="comment">
</span>         CALL <a name="ZLACPY.391"></a><a href="zlacpy.f.html#ZLACPY.1">ZLACPY</a>( <span class="string">'Full'</span>, N, N, A, LDA, AF, LDAF )
         CALL <a name="ZGETRF.392"></a><a href="zgetrf.f.html#ZGETRF.1">ZGETRF</a>( N, N, AF, LDAF, IPIV, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Return if INFO is non-zero.
</span><span class="comment">*</span><span class="comment">
</span>         IF( INFO.GT.0 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Compute the reciprocal pivot growth factor of the
</span><span class="comment">*</span><span class="comment">           leading rank-deficient INFO columns of A.
</span><span class="comment">*</span><span class="comment">
</span>            RPVGRW = <a name="ZLANTR.401"></a><a href="zlantr.f.html#ZLANTR.1">ZLANTR</a>( <span class="string">'M'</span>, <span class="string">'U'</span>, <span class="string">'N'</span>, INFO, INFO, AF, LDAF,
     $               RWORK )
            IF( RPVGRW.EQ.ZERO ) THEN
               RPVGRW = ONE
            ELSE
               RPVGRW = <a name="ZLANGE.406"></a><a href="zlange.f.html#ZLANGE.1">ZLANGE</a>( <span class="string">'M'</span>, N, INFO, A, LDA, RWORK ) /
     $                  RPVGRW
            END IF
            RWORK( 1 ) = RPVGRW
            RCOND = ZERO
            RETURN
         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Compute the norm of the matrix A and the
</span><span class="comment">*</span><span class="comment">     reciprocal pivot growth factor RPVGRW.
</span><span class="comment">*</span><span class="comment">
</span>      IF( NOTRAN ) THEN
         NORM = <span class="string">'1'</span>
      ELSE
         NORM = <span class="string">'I'</span>
      END IF
      ANORM = <a name="ZLANGE.423"></a><a href="zlange.f.html#ZLANGE.1">ZLANGE</a>( NORM, N, N, A, LDA, RWORK )
      RPVGRW = <a name="ZLANTR.424"></a><a href="zlantr.f.html#ZLANTR.1">ZLANTR</a>( <span class="string">'M'</span>, <span class="string">'U'</span>, <span class="string">'N'</span>, N, N, AF, LDAF, RWORK )
      IF( RPVGRW.EQ.ZERO ) THEN
         RPVGRW = ONE
      ELSE
         RPVGRW = <a name="ZLANGE.428"></a><a href="zlange.f.html#ZLANGE.1">ZLANGE</a>( <span class="string">'M'</span>, N, N, A, LDA, RWORK ) / RPVGRW
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Compute the reciprocal of the condition number of A.
</span><span class="comment">*</span><span class="comment">
</span>      CALL <a name="ZGECON.433"></a><a href="zgecon.f.html#ZGECON.1">ZGECON</a>( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Compute the solution matrix X.
</span><span class="comment">*</span><span class="comment">
</span>      CALL <a name="ZLACPY.437"></a><a href="zlacpy.f.html#ZLACPY.1">ZLACPY</a>( <span class="string">'Full'</span>, N, NRHS, B, LDB, X, LDX )
      CALL <a name="ZGETRS.438"></a><a href="zgetrs.f.html#ZGETRS.1">ZGETRS</a>( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Use iterative refinement to improve the computed solution and
</span><span class="comment">*</span><span class="comment">     compute error bounds and backward error estimates for it.
</span><span class="comment">*</span><span class="comment">
</span>      CALL <a name="ZGERFS.443"></a><a href="zgerfs.f.html#ZGERFS.1">ZGERFS</a>( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X,
     $             LDX, FERR, BERR, WORK, RWORK, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Transform the solution matrix X to a solution of the original
</span><span class="comment">*</span><span class="comment">     system.
</span><span class="comment">*</span><span class="comment">
</span>      IF( NOTRAN ) THEN
         IF( COLEQU ) THEN
            DO 80 J = 1, NRHS
               DO 70 I = 1, N
                  X( I, J ) = C( I )*X( I, J )
   70          CONTINUE
   80       CONTINUE
            DO 90 J = 1, NRHS
               FERR( J ) = FERR( J ) / COLCND
   90       CONTINUE
         END IF
      ELSE IF( ROWEQU ) THEN
         DO 110 J = 1, NRHS
            DO 100 I = 1, N
               X( I, J ) = R( I )*X( I, J )
  100       CONTINUE
  110    CONTINUE
         DO 120 J = 1, NRHS
            FERR( J ) = FERR( J ) / ROWCND
  120    CONTINUE
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Set INFO = N+1 if the matrix is singular to working precision.
</span><span class="comment">*</span><span class="comment">
</span>      IF( RCOND.LT.<a name="DLAMCH.473"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>( <span class="string">'Epsilon'</span> ) )
     $   INFO = N + 1
<span class="comment">*</span><span class="comment">
</span>      RWORK( 1 ) = RPVGRW
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="ZGESVX.479"></a><a href="zgesvx.f.html#ZGESVX.1">ZGESVX</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>