Annotation of rpl/lapack/lapack/zla_gercond_c.f, revision 1.18

1.10      bertrand    1: *> \brief \b ZLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices.
1.6       bertrand    2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.14      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.6       bertrand    7: *
                      8: *> \htmlonly
1.14      bertrand    9: *> Download ZLA_GERCOND_C + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_gercond_c.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_gercond_c.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_gercond_c.f">
1.6       bertrand   15: *> [TXT]</a>
1.14      bertrand   16: *> \endhtmlonly
1.6       bertrand   17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
1.14      bertrand   21: *       DOUBLE PRECISION FUNCTION ZLA_GERCOND_C( TRANS, N, A, LDA, AF,
1.6       bertrand   22: *                                                LDAF, IPIV, C, CAPPLY,
                     23: *                                                INFO, WORK, RWORK )
1.14      bertrand   24: *
1.17      bertrand   25: *       .. Scalar Arguments ..
1.6       bertrand   26: *       CHARACTER          TRANS
                     27: *       LOGICAL            CAPPLY
                     28: *       INTEGER            N, LDA, LDAF, INFO
                     29: *       ..
                     30: *       .. Array Arguments ..
                     31: *       INTEGER            IPIV( * )
                     32: *       COMPLEX*16         A( LDA, * ), AF( LDAF, * ), WORK( * )
                     33: *       DOUBLE PRECISION   C( * ), RWORK( * )
                     34: *       ..
1.14      bertrand   35: *
1.6       bertrand   36: *
                     37: *> \par Purpose:
                     38: *  =============
                     39: *>
                     40: *> \verbatim
                     41: *>
                     42: *>    ZLA_GERCOND_C computes the infinity norm condition number of
                     43: *>    op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector.
                     44: *> \endverbatim
                     45: *
                     46: *  Arguments:
                     47: *  ==========
                     48: *
                     49: *> \param[in] TRANS
                     50: *> \verbatim
                     51: *>          TRANS is CHARACTER*1
                     52: *>     Specifies the form of the system of equations:
                     53: *>       = 'N':  A * X = B     (No transpose)
                     54: *>       = 'T':  A**T * X = B  (Transpose)
                     55: *>       = 'C':  A**H * X = B  (Conjugate Transpose = Transpose)
                     56: *> \endverbatim
                     57: *>
                     58: *> \param[in] N
                     59: *> \verbatim
                     60: *>          N is INTEGER
                     61: *>     The number of linear equations, i.e., the order of the
                     62: *>     matrix A.  N >= 0.
                     63: *> \endverbatim
                     64: *>
                     65: *> \param[in] A
                     66: *> \verbatim
                     67: *>          A is COMPLEX*16 array, dimension (LDA,N)
                     68: *>     On entry, the N-by-N matrix A
                     69: *> \endverbatim
                     70: *>
                     71: *> \param[in] LDA
                     72: *> \verbatim
                     73: *>          LDA is INTEGER
                     74: *>     The leading dimension of the array A.  LDA >= max(1,N).
                     75: *> \endverbatim
                     76: *>
                     77: *> \param[in] AF
                     78: *> \verbatim
                     79: *>          AF is COMPLEX*16 array, dimension (LDAF,N)
                     80: *>     The factors L and U from the factorization
                     81: *>     A = P*L*U as computed by ZGETRF.
                     82: *> \endverbatim
                     83: *>
                     84: *> \param[in] LDAF
                     85: *> \verbatim
                     86: *>          LDAF is INTEGER
                     87: *>     The leading dimension of the array AF.  LDAF >= max(1,N).
                     88: *> \endverbatim
                     89: *>
                     90: *> \param[in] IPIV
                     91: *> \verbatim
                     92: *>          IPIV is INTEGER array, dimension (N)
                     93: *>     The pivot indices from the factorization A = P*L*U
                     94: *>     as computed by ZGETRF; row i of the matrix was interchanged
                     95: *>     with row IPIV(i).
                     96: *> \endverbatim
                     97: *>
                     98: *> \param[in] C
                     99: *> \verbatim
                    100: *>          C is DOUBLE PRECISION array, dimension (N)
                    101: *>     The vector C in the formula op(A) * inv(diag(C)).
                    102: *> \endverbatim
                    103: *>
                    104: *> \param[in] CAPPLY
                    105: *> \verbatim
                    106: *>          CAPPLY is LOGICAL
                    107: *>     If .TRUE. then access the vector C in the formula above.
                    108: *> \endverbatim
                    109: *>
                    110: *> \param[out] INFO
                    111: *> \verbatim
                    112: *>          INFO is INTEGER
                    113: *>       = 0:  Successful exit.
                    114: *>     i > 0:  The ith argument is invalid.
                    115: *> \endverbatim
                    116: *>
1.17      bertrand  117: *> \param[out] WORK
1.6       bertrand  118: *> \verbatim
                    119: *>          WORK is COMPLEX*16 array, dimension (2*N).
                    120: *>     Workspace.
                    121: *> \endverbatim
                    122: *>
1.17      bertrand  123: *> \param[out] RWORK
1.6       bertrand  124: *> \verbatim
                    125: *>          RWORK is DOUBLE PRECISION array, dimension (N).
                    126: *>     Workspace.
                    127: *> \endverbatim
                    128: *
                    129: *  Authors:
                    130: *  ========
                    131: *
1.14      bertrand  132: *> \author Univ. of Tennessee
                    133: *> \author Univ. of California Berkeley
                    134: *> \author Univ. of Colorado Denver
                    135: *> \author NAG Ltd.
1.6       bertrand  136: *
                    137: *> \ingroup complex16GEcomputational
                    138: *
                    139: *  =====================================================================
1.14      bertrand  140:       DOUBLE PRECISION FUNCTION ZLA_GERCOND_C( TRANS, N, A, LDA, AF,
1.1       bertrand  141:      $                                         LDAF, IPIV, C, CAPPLY,
                    142:      $                                         INFO, WORK, RWORK )
                    143: *
1.18    ! bertrand  144: *  -- LAPACK computational routine --
1.6       bertrand  145: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    146: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.1       bertrand  147: *
1.17      bertrand  148: *     .. Scalar Arguments ..
1.1       bertrand  149:       CHARACTER          TRANS
                    150:       LOGICAL            CAPPLY
                    151:       INTEGER            N, LDA, LDAF, INFO
                    152: *     ..
                    153: *     .. Array Arguments ..
                    154:       INTEGER            IPIV( * )
                    155:       COMPLEX*16         A( LDA, * ), AF( LDAF, * ), WORK( * )
                    156:       DOUBLE PRECISION   C( * ), RWORK( * )
                    157: *     ..
                    158: *
                    159: *  =====================================================================
                    160: *
                    161: *     .. Local Scalars ..
                    162:       LOGICAL            NOTRANS
                    163:       INTEGER            KASE, I, J
                    164:       DOUBLE PRECISION   AINVNM, ANORM, TMP
                    165:       COMPLEX*16         ZDUM
                    166: *     ..
                    167: *     .. Local Arrays ..
                    168:       INTEGER            ISAVE( 3 )
                    169: *     ..
                    170: *     .. External Functions ..
                    171:       LOGICAL            LSAME
                    172:       EXTERNAL           LSAME
                    173: *     ..
                    174: *     .. External Subroutines ..
                    175:       EXTERNAL           ZLACN2, ZGETRS, XERBLA
                    176: *     ..
                    177: *     .. Intrinsic Functions ..
                    178:       INTRINSIC          ABS, MAX, REAL, DIMAG
                    179: *     ..
                    180: *     .. Statement Functions ..
                    181:       DOUBLE PRECISION   CABS1
                    182: *     ..
                    183: *     .. Statement Function Definitions ..
                    184:       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
                    185: *     ..
                    186: *     .. Executable Statements ..
                    187:       ZLA_GERCOND_C = 0.0D+0
                    188: *
                    189:       INFO = 0
                    190:       NOTRANS = LSAME( TRANS, 'N' )
                    191:       IF ( .NOT. NOTRANS .AND. .NOT. LSAME( TRANS, 'T' ) .AND. .NOT.
                    192:      $     LSAME( TRANS, 'C' ) ) THEN
1.8       bertrand  193:          INFO = -1
1.1       bertrand  194:       ELSE IF( N.LT.0 ) THEN
                    195:          INFO = -2
1.8       bertrand  196:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
                    197:          INFO = -4
                    198:       ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
                    199:          INFO = -6
1.1       bertrand  200:       END IF
                    201:       IF( INFO.NE.0 ) THEN
                    202:          CALL XERBLA( 'ZLA_GERCOND_C', -INFO )
                    203:          RETURN
                    204:       END IF
                    205: *
                    206: *     Compute norm of op(A)*op2(C).
                    207: *
                    208:       ANORM = 0.0D+0
                    209:       IF ( NOTRANS ) THEN
                    210:          DO I = 1, N
                    211:             TMP = 0.0D+0
                    212:             IF ( CAPPLY ) THEN
                    213:                DO J = 1, N
                    214:                   TMP = TMP + CABS1( A( I, J ) ) / C( J )
                    215:                END DO
                    216:             ELSE
                    217:                DO J = 1, N
                    218:                   TMP = TMP + CABS1( A( I, J ) )
                    219:                END DO
                    220:             END IF
                    221:             RWORK( I ) = TMP
                    222:             ANORM = MAX( ANORM, TMP )
                    223:          END DO
                    224:       ELSE
                    225:          DO I = 1, N
                    226:             TMP = 0.0D+0
                    227:             IF ( CAPPLY ) THEN
                    228:                DO J = 1, N
                    229:                   TMP = TMP + CABS1( A( J, I ) ) / C( J )
                    230:                END DO
                    231:             ELSE
                    232:                DO J = 1, N
                    233:                   TMP = TMP + CABS1( A( J, I ) )
                    234:                END DO
                    235:             END IF
                    236:             RWORK( I ) = TMP
                    237:             ANORM = MAX( ANORM, TMP )
                    238:          END DO
                    239:       END IF
                    240: *
                    241: *     Quick return if possible.
                    242: *
                    243:       IF( N.EQ.0 ) THEN
                    244:          ZLA_GERCOND_C = 1.0D+0
                    245:          RETURN
                    246:       ELSE IF( ANORM .EQ. 0.0D+0 ) THEN
                    247:          RETURN
                    248:       END IF
                    249: *
                    250: *     Estimate the norm of inv(op(A)).
                    251: *
                    252:       AINVNM = 0.0D+0
                    253: *
                    254:       KASE = 0
                    255:    10 CONTINUE
                    256:       CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
                    257:       IF( KASE.NE.0 ) THEN
                    258:          IF( KASE.EQ.2 ) THEN
                    259: *
                    260: *           Multiply by R.
                    261: *
                    262:             DO I = 1, N
                    263:                WORK( I ) = WORK( I ) * RWORK( I )
                    264:             END DO
                    265: *
                    266:             IF (NOTRANS) THEN
                    267:                CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
                    268:      $            WORK, N, INFO )
                    269:             ELSE
                    270:                CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
                    271:      $            WORK, N, INFO )
                    272:             ENDIF
                    273: *
                    274: *           Multiply by inv(C).
                    275: *
                    276:             IF ( CAPPLY ) THEN
                    277:                DO I = 1, N
                    278:                   WORK( I ) = WORK( I ) * C( I )
                    279:                END DO
                    280:             END IF
                    281:          ELSE
                    282: *
1.5       bertrand  283: *           Multiply by inv(C**H).
1.1       bertrand  284: *
                    285:             IF ( CAPPLY ) THEN
                    286:                DO I = 1, N
                    287:                   WORK( I ) = WORK( I ) * C( I )
                    288:                END DO
                    289:             END IF
                    290: *
                    291:             IF ( NOTRANS ) THEN
                    292:                CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
                    293:      $            WORK, N, INFO )
                    294:             ELSE
                    295:                CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
                    296:      $            WORK, N, INFO )
                    297:             END IF
                    298: *
                    299: *           Multiply by R.
                    300: *
                    301:             DO I = 1, N
                    302:                WORK( I ) = WORK( I ) * RWORK( I )
                    303:             END DO
                    304:          END IF
                    305:          GO TO 10
                    306:       END IF
                    307: *
                    308: *     Compute the estimate of the reciprocal condition number.
                    309: *
                    310:       IF( AINVNM .NE. 0.0D+0 )
                    311:      $   ZLA_GERCOND_C = 1.0D+0 / AINVNM
                    312: *
                    313:       RETURN
                    314: *
1.18    ! bertrand  315: *     End of ZLA_GERCOND_C
        !           316: *
1.1       bertrand  317:       END

CVSweb interface <joel.bertrand@systella.fr>