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