LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cla_gercond_x.f
Go to the documentation of this file.
00001 *> \brief \b CLA_GERCOND_X
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CLA_GERCOND_X + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cla_gercond_x.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cla_gercond_x.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cla_gercond_x.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       REAL FUNCTION CLA_GERCOND_X( TRANS, N, A, LDA, AF, LDAF, IPIV, X,
00022 *                                    INFO, WORK, RWORK )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       CHARACTER          TRANS
00026 *       INTEGER            N, LDA, LDAF, INFO
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       INTEGER            IPIV( * )
00030 *       COMPLEX            A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
00031 *       REAL               RWORK( * )
00032 *       ..
00033 *  
00034 *
00035 *> \par Purpose:
00036 *  =============
00037 *>
00038 *> \verbatim
00039 *>
00040 *> 
00041 *>    CLA_GERCOND_X computes the infinity norm condition number of
00042 *>    op(A) * diag(X) where X is a COMPLEX vector.
00043 *> \endverbatim
00044 *
00045 *  Arguments:
00046 *  ==========
00047 *
00048 *> \param[in] TRANS
00049 *> \verbatim
00050 *>          TRANS is CHARACTER*1
00051 *>     Specifies the form of the system of equations:
00052 *>       = 'N':  A * X = B     (No transpose)
00053 *>       = 'T':  A**T * X = B  (Transpose)
00054 *>       = 'C':  A**H * X = B  (Conjugate Transpose = Transpose)
00055 *> \endverbatim
00056 *>
00057 *> \param[in] N
00058 *> \verbatim
00059 *>          N is INTEGER
00060 *>     The number of linear equations, i.e., the order of the
00061 *>     matrix A.  N >= 0.
00062 *> \endverbatim
00063 *>
00064 *> \param[in] A
00065 *> \verbatim
00066 *>          A is COMPLEX array, dimension (LDA,N)
00067 *>     On entry, the N-by-N matrix A.
00068 *> \endverbatim
00069 *>
00070 *> \param[in] LDA
00071 *> \verbatim
00072 *>          LDA is INTEGER
00073 *>     The leading dimension of the array A.  LDA >= max(1,N).
00074 *> \endverbatim
00075 *>
00076 *> \param[in] AF
00077 *> \verbatim
00078 *>          AF is COMPLEX array, dimension (LDAF,N)
00079 *>     The factors L and U from the factorization
00080 *>     A = P*L*U as computed by CGETRF.
00081 *> \endverbatim
00082 *>
00083 *> \param[in] LDAF
00084 *> \verbatim
00085 *>          LDAF is INTEGER
00086 *>     The leading dimension of the array AF.  LDAF >= max(1,N).
00087 *> \endverbatim
00088 *>
00089 *> \param[in] IPIV
00090 *> \verbatim
00091 *>          IPIV is INTEGER array, dimension (N)
00092 *>     The pivot indices from the factorization A = P*L*U
00093 *>     as computed by CGETRF; row i of the matrix was interchanged
00094 *>     with row IPIV(i).
00095 *> \endverbatim
00096 *>
00097 *> \param[in] X
00098 *> \verbatim
00099 *>          X is COMPLEX array, dimension (N)
00100 *>     The vector X in the formula op(A) * diag(X).
00101 *> \endverbatim
00102 *>
00103 *> \param[out] INFO
00104 *> \verbatim
00105 *>          INFO is INTEGER
00106 *>       = 0:  Successful exit.
00107 *>     i > 0:  The ith argument is invalid.
00108 *> \endverbatim
00109 *>
00110 *> \param[in] WORK
00111 *> \verbatim
00112 *>          WORK is COMPLEX array, dimension (2*N).
00113 *>     Workspace.
00114 *> \endverbatim
00115 *>
00116 *> \param[in] RWORK
00117 *> \verbatim
00118 *>          RWORK is REAL array, dimension (N).
00119 *>     Workspace.
00120 *> \endverbatim
00121 *
00122 *  Authors:
00123 *  ========
00124 *
00125 *> \author Univ. of Tennessee 
00126 *> \author Univ. of California Berkeley 
00127 *> \author Univ. of Colorado Denver 
00128 *> \author NAG Ltd. 
00129 *
00130 *> \date November 2011
00131 *
00132 *> \ingroup complexGEcomputational
00133 *
00134 *  =====================================================================
00135       REAL FUNCTION CLA_GERCOND_X( TRANS, N, A, LDA, AF, LDAF, IPIV, X,
00136      $                             INFO, WORK, RWORK )
00137 *
00138 *  -- LAPACK computational routine (version 3.4.0) --
00139 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00140 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00141 *     November 2011
00142 *
00143 *     .. Scalar Arguments ..
00144       CHARACTER          TRANS
00145       INTEGER            N, LDA, LDAF, INFO
00146 *     ..
00147 *     .. Array Arguments ..
00148       INTEGER            IPIV( * )
00149       COMPLEX            A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
00150       REAL               RWORK( * )
00151 *     ..
00152 *
00153 *  =====================================================================
00154 *
00155 *     .. Local Scalars ..
00156       LOGICAL            NOTRANS
00157       INTEGER            KASE
00158       REAL               AINVNM, ANORM, TMP
00159       INTEGER            I, J
00160       COMPLEX            ZDUM
00161 *     ..
00162 *     .. Local Arrays ..
00163       INTEGER            ISAVE( 3 )
00164 *     ..
00165 *     .. External Functions ..
00166       LOGICAL            LSAME
00167       EXTERNAL           LSAME
00168 *     ..
00169 *     .. External Subroutines ..
00170       EXTERNAL           CLACN2, CGETRS, XERBLA
00171 *     ..
00172 *     .. Intrinsic Functions ..
00173       INTRINSIC          ABS, MAX, REAL, AIMAG
00174 *     ..
00175 *     .. Statement Functions ..
00176       REAL               CABS1
00177 *     ..
00178 *     .. Statement Function Definitions ..
00179       CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
00180 *     ..
00181 *     .. Executable Statements ..
00182 *
00183       CLA_GERCOND_X = 0.0E+0
00184 *
00185       INFO = 0
00186       NOTRANS = LSAME( TRANS, 'N' )
00187       IF ( .NOT. NOTRANS .AND. .NOT. LSAME( TRANS, 'T' ) .AND. .NOT.
00188      $     LSAME( TRANS, 'C' ) ) THEN
00189          INFO = -1
00190       ELSE IF( N.LT.0 ) THEN
00191          INFO = -2
00192       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00193          INFO = -4
00194       ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
00195          INFO = -6
00196       END IF
00197       IF( INFO.NE.0 ) THEN
00198          CALL XERBLA( 'CLA_GERCOND_X', -INFO )
00199          RETURN
00200       END IF
00201 *
00202 *     Compute norm of op(A)*op2(C).
00203 *
00204       ANORM = 0.0
00205       IF ( NOTRANS ) THEN
00206          DO I = 1, N
00207             TMP = 0.0E+0
00208             DO J = 1, N
00209                TMP = TMP + CABS1( A( I, J ) * X( J ) )
00210             END DO
00211             RWORK( I ) = TMP
00212             ANORM = MAX( ANORM, TMP )
00213          END DO
00214       ELSE
00215          DO I = 1, N
00216             TMP = 0.0E+0
00217             DO J = 1, N
00218                TMP = TMP + CABS1( A( J, I ) * X( J ) )
00219             END DO
00220             RWORK( I ) = TMP
00221             ANORM = MAX( ANORM, TMP )
00222          END DO
00223       END IF
00224 *
00225 *     Quick return if possible.
00226 *
00227       IF( N.EQ.0 ) THEN
00228          CLA_GERCOND_X = 1.0E+0
00229          RETURN
00230       ELSE IF( ANORM .EQ. 0.0E+0 ) THEN
00231          RETURN
00232       END IF
00233 *
00234 *     Estimate the norm of inv(op(A)).
00235 *
00236       AINVNM = 0.0E+0
00237 *
00238       KASE = 0
00239    10 CONTINUE
00240       CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
00241       IF( KASE.NE.0 ) THEN
00242          IF( KASE.EQ.2 ) THEN
00243 *           Multiply by R.
00244             DO I = 1, N
00245                WORK( I ) = WORK( I ) * RWORK( I )
00246             END DO
00247 *
00248             IF ( NOTRANS ) THEN
00249                CALL CGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
00250      $            WORK, N, INFO )
00251             ELSE
00252                CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
00253      $            WORK, N, INFO )
00254             ENDIF
00255 *
00256 *           Multiply by inv(X).
00257 *
00258             DO I = 1, N
00259                WORK( I ) = WORK( I ) / X( I )
00260             END DO
00261          ELSE
00262 *
00263 *           Multiply by inv(X**H).
00264 *
00265             DO I = 1, N
00266                WORK( I ) = WORK( I ) / X( I )
00267             END DO
00268 *
00269             IF ( NOTRANS ) THEN
00270                CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
00271      $            WORK, N, INFO )
00272             ELSE
00273                CALL CGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
00274      $            WORK, N, INFO )
00275             END IF
00276 *
00277 *           Multiply by R.
00278 *
00279             DO I = 1, N
00280                WORK( I ) = WORK( I ) * RWORK( I )
00281             END DO
00282          END IF
00283          GO TO 10
00284       END IF
00285 *
00286 *     Compute the estimate of the reciprocal condition number.
00287 *
00288       IF( AINVNM .NE. 0.0E+0 )
00289      $   CLA_GERCOND_X = 1.0E+0 / AINVNM
00290 *
00291       RETURN
00292 *
00293       END
 All Files Functions