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       END IF
00193       IF( INFO.NE.0 ) THEN
00194          CALL XERBLA( 'CLA_GERCOND_X', -INFO )
00195          RETURN
00196       END IF
00197 *
00198 *     Compute norm of op(A)*op2(C).
00199 *
00200       ANORM = 0.0
00201       IF ( NOTRANS ) THEN
00202          DO I = 1, N
00203             TMP = 0.0E+0
00204             DO J = 1, N
00205                TMP = TMP + CABS1( A( I, J ) * X( J ) )
00206             END DO
00207             RWORK( I ) = TMP
00208             ANORM = MAX( ANORM, TMP )
00209          END DO
00210       ELSE
00211          DO I = 1, N
00212             TMP = 0.0E+0
00213             DO J = 1, N
00214                TMP = TMP + CABS1( A( J, I ) * X( J ) )
00215             END DO
00216             RWORK( I ) = TMP
00217             ANORM = MAX( ANORM, TMP )
00218          END DO
00219       END IF
00220 *
00221 *     Quick return if possible.
00222 *
00223       IF( N.EQ.0 ) THEN
00224          CLA_GERCOND_X = 1.0E+0
00225          RETURN
00226       ELSE IF( ANORM .EQ. 0.0E+0 ) THEN
00227          RETURN
00228       END IF
00229 *
00230 *     Estimate the norm of inv(op(A)).
00231 *
00232       AINVNM = 0.0E+0
00233 *
00234       KASE = 0
00235    10 CONTINUE
00236       CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
00237       IF( KASE.NE.0 ) THEN
00238          IF( KASE.EQ.2 ) THEN
00239 *           Multiply by R.
00240             DO I = 1, N
00241                WORK( I ) = WORK( I ) * RWORK( I )
00242             END DO
00243 *
00244             IF ( NOTRANS ) THEN
00245                CALL CGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
00246      $            WORK, N, INFO )
00247             ELSE
00248                CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
00249      $            WORK, N, INFO )
00250             ENDIF
00251 *
00252 *           Multiply by inv(X).
00253 *
00254             DO I = 1, N
00255                WORK( I ) = WORK( I ) / X( I )
00256             END DO
00257          ELSE
00258 *
00259 *           Multiply by inv(X**H).
00260 *
00261             DO I = 1, N
00262                WORK( I ) = WORK( I ) / X( I )
00263             END DO
00264 *
00265             IF ( NOTRANS ) THEN
00266                CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
00267      $            WORK, N, INFO )
00268             ELSE
00269                CALL CGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
00270      $            WORK, N, INFO )
00271             END IF
00272 *
00273 *           Multiply by R.
00274 *
00275             DO I = 1, N
00276                WORK( I ) = WORK( I ) * RWORK( I )
00277             END DO
00278          END IF
00279          GO TO 10
00280       END IF
00281 *
00282 *     Compute the estimate of the reciprocal condition number.
00283 *
00284       IF( AINVNM .NE. 0.0E+0 )
00285      $   CLA_GERCOND_X = 1.0E+0 / AINVNM
00286 *
00287       RETURN
00288 *
00289       END