Return to zgebak.f CVS log

Up to [local] / rpl / lapack / lapack

Mise à jour globale de Lapack 3.2.2.

    1:       SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
    2:      $                   INFO )
    3: *
    4: *  -- LAPACK routine (version 3.2) --
    5: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    6: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    7: *     November 2006
    8: *
    9: *     .. Scalar Arguments ..
   10:       CHARACTER          JOB, SIDE
   11:       INTEGER            IHI, ILO, INFO, LDV, M, N
   12: *     ..
   13: *     .. Array Arguments ..
   14:       DOUBLE PRECISION   SCALE( * )
   15:       COMPLEX*16         V( LDV, * )
   16: *     ..
   17: *
   18: *  Purpose
   19: *  =======
   20: *
   21: *  ZGEBAK forms the right or left eigenvectors of a complex general
   22: *  matrix by backward transformation on the computed eigenvectors of the
   23: *  balanced matrix output by ZGEBAL.
   24: *
   25: *  Arguments
   26: *  =========
   27: *
   28: *  JOB     (input) CHARACTER*1
   29: *          Specifies the type of backward transformation required:
   30: *          = 'N', do nothing, return immediately;
   31: *          = 'P', do backward transformation for permutation only;
   32: *          = 'S', do backward transformation for scaling only;
   33: *          = 'B', do backward transformations for both permutation and
   34: *                 scaling.
   35: *          JOB must be the same as the argument JOB supplied to ZGEBAL.
   36: *
   37: *  SIDE    (input) CHARACTER*1
   38: *          = 'R':  V contains right eigenvectors;
   39: *          = 'L':  V contains left eigenvectors.
   40: *
   41: *  N       (input) INTEGER
   42: *          The number of rows of the matrix V.  N >= 0.
   43: *
   44: *  ILO     (input) INTEGER
   45: *  IHI     (input) INTEGER
   46: *          The integers ILO and IHI determined by ZGEBAL.
   47: *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
   48: *
   49: *  SCALE   (input) DOUBLE PRECISION array, dimension (N)
   50: *          Details of the permutation and scaling factors, as returned
   51: *          by ZGEBAL.
   52: *
   53: *  M       (input) INTEGER
   54: *          The number of columns of the matrix V.  M >= 0.
   55: *
   56: *  V       (input/output) COMPLEX*16 array, dimension (LDV,M)
   57: *          On entry, the matrix of right or left eigenvectors to be
   58: *          transformed, as returned by ZHSEIN or ZTREVC.
   59: *          On exit, V is overwritten by the transformed eigenvectors.
   60: *
   61: *  LDV     (input) INTEGER
   62: *          The leading dimension of the array V. LDV >= max(1,N).
   63: *
   64: *  INFO    (output) INTEGER
   65: *          = 0:  successful exit
   66: *          < 0:  if INFO = -i, the i-th argument had an illegal value.
   67: *
   68: *  =====================================================================
   69: *
   70: *     .. Parameters ..
   71:       DOUBLE PRECISION   ONE
   72:       PARAMETER          ( ONE = 1.0D+0 )
   73: *     ..
   74: *     .. Local Scalars ..
   75:       LOGICAL            LEFTV, RIGHTV
   76:       INTEGER            I, II, K
   77:       DOUBLE PRECISION   S
   78: *     ..
   79: *     .. External Functions ..
   80:       LOGICAL            LSAME
   81:       EXTERNAL           LSAME
   82: *     ..
   83: *     .. External Subroutines ..
   84:       EXTERNAL           XERBLA, ZDSCAL, ZSWAP
   85: *     ..
   86: *     .. Intrinsic Functions ..
   87:       INTRINSIC          MAX, MIN
   88: *     ..
   89: *     .. Executable Statements ..
   90: *
   91: *     Decode and Test the input parameters
   92: *
   93:       RIGHTV = LSAME( SIDE, 'R' )
   94:       LEFTV = LSAME( SIDE, 'L' )
   95: *
   96:       INFO = 0
   97:       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
   98:      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
   99:          INFO = -1
  100:       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
  101:          INFO = -2
  102:       ELSE IF( N.LT.0 ) THEN
  103:          INFO = -3
  104:       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
  105:          INFO = -4
  106:       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
  107:          INFO = -5
  108:       ELSE IF( M.LT.0 ) THEN
  109:          INFO = -7
  110:       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
  111:          INFO = -9
  112:       END IF
  113:       IF( INFO.NE.0 ) THEN
  114:          CALL XERBLA( 'ZGEBAK', -INFO )
  115:          RETURN
  116:       END IF
  117: *
  118: *     Quick return if possible
  119: *
  120:       IF( N.EQ.0 )
  121:      $   RETURN
  122:       IF( M.EQ.0 )
  123:      $   RETURN
  124:       IF( LSAME( JOB, 'N' ) )
  125:      $   RETURN
  126: *
  127:       IF( ILO.EQ.IHI )
  128:      $   GO TO 30
  129: *
  130: *     Backward balance
  131: *
  132:       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
  133: *
  134:          IF( RIGHTV ) THEN
  135:             DO 10 I = ILO, IHI
  136:                S = SCALE( I )
  137:                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
  138:    10       CONTINUE
  139:          END IF
  140: *
  141:          IF( LEFTV ) THEN
  142:             DO 20 I = ILO, IHI
  143:                S = ONE / SCALE( I )
  144:                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
  145:    20       CONTINUE
  146:          END IF
  147: *
  148:       END IF
  149: *
  150: *     Backward permutation
  151: *
  152: *     For  I = ILO-1 step -1 until 1,
  153: *              IHI+1 step 1 until N do --
  154: *
  155:    30 CONTINUE
  156:       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
  157:          IF( RIGHTV ) THEN
  158:             DO 40 II = 1, N
  159:                I = II
  160:                IF( I.GE.ILO .AND. I.LE.IHI )
  161:      $            GO TO 40
  162:                IF( I.LT.ILO )
  163:      $            I = ILO - II
  164:                K = SCALE( I )
  165:                IF( K.EQ.I )
  166:      $            GO TO 40
  167:                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  168:    40       CONTINUE
  169:          END IF
  170: *
  171:          IF( LEFTV ) THEN
  172:             DO 50 II = 1, N
  173:                I = II
  174:                IF( I.GE.ILO .AND. I.LE.IHI )
  175:      $            GO TO 50
  176:                IF( I.LT.ILO )
  177:      $            I = ILO - II
  178:                K = SCALE( I )
  179:                IF( K.EQ.I )
  180:      $            GO TO 50
  181:                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  182:    50       CONTINUE
  183:          END IF
  184:       END IF
  185: *
  186:       RETURN
  187: *
  188: *     End of ZGEBAK
  189: *
  190:       END