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