d8/d8b/zla__syrcond__c_8f_source.html

 *> \brief \b ZLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefinite matrices.

 *

 *  =========== DOCUMENTATION ===========

 *

 * Online html documentation available at

 *            http://www.netlib.org/lapack/explore-html/

 *

 *> \htmlonly

 *> Download ZLA_SYRCOND_C + dependencies

 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_syrcond_c.f">

 *> [TGZ]</a>

 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_syrcond_c.f">

 *> [ZIP]</a>

 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_syrcond_c.f">

 *> [TXT]</a>

 *> \endhtmlonly

 *

 *  Definition:

 *  ===========

 *

 *       DOUBLE PRECISION FUNCTION ZLA_SYRCOND_C( UPLO, N, A, LDA, AF,

 *                                                LDAF, IPIV, C, CAPPLY,

 *                                                INFO, WORK, RWORK )

 *

 *       .. Scalar Arguments ..

 *       CHARACTER          UPLO

 *       LOGICAL            CAPPLY

 *       INTEGER            N, LDA, LDAF, INFO

 *       ..

 *       .. Array Arguments ..

 *       INTEGER            IPIV( * )

 *       COMPLEX*16         A( LDA, * ), AF( LDAF, * ), WORK( * )

 *       DOUBLE PRECISION   C( * ), RWORK( * )

 *       ..

 *

 *

 *> \par Purpose:

 *  =============

 *>

 *> \verbatim

 *>

 *>    ZLA_SYRCOND_C Computes the infinity norm condition number of

 *>    op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector.

 *> \endverbatim

 *

 *  Arguments:

 *  ==========

 *

 *> \param[in] UPLO

 *> \verbatim

 *>          UPLO is CHARACTER*1

 *>       = 'U':  Upper triangle of A is stored;

 *>       = 'L':  Lower triangle of A is stored.

 *> \endverbatim

 *>

 *> \param[in] N

 *> \verbatim

 *>          N is INTEGER

 *>     The number of linear equations, i.e., the order of the

 *>     matrix A.  N >= 0.

 *> \endverbatim

 *>

 *> \param[in] A

 *> \verbatim

 *>          A is COMPLEX*16 array, dimension (LDA,N)

 *>     On entry, the N-by-N matrix A

 *> \endverbatim

 *>

 *> \param[in] LDA

 *> \verbatim

 *>          LDA is INTEGER

 *>     The leading dimension of the array A.  LDA >= max(1,N).

 *> \endverbatim

 *>

 *> \param[in] AF

 *> \verbatim

 *>          AF is COMPLEX*16 array, dimension (LDAF,N)

 *>     The block diagonal matrix D and the multipliers used to

 *>     obtain the factor U or L as computed by ZSYTRF.

 *> \endverbatim

 *>

 *> \param[in] LDAF

 *> \verbatim

 *>          LDAF is INTEGER

 *>     The leading dimension of the array AF.  LDAF >= max(1,N).

 *> \endverbatim

 *>

 *> \param[in] IPIV

 *> \verbatim

 *>          IPIV is INTEGER array, dimension (N)

 *>     Details of the interchanges and the block structure of D

 *>     as determined by ZSYTRF.

 *> \endverbatim

 *>

 *> \param[in] C

 *> \verbatim

 *>          C is DOUBLE PRECISION array, dimension (N)

 *>     The vector C in the formula op(A) * inv(diag(C)).

 *> \endverbatim

 *>

 *> \param[in] CAPPLY

 *> \verbatim

 *>          CAPPLY is LOGICAL

 *>     If .TRUE. then access the vector C in the formula above.

 *> \endverbatim

 *>

 *> \param[out] INFO

 *> \verbatim

 *>          INFO is INTEGER

 *>       = 0:  Successful exit.

 *>     i > 0:  The ith argument is invalid.

 *> \endverbatim

 *>

 *> \param[out] WORK

 *> \verbatim

 *>          WORK is COMPLEX*16 array, dimension (2*N).

 *>     Workspace.

 *> \endverbatim

 *>

 *> \param[out] RWORK

 *> \verbatim

 *>          RWORK is DOUBLE PRECISION array, dimension (N).

 *>     Workspace.

 *> \endverbatim

 *

 *  Authors:

 *  ========

 *

 *> \author Univ. of Tennessee

 *> \author Univ. of California Berkeley

 *> \author Univ. of Colorado Denver

 *> \author NAG Ltd.

 *

 *> \ingroup complex16SYcomputational

 *

 *  =====================================================================

       DOUBLE PRECISION FUNCTION zla_syrcond_c( UPLO, N, A, LDA, AF,

      $                                         LDAF, IPIV, C, CAPPLY,

      $                                         INFO, WORK, RWORK )

 *

 *  -- LAPACK computational routine --

 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --

 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--

 *

 *     .. Scalar Arguments ..

       CHARACTER          uplo

       LOGICAL            capply

       INTEGER            n, lda, ldaf, info

 *     ..

 *     .. Array Arguments ..

       INTEGER            ipiv( * )

       COMPLEX*16         a( lda, * ), af( ldaf, * ), work( * )

       DOUBLE PRECISION   c( * ), rwork( * )

 *     ..

 *

 *  =====================================================================

 *

 *     .. Local Scalars ..

       INTEGER            kase

       DOUBLE PRECISION   ainvnm, anorm, tmp

       INTEGER            i, j

       LOGICAL            up, upper

       COMPLEX*16         zdum

 *     ..

 *     .. Local Arrays ..

       INTEGER            isave( 3 )

 *     ..

 *     .. External Functions ..

       LOGICAL            lsame

       EXTERNAL           lsame

 *     ..

 *     .. External Subroutines ..

       EXTERNAL           zlacn2, zsytrs, xerbla

 *     ..

 *     .. Intrinsic Functions ..

       INTRINSIC          abs, max

 *     ..

 *     .. Statement Functions ..

       DOUBLE PRECISION cabs1

 *     ..

 *     .. Statement Function Definitions ..

       cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )

 *     ..

 *     .. Executable Statements ..

 *

       zla_syrcond_c = 0.0d+0

 *

       info = 0

       upper = lsame( uplo, 'U' )

       IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN

          info = -1

       ELSE IF( n.LT.0 ) THEN

          info = -2

       ELSE IF( lda.LT.max( 1, n ) ) THEN

          info = -4

       ELSE IF( ldaf.LT.max( 1, n ) ) THEN

          info = -6

       END IF

       IF( info.NE.0 ) THEN

          CALL xerbla( 'ZLA_SYRCOND_C', -info )

          RETURN

       END IF

       up = .false.

       IF ( lsame( uplo, 'U' ) ) up = .true.

 *

 *     Compute norm of op(A)*op2(C).

 *

       anorm = 0.0d+0

       IF ( up ) THEN

          DO i = 1, n

             tmp = 0.0d+0

             IF ( capply ) THEN

                DO j = 1, i

                   tmp = tmp + cabs1( a( j, i ) ) / c( j )

                END DO

                DO j = i+1, n

                   tmp = tmp + cabs1( a( i, j ) ) / c( j )

                END DO

             ELSE

                DO j = 1, i

                   tmp = tmp + cabs1( a( j, i ) )

                END DO

                DO j = i+1, n

                   tmp = tmp + cabs1( a( i, j ) )

                END DO

             END IF

             rwork( i ) = tmp

             anorm = max( anorm, tmp )

          END DO

       ELSE

          DO i = 1, n

             tmp = 0.0d+0

             IF ( capply ) THEN

                DO j = 1, i

                   tmp = tmp + cabs1( a( i, j ) ) / c( j )

                END DO

                DO j = i+1, n

                   tmp = tmp + cabs1( a( j, i ) ) / c( j )

                END DO

             ELSE

                DO j = 1, i

                   tmp = tmp + cabs1( a( i, j ) )

                END DO

                DO j = i+1, n

                   tmp = tmp + cabs1( a( j, i ) )

                END DO

             END IF

             rwork( i ) = tmp

             anorm = max( anorm, tmp )

          END DO

       END IF

 *

 *     Quick return if possible.

 *

       IF( n.EQ.0 ) THEN

          zla_syrcond_c = 1.0d+0

          RETURN

       ELSE IF( anorm .EQ. 0.0d+0 ) THEN

          RETURN

       END IF

 *

 *     Estimate the norm of inv(op(A)).

 *

       ainvnm = 0.0d+0

 *

       kase = 0

    10 CONTINUE

       CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )

       IF( kase.NE.0 ) THEN

          IF( kase.EQ.2 ) THEN

 *

 *           Multiply by R.

 *

             DO i = 1, n

                work( i ) = work( i ) * rwork( i )

             END DO

 *

             IF ( up ) THEN

                CALL zsytrs( 'U', n, 1, af, ldaf, ipiv,

      $            work, n, info )

             ELSE

                CALL zsytrs( 'L', n, 1, af, ldaf, ipiv,

      $            work, n, info )

             ENDIF

 *

 *           Multiply by inv(C).

 *

             IF ( capply ) THEN

                DO i = 1, n

                   work( i ) = work( i ) * c( i )

                END DO

             END IF

          ELSE

 *

 *           Multiply by inv(C**T).

 *

             IF ( capply ) THEN

                DO i = 1, n

                   work( i ) = work( i ) * c( i )

                END DO

             END IF

 *

             IF ( up ) THEN

                CALL zsytrs( 'U', n, 1, af, ldaf, ipiv,

      $            work, n, info )

             ELSE

                CALL zsytrs( 'L', n, 1, af, ldaf, ipiv,

      $            work, n, info )

             END IF

 *

 *           Multiply by R.

 *

             DO i = 1, n

                work( i ) = work( i ) * rwork( i )

             END DO

          END IF

          GO TO 10

       END IF

 *

 *     Compute the estimate of the reciprocal condition number.

 *

       IF( ainvnm .NE. 0.0d+0 )

      $   zla_syrcond_c = 1.0d+0 / ainvnm

 *

       RETURN

 *

 *     End of ZLA_SYRCOND_C

 *

       END

xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60

lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53

zlacn2
subroutine zlacn2(N, V, X, EST, KASE, ISAVE)
ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition: zlacn2.f:133

zla_syrcond_c
double precision function zla_syrcond_c(UPLO, N, A, LDA, AF, LDAF, IPIV, C, CAPPLY, INFO, WORK, RWORK)
ZLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefin...
Definition: zla_syrcond_c.f:140

zsytrs
subroutine zsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS
Definition: zsytrs.f:120