Go to the documentation of this file.
00001 *> \brief \b ZLA_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 ZLA_GERCOND_X + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_gercond_x.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_gercond_x.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_gercond_x.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       DOUBLE PRECISION FUNCTION ZLA_GERCOND_X( TRANS, N, A, LDA, AF,
00022 *                                                LDAF, IPIV, X, INFO,
00023 *                                                WORK, RWORK )
00024 * 
00025 *       .. Scalar Arguments ..
00026 *       CHARACTER          TRANS
00027 *       INTEGER            N, LDA, LDAF, INFO
00028 *       ..
00029 *       .. Array Arguments ..
00030 *       INTEGER            IPIV( * )
00031 *       COMPLEX*16         A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
00032 *       DOUBLE PRECISION   RWORK( * )
00033 *       ..
00034 *  
00035 *
00036 *> \par Purpose:
00037 *  =============
00038 *>
00039 *> \verbatim
00040 *>
00041 *>    ZLA_GERCOND_X computes the infinity norm condition number of
00042 *>    op(A) * diag(X) where X is a COMPLEX*16 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*16 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*16 array, dimension (LDAF,N)
00079 *>     The factors L and U from the factorization
00080 *>     A = P*L*U as computed by ZGETRF.
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 ZGETRF; 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*16 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*16 array, dimension (2*N).
00113 *>     Workspace.
00114 *> \endverbatim
00115 *>
00116 *> \param[in] RWORK
00117 *> \verbatim
00118 *>          RWORK is DOUBLE PRECISION 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 complex16GEcomputational
00133 *
00134 *  =====================================================================
00135       DOUBLE PRECISION FUNCTION ZLA_GERCOND_X( TRANS, N, A, LDA, AF,
00136      $                                         LDAF, IPIV, X, INFO,
00137      $                                         WORK, RWORK )
00138 *
00139 *  -- LAPACK computational routine (version 3.4.0) --
00140 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00141 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00142 *     November 2011
00143 *
00144 *     .. Scalar Arguments ..
00145       CHARACTER          TRANS
00146       INTEGER            N, LDA, LDAF, INFO
00147 *     ..
00148 *     .. Array Arguments ..
00149       INTEGER            IPIV( * )
00150       COMPLEX*16         A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
00151       DOUBLE PRECISION   RWORK( * )
00152 *     ..
00153 *
00154 *  =====================================================================
00155 *
00156 *     .. Local Scalars ..
00157       LOGICAL            NOTRANS
00158       INTEGER            KASE
00159       DOUBLE PRECISION   AINVNM, ANORM, TMP
00160       INTEGER            I, J
00161       COMPLEX*16         ZDUM
00162 *     ..
00163 *     .. Local Arrays ..
00164       INTEGER            ISAVE( 3 )
00165 *     ..
00166 *     .. External Functions ..
00167       LOGICAL            LSAME
00168       EXTERNAL           LSAME
00169 *     ..
00170 *     .. External Subroutines ..
00171       EXTERNAL           ZLACN2, ZGETRS, XERBLA
00172 *     ..
00173 *     .. Intrinsic Functions ..
00174       INTRINSIC          ABS, MAX, REAL, DIMAG
00175 *     ..
00176 *     .. Statement Functions ..
00177       DOUBLE PRECISION   CABS1
00178 *     ..
00179 *     .. Statement Function Definitions ..
00180       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
00181 *     ..
00182 *     .. Executable Statements ..
00183 *
00184       ZLA_GERCOND_X = 0.0D+0
00185 *
00186       INFO = 0
00187       NOTRANS = LSAME( TRANS, 'N' )
00188       IF ( .NOT. NOTRANS .AND. .NOT. LSAME( TRANS, 'T' ) .AND. .NOT.
00189      $     LSAME( TRANS, 'C' ) ) THEN
00190          INFO = -1
00191       ELSE IF( N.LT.0 ) THEN
00192          INFO = -2
00193       END IF
00194       IF( INFO.NE.0 ) THEN
00195          CALL XERBLA( 'ZLA_GERCOND_X', -INFO )
00196          RETURN
00197       END IF
00198 *
00199 *     Compute norm of op(A)*op2(C).
00200 *
00201       ANORM = 0.0D+0
00202       IF ( NOTRANS ) THEN
00203          DO I = 1, N
00204             TMP = 0.0D+0
00205             DO J = 1, N
00206                TMP = TMP + CABS1( A( I, J ) * X( J ) )
00207             END DO
00208             RWORK( I ) = TMP
00209             ANORM = MAX( ANORM, TMP )
00210          END DO
00211       ELSE
00212          DO I = 1, N
00213             TMP = 0.0D+0
00214             DO J = 1, N
00215                TMP = TMP + CABS1( A( J, I ) * X( J ) )
00216             END DO
00217             RWORK( I ) = TMP
00218             ANORM = MAX( ANORM, TMP )
00219          END DO
00220       END IF
00221 *
00222 *     Quick return if possible.
00223 *
00224       IF( N.EQ.0 ) THEN
00225          ZLA_GERCOND_X = 1.0D+0
00226          RETURN
00227       ELSE IF( ANORM .EQ. 0.0D+0 ) THEN
00228          RETURN
00229       END IF
00230 *
00231 *     Estimate the norm of inv(op(A)).
00232 *
00233       AINVNM = 0.0D+0
00234 *
00235       KASE = 0
00236    10 CONTINUE
00237       CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
00238       IF( KASE.NE.0 ) THEN
00239          IF( KASE.EQ.2 ) THEN
00240 *           Multiply by R.
00241             DO I = 1, N
00242                WORK( I ) = WORK( I ) * RWORK( I )
00243             END DO
00244 *
00245             IF ( NOTRANS ) THEN
00246                CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
00247      $            WORK, N, INFO )
00248             ELSE
00249                CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
00250      $            WORK, N, INFO )
00251             ENDIF
00252 *
00253 *           Multiply by inv(X).
00254 *
00255             DO I = 1, N
00256                WORK( I ) = WORK( I ) / X( I )
00257             END DO
00258          ELSE
00259 *
00260 *           Multiply by inv(X**H).
00261 *
00262             DO I = 1, N
00263                WORK( I ) = WORK( I ) / X( I )
00264             END DO
00265 *
00266             IF ( NOTRANS ) THEN
00267                CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
00268      $            WORK, N, INFO )
00269             ELSE
00270                CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
00271      $            WORK, N, INFO )
00272             END IF
00273 *
00274 *           Multiply by R.
00275 *
00276             DO I = 1, N
00277                WORK( I ) = WORK( I ) * RWORK( I )
00278             END DO
00279          END IF
00280          GO TO 10
00281       END IF
00282 *
00283 *     Compute the estimate of the reciprocal condition number.
00284 *
00285       IF( AINVNM .NE. 0.0D+0 )
00286      $   ZLA_GERCOND_X = 1.0D+0 / AINVNM
00287 *
00288       RETURN
00289 *
00290       END