Return to dggbak.f CVS log

Up to [local] / rpl / lapack / lapack

Cohérence

    1:       SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
    2:      $                   LDV, 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   LSCALE( * ), RSCALE( * ), V( LDV, * )
   15: *     ..
   16: *
   17: *  Purpose
   18: *  =======
   19: *
   20: *  DGGBAK forms the right or left eigenvectors of a real generalized
   21: *  eigenvalue problem A*x = lambda*B*x, by backward transformation on
   22: *  the computed eigenvectors of the balanced pair of matrices output by
   23: *  DGGBAL.
   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 DGGBAL.
   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 DGGBAL.
   47: *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
   48: *
   49: *  LSCALE  (input) DOUBLE PRECISION array, dimension (N)
   50: *          Details of the permutations and/or scaling factors applied
   51: *          to the left side of A and B, as returned by DGGBAL.
   52: *
   53: *  RSCALE  (input) DOUBLE PRECISION array, dimension (N)
   54: *          Details of the permutations and/or scaling factors applied
   55: *          to the right side of A and B, as returned by DGGBAL.
   56: *
   57: *  M       (input) INTEGER
   58: *          The number of columns of the matrix V.  M >= 0.
   59: *
   60: *  V       (input/output) DOUBLE PRECISION array, dimension (LDV,M)
   61: *          On entry, the matrix of right or left eigenvectors to be
   62: *          transformed, as returned by DTGEVC.
   63: *          On exit, V is overwritten by the transformed eigenvectors.
   64: *
   65: *  LDV     (input) INTEGER
   66: *          The leading dimension of the matrix V. LDV >= max(1,N).
   67: *
   68: *  INFO    (output) INTEGER
   69: *          = 0:  successful exit.
   70: *          < 0:  if INFO = -i, the i-th argument had an illegal value.
   71: *
   72: *  Further Details
   73: *  ===============
   74: *
   75: *  See R.C. Ward, Balancing the generalized eigenvalue problem,
   76: *                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
   77: *
   78: *  =====================================================================
   79: *
   80: *     .. Local Scalars ..
   81:       LOGICAL            LEFTV, RIGHTV
   82:       INTEGER            I, K
   83: *     ..
   84: *     .. External Functions ..
   85:       LOGICAL            LSAME
   86:       EXTERNAL           LSAME
   87: *     ..
   88: *     .. External Subroutines ..
   89:       EXTERNAL           DSCAL, DSWAP, XERBLA
   90: *     ..
   91: *     .. Intrinsic Functions ..
   92:       INTRINSIC          MAX
   93: *     ..
   94: *     .. Executable Statements ..
   95: *
   96: *     Test the input parameters
   97: *
   98:       RIGHTV = LSAME( SIDE, 'R' )
   99:       LEFTV = LSAME( SIDE, 'L' )
  100: *
  101:       INFO = 0
  102:       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
  103:      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
  104:          INFO = -1
  105:       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
  106:          INFO = -2
  107:       ELSE IF( N.LT.0 ) THEN
  108:          INFO = -3
  109:       ELSE IF( ILO.LT.1 ) THEN
  110:          INFO = -4
  111:       ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
  112:          INFO = -4
  113:       ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
  114:      $   THEN
  115:          INFO = -5
  116:       ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
  117:          INFO = -5
  118:       ELSE IF( M.LT.0 ) THEN
  119:          INFO = -8
  120:       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
  121:          INFO = -10
  122:       END IF
  123:       IF( INFO.NE.0 ) THEN
  124:          CALL XERBLA( 'DGGBAK', -INFO )
  125:          RETURN
  126:       END IF
  127: *
  128: *     Quick return if possible
  129: *
  130:       IF( N.EQ.0 )
  131:      $   RETURN
  132:       IF( M.EQ.0 )
  133:      $   RETURN
  134:       IF( LSAME( JOB, 'N' ) )
  135:      $   RETURN
  136: *
  137:       IF( ILO.EQ.IHI )
  138:      $   GO TO 30
  139: *
  140: *     Backward balance
  141: *
  142:       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
  143: *
  144: *        Backward transformation on right eigenvectors
  145: *
  146:          IF( RIGHTV ) THEN
  147:             DO 10 I = ILO, IHI
  148:                CALL DSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
  149:    10       CONTINUE
  150:          END IF
  151: *
  152: *        Backward transformation on left eigenvectors
  153: *
  154:          IF( LEFTV ) THEN
  155:             DO 20 I = ILO, IHI
  156:                CALL DSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
  157:    20       CONTINUE
  158:          END IF
  159:       END IF
  160: *
  161: *     Backward permutation
  162: *
  163:    30 CONTINUE
  164:       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
  165: *
  166: *        Backward permutation on right eigenvectors
  167: *
  168:          IF( RIGHTV ) THEN
  169:             IF( ILO.EQ.1 )
  170:      $         GO TO 50
  171: *
  172:             DO 40 I = ILO - 1, 1, -1
  173:                K = RSCALE( I )
  174:                IF( K.EQ.I )
  175:      $            GO TO 40
  176:                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  177:    40       CONTINUE
  178: *
  179:    50       CONTINUE
  180:             IF( IHI.EQ.N )
  181:      $         GO TO 70
  182:             DO 60 I = IHI + 1, N
  183:                K = RSCALE( I )
  184:                IF( K.EQ.I )
  185:      $            GO TO 60
  186:                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  187:    60       CONTINUE
  188:          END IF
  189: *
  190: *        Backward permutation on left eigenvectors
  191: *
  192:    70    CONTINUE
  193:          IF( LEFTV ) THEN
  194:             IF( ILO.EQ.1 )
  195:      $         GO TO 90
  196:             DO 80 I = ILO - 1, 1, -1
  197:                K = LSCALE( I )
  198:                IF( K.EQ.I )
  199:      $            GO TO 80
  200:                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  201:    80       CONTINUE
  202: *
  203:    90       CONTINUE
  204:             IF( IHI.EQ.N )
  205:      $         GO TO 110
  206:             DO 100 I = IHI + 1, N
  207:                K = LSCALE( I )
  208:                IF( K.EQ.I )
  209:      $            GO TO 100
  210:                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  211:   100       CONTINUE
  212:          END IF
  213:       END IF
  214: *
  215:   110 CONTINUE
  216: *
  217:       RETURN
  218: *
  219: *     End of DGGBAK
  220: *
  221:       END