LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cla_porcond_x.f
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, UPPER
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       UPPER = LSAME( UPLO, 'U' )
00173       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00174          INFO = -1
00175       ELSE IF ( N.LT.0 ) THEN
00176          INFO = -2
00177       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00178          INFO = -4
00179       ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
00180          INFO = -6
00181       END IF
00182       IF( INFO.NE.0 ) THEN
00183          CALL XERBLA( 'CLA_PORCOND_X', -INFO )
00184          RETURN
00185       END IF
00186       UP = .FALSE.
00187       IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
00188 *
00189 *     Compute norm of op(A)*op2(C).
00190 *
00191       ANORM = 0.0
00192       IF ( UP ) THEN
00193          DO I = 1, N
00194             TMP = 0.0E+0
00195             DO J = 1, I
00196                TMP = TMP + CABS1( A( J, I ) * X( J ) )
00197             END DO
00198             DO J = I+1, N
00199                TMP = TMP + CABS1( A( I, J ) * X( J ) )
00200             END DO
00201             RWORK( I ) = TMP
00202             ANORM = MAX( ANORM, TMP )
00203          END DO
00204       ELSE
00205          DO I = 1, N
00206             TMP = 0.0E+0
00207             DO J = 1, I
00208                TMP = TMP + CABS1( A( I, J ) * X( J ) )
00209             END DO
00210             DO J = I+1, N
00211                TMP = TMP + CABS1( A( J, I ) * X( J ) )
00212             END DO
00213             RWORK( I ) = TMP
00214             ANORM = MAX( ANORM, TMP )
00215          END DO
00216       END IF
00217 *
00218 *     Quick return if possible.
00219 *
00220       IF( N.EQ.0 ) THEN
00221          CLA_PORCOND_X = 1.0E+0
00222          RETURN
00223       ELSE IF( ANORM .EQ. 0.0E+0 ) THEN
00224          RETURN
00225       END IF
00226 *
00227 *     Estimate the norm of inv(op(A)).
00228 *
00229       AINVNM = 0.0E+0
00230 *
00231       KASE = 0
00232    10 CONTINUE
00233       CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
00234       IF( KASE.NE.0 ) THEN
00235          IF( KASE.EQ.2 ) THEN
00236 *
00237 *           Multiply by R.
00238 *
00239             DO I = 1, N
00240                WORK( I ) = WORK( I ) * RWORK( I )
00241             END DO
00242 *
00243             IF ( UP ) THEN
00244                CALL CPOTRS( 'U', N, 1, AF, LDAF,
00245      $            WORK, N, INFO )
00246             ELSE
00247                CALL CPOTRS( 'L', N, 1, AF, LDAF,
00248      $            WORK, N, INFO )
00249             ENDIF
00250 *
00251 *           Multiply by inv(X).
00252 *
00253             DO I = 1, N
00254                WORK( I ) = WORK( I ) / X( I )
00255             END DO
00256          ELSE
00257 *
00258 *           Multiply by inv(X**H).
00259 *
00260             DO I = 1, N
00261                WORK( I ) = WORK( I ) / X( I )
00262             END DO
00263 *
00264             IF ( UP ) THEN
00265                CALL CPOTRS( 'U', N, 1, AF, LDAF,
00266      $            WORK, N, INFO )
00267             ELSE
00268                CALL CPOTRS( 'L', N, 1, AF, LDAF,
00269      $            WORK, N, INFO )
00270             END IF
00271 *
00272 *           Multiply by R.
00273 *
00274             DO I = 1, N
00275                WORK( I ) = WORK( I ) * RWORK( I )
00276             END DO
00277          END IF
00278          GO TO 10
00279       END IF
00280 *
00281 *     Compute the estimate of the reciprocal condition number.
00282 *
00283       IF( AINVNM .NE. 0.0E+0 )
00284      $   CLA_PORCOND_X = 1.0E+0 / AINVNM
00285 *
00286       RETURN
00287 *
00288       END
 All Files Functions