Annotation of rpl/lapack/lapack/zlacon.f, revision 1.19

1.12      bertrand    1: *> \brief \b ZLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products.
1.9       bertrand    2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.16      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.9       bertrand    7: *
                      8: *> \htmlonly
1.16      bertrand    9: *> Download ZLACON + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlacon.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlacon.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlacon.f">
1.9       bertrand   15: *> [TXT]</a>
1.16      bertrand   16: *> \endhtmlonly
1.9       bertrand   17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE ZLACON( N, V, X, EST, KASE )
1.16      bertrand   22: *
1.9       bertrand   23: *       .. Scalar Arguments ..
                     24: *       INTEGER            KASE, N
                     25: *       DOUBLE PRECISION   EST
                     26: *       ..
                     27: *       .. Array Arguments ..
                     28: *       COMPLEX*16         V( N ), X( N )
                     29: *       ..
1.16      bertrand   30: *
1.9       bertrand   31: *
                     32: *> \par Purpose:
                     33: *  =============
                     34: *>
                     35: *> \verbatim
                     36: *>
                     37: *> ZLACON estimates the 1-norm of a square, complex matrix A.
                     38: *> Reverse communication is used for evaluating matrix-vector products.
                     39: *> \endverbatim
                     40: *
                     41: *  Arguments:
                     42: *  ==========
                     43: *
                     44: *> \param[in] N
                     45: *> \verbatim
                     46: *>          N is INTEGER
                     47: *>         The order of the matrix.  N >= 1.
                     48: *> \endverbatim
                     49: *>
                     50: *> \param[out] V
                     51: *> \verbatim
                     52: *>          V is COMPLEX*16 array, dimension (N)
                     53: *>         On the final return, V = A*W,  where  EST = norm(V)/norm(W)
                     54: *>         (W is not returned).
                     55: *> \endverbatim
                     56: *>
                     57: *> \param[in,out] X
                     58: *> \verbatim
                     59: *>          X is COMPLEX*16 array, dimension (N)
                     60: *>         On an intermediate return, X should be overwritten by
                     61: *>               A * X,   if KASE=1,
                     62: *>               A**H * X,  if KASE=2,
                     63: *>         where A**H is the conjugate transpose of A, and ZLACON must be
                     64: *>         re-called with all the other parameters unchanged.
                     65: *> \endverbatim
                     66: *>
                     67: *> \param[in,out] EST
                     68: *> \verbatim
                     69: *>          EST is DOUBLE PRECISION
                     70: *>         On entry with KASE = 1 or 2 and JUMP = 3, EST should be
                     71: *>         unchanged from the previous call to ZLACON.
1.16      bertrand   72: *>         On exit, EST is an estimate (a lower bound) for norm(A).
1.9       bertrand   73: *> \endverbatim
                     74: *>
                     75: *> \param[in,out] KASE
                     76: *> \verbatim
                     77: *>          KASE is INTEGER
                     78: *>         On the initial call to ZLACON, KASE should be 0.
                     79: *>         On an intermediate return, KASE will be 1 or 2, indicating
                     80: *>         whether X should be overwritten by A * X  or A**H * X.
                     81: *>         On the final return from ZLACON, KASE will again be 0.
                     82: *> \endverbatim
                     83: *
                     84: *  Authors:
                     85: *  ========
                     86: *
1.16      bertrand   87: *> \author Univ. of Tennessee
                     88: *> \author Univ. of California Berkeley
                     89: *> \author Univ. of Colorado Denver
                     90: *> \author NAG Ltd.
1.9       bertrand   91: *
                     92: *> \ingroup complex16OTHERauxiliary
                     93: *
                     94: *> \par Further Details:
                     95: *  =====================
                     96: *>
                     97: *>  Originally named CONEST, dated March 16, 1988. \n
                     98: *>  Last modified:  April, 1999
                     99: *
                    100: *> \par Contributors:
                    101: *  ==================
                    102: *>
                    103: *>     Nick Higham, University of Manchester
                    104: *
                    105: *> \par References:
                    106: *  ================
                    107: *>
                    108: *>  N.J. Higham, "FORTRAN codes for estimating the one-norm of
                    109: *>  a real or complex matrix, with applications to condition estimation",
                    110: *>  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
                    111: *>
                    112: *  =====================================================================
1.1       bertrand  113:       SUBROUTINE ZLACON( N, V, X, EST, KASE )
                    114: *
1.19    ! bertrand  115: *  -- LAPACK auxiliary routine --
1.1       bertrand  116: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    117: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    118: *
                    119: *     .. Scalar Arguments ..
                    120:       INTEGER            KASE, N
                    121:       DOUBLE PRECISION   EST
                    122: *     ..
                    123: *     .. Array Arguments ..
                    124:       COMPLEX*16         V( N ), X( N )
                    125: *     ..
                    126: *
                    127: *  =====================================================================
                    128: *
                    129: *     .. Parameters ..
                    130:       INTEGER            ITMAX
                    131:       PARAMETER          ( ITMAX = 5 )
                    132:       DOUBLE PRECISION   ONE, TWO
                    133:       PARAMETER          ( ONE = 1.0D0, TWO = 2.0D0 )
                    134:       COMPLEX*16         CZERO, CONE
                    135:       PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
                    136:      $                   CONE = ( 1.0D0, 0.0D0 ) )
                    137: *     ..
                    138: *     .. Local Scalars ..
                    139:       INTEGER            I, ITER, J, JLAST, JUMP
                    140:       DOUBLE PRECISION   ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP
                    141: *     ..
                    142: *     .. External Functions ..
                    143:       INTEGER            IZMAX1
                    144:       DOUBLE PRECISION   DLAMCH, DZSUM1
                    145:       EXTERNAL           IZMAX1, DLAMCH, DZSUM1
                    146: *     ..
                    147: *     .. External Subroutines ..
                    148:       EXTERNAL           ZCOPY
                    149: *     ..
                    150: *     .. Intrinsic Functions ..
                    151:       INTRINSIC          ABS, DBLE, DCMPLX, DIMAG
                    152: *     ..
                    153: *     .. Save statement ..
                    154:       SAVE
                    155: *     ..
                    156: *     .. Executable Statements ..
                    157: *
                    158:       SAFMIN = DLAMCH( 'Safe minimum' )
                    159:       IF( KASE.EQ.0 ) THEN
                    160:          DO 10 I = 1, N
                    161:             X( I ) = DCMPLX( ONE / DBLE( N ) )
                    162:    10    CONTINUE
                    163:          KASE = 1
                    164:          JUMP = 1
                    165:          RETURN
                    166:       END IF
                    167: *
                    168:       GO TO ( 20, 40, 70, 90, 120 )JUMP
                    169: *
                    170: *     ................ ENTRY   (JUMP = 1)
                    171: *     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
                    172: *
                    173:    20 CONTINUE
                    174:       IF( N.EQ.1 ) THEN
                    175:          V( 1 ) = X( 1 )
                    176:          EST = ABS( V( 1 ) )
                    177: *        ... QUIT
                    178:          GO TO 130
                    179:       END IF
                    180:       EST = DZSUM1( N, X, 1 )
                    181: *
                    182:       DO 30 I = 1, N
                    183:          ABSXI = ABS( X( I ) )
                    184:          IF( ABSXI.GT.SAFMIN ) THEN
                    185:             X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
                    186:      $               DIMAG( X( I ) ) / ABSXI )
                    187:          ELSE
                    188:             X( I ) = CONE
                    189:          END IF
                    190:    30 CONTINUE
                    191:       KASE = 2
                    192:       JUMP = 2
                    193:       RETURN
                    194: *
                    195: *     ................ ENTRY   (JUMP = 2)
                    196: *     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
                    197: *
                    198:    40 CONTINUE
                    199:       J = IZMAX1( N, X, 1 )
                    200:       ITER = 2
                    201: *
                    202: *     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
                    203: *
                    204:    50 CONTINUE
                    205:       DO 60 I = 1, N
                    206:          X( I ) = CZERO
                    207:    60 CONTINUE
                    208:       X( J ) = CONE
                    209:       KASE = 1
                    210:       JUMP = 3
                    211:       RETURN
                    212: *
                    213: *     ................ ENTRY   (JUMP = 3)
                    214: *     X HAS BEEN OVERWRITTEN BY A*X.
                    215: *
                    216:    70 CONTINUE
                    217:       CALL ZCOPY( N, X, 1, V, 1 )
                    218:       ESTOLD = EST
                    219:       EST = DZSUM1( N, V, 1 )
                    220: *
                    221: *     TEST FOR CYCLING.
                    222:       IF( EST.LE.ESTOLD )
                    223:      $   GO TO 100
                    224: *
                    225:       DO 80 I = 1, N
                    226:          ABSXI = ABS( X( I ) )
                    227:          IF( ABSXI.GT.SAFMIN ) THEN
                    228:             X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
                    229:      $               DIMAG( X( I ) ) / ABSXI )
                    230:          ELSE
                    231:             X( I ) = CONE
                    232:          END IF
                    233:    80 CONTINUE
                    234:       KASE = 2
                    235:       JUMP = 4
                    236:       RETURN
                    237: *
                    238: *     ................ ENTRY   (JUMP = 4)
                    239: *     X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
                    240: *
                    241:    90 CONTINUE
                    242:       JLAST = J
                    243:       J = IZMAX1( N, X, 1 )
                    244:       IF( ( ABS( X( JLAST ) ).NE.ABS( X( J ) ) ) .AND.
                    245:      $    ( ITER.LT.ITMAX ) ) THEN
                    246:          ITER = ITER + 1
                    247:          GO TO 50
                    248:       END IF
                    249: *
                    250: *     ITERATION COMPLETE.  FINAL STAGE.
                    251: *
                    252:   100 CONTINUE
                    253:       ALTSGN = ONE
                    254:       DO 110 I = 1, N
                    255:          X( I ) = DCMPLX( ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) ) )
                    256:          ALTSGN = -ALTSGN
                    257:   110 CONTINUE
                    258:       KASE = 1
                    259:       JUMP = 5
                    260:       RETURN
                    261: *
                    262: *     ................ ENTRY   (JUMP = 5)
                    263: *     X HAS BEEN OVERWRITTEN BY A*X.
                    264: *
                    265:   120 CONTINUE
                    266:       TEMP = TWO*( DZSUM1( N, X, 1 ) / DBLE( 3*N ) )
                    267:       IF( TEMP.GT.EST ) THEN
                    268:          CALL ZCOPY( N, X, 1, V, 1 )
                    269:          EST = TEMP
                    270:       END IF
                    271: *
                    272:   130 CONTINUE
                    273:       KASE = 0
                    274:       RETURN
                    275: *
                    276: *     End of ZLACON
                    277: *
                    278:       END

CVSweb interface <joel.bertrand@systella.fr>