Return to dggbak.f CVS log

Up to [local] / rpl / lapack / lapack

Cohérence.

    1: *> \brief \b DGGBAK
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download DGGBAK + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggbak.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dggbak.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggbak.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
   22: *                          LDV, INFO )
   23: * 
   24: *       .. Scalar Arguments ..
   25: *       CHARACTER          JOB, SIDE
   26: *       INTEGER            IHI, ILO, INFO, LDV, M, N
   27: *       ..
   28: *       .. Array Arguments ..
   29: *       DOUBLE PRECISION   LSCALE( * ), RSCALE( * ), V( LDV, * )
   30: *       ..
   31: *  
   32: *
   33: *> \par Purpose:
   34: *  =============
   35: *>
   36: *> \verbatim
   37: *>
   38: *> DGGBAK forms the right or left eigenvectors of a real generalized
   39: *> eigenvalue problem A*x = lambda*B*x, by backward transformation on
   40: *> the computed eigenvectors of the balanced pair of matrices output by
   41: *> DGGBAL.
   42: *> \endverbatim
   43: *
   44: *  Arguments:
   45: *  ==========
   46: *
   47: *> \param[in] JOB
   48: *> \verbatim
   49: *>          JOB is CHARACTER*1
   50: *>          Specifies the type of backward transformation required:
   51: *>          = 'N':  do nothing, return immediately;
   52: *>          = 'P':  do backward transformation for permutation only;
   53: *>          = 'S':  do backward transformation for scaling only;
   54: *>          = 'B':  do backward transformations for both permutation and
   55: *>                  scaling.
   56: *>          JOB must be the same as the argument JOB supplied to DGGBAL.
   57: *> \endverbatim
   58: *>
   59: *> \param[in] SIDE
   60: *> \verbatim
   61: *>          SIDE is CHARACTER*1
   62: *>          = 'R':  V contains right eigenvectors;
   63: *>          = 'L':  V contains left eigenvectors.
   64: *> \endverbatim
   65: *>
   66: *> \param[in] N
   67: *> \verbatim
   68: *>          N is INTEGER
   69: *>          The number of rows of the matrix V.  N >= 0.
   70: *> \endverbatim
   71: *>
   72: *> \param[in] ILO
   73: *> \verbatim
   74: *>          ILO is INTEGER
   75: *> \endverbatim
   76: *>
   77: *> \param[in] IHI
   78: *> \verbatim
   79: *>          IHI is INTEGER
   80: *>          The integers ILO and IHI determined by DGGBAL.
   81: *>          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
   82: *> \endverbatim
   83: *>
   84: *> \param[in] LSCALE
   85: *> \verbatim
   86: *>          LSCALE is DOUBLE PRECISION array, dimension (N)
   87: *>          Details of the permutations and/or scaling factors applied
   88: *>          to the left side of A and B, as returned by DGGBAL.
   89: *> \endverbatim
   90: *>
   91: *> \param[in] RSCALE
   92: *> \verbatim
   93: *>          RSCALE is DOUBLE PRECISION array, dimension (N)
   94: *>          Details of the permutations and/or scaling factors applied
   95: *>          to the right side of A and B, as returned by DGGBAL.
   96: *> \endverbatim
   97: *>
   98: *> \param[in] M
   99: *> \verbatim
  100: *>          M is INTEGER
  101: *>          The number of columns of the matrix V.  M >= 0.
  102: *> \endverbatim
  103: *>
  104: *> \param[in,out] V
  105: *> \verbatim
  106: *>          V is DOUBLE PRECISION array, dimension (LDV,M)
  107: *>          On entry, the matrix of right or left eigenvectors to be
  108: *>          transformed, as returned by DTGEVC.
  109: *>          On exit, V is overwritten by the transformed eigenvectors.
  110: *> \endverbatim
  111: *>
  112: *> \param[in] LDV
  113: *> \verbatim
  114: *>          LDV is INTEGER
  115: *>          The leading dimension of the matrix V. LDV >= max(1,N).
  116: *> \endverbatim
  117: *>
  118: *> \param[out] INFO
  119: *> \verbatim
  120: *>          INFO is INTEGER
  121: *>          = 0:  successful exit.
  122: *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
  123: *> \endverbatim
  124: *
  125: *  Authors:
  126: *  ========
  127: *
  128: *> \author Univ. of Tennessee 
  129: *> \author Univ. of California Berkeley 
  130: *> \author Univ. of Colorado Denver 
  131: *> \author NAG Ltd. 
  132: *
  133: *> \date November 2011
  134: *
  135: *> \ingroup doubleGBcomputational
  136: *
  137: *> \par Further Details:
  138: *  =====================
  139: *>
  140: *> \verbatim
  141: *>
  142: *>  See R.C. Ward, Balancing the generalized eigenvalue problem,
  143: *>                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
  144: *> \endverbatim
  145: *>
  146: *  =====================================================================
  147:       SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
  148:      $                   LDV, INFO )
  149: *
  150: *  -- LAPACK computational routine (version 3.4.0) --
  151: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  152: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  153: *     November 2011
  154: *
  155: *     .. Scalar Arguments ..
  156:       CHARACTER          JOB, SIDE
  157:       INTEGER            IHI, ILO, INFO, LDV, M, N
  158: *     ..
  159: *     .. Array Arguments ..
  160:       DOUBLE PRECISION   LSCALE( * ), RSCALE( * ), V( LDV, * )
  161: *     ..
  162: *
  163: *  =====================================================================
  164: *
  165: *     .. Local Scalars ..
  166:       LOGICAL            LEFTV, RIGHTV
  167:       INTEGER            I, K
  168: *     ..
  169: *     .. External Functions ..
  170:       LOGICAL            LSAME
  171:       EXTERNAL           LSAME
  172: *     ..
  173: *     .. External Subroutines ..
  174:       EXTERNAL           DSCAL, DSWAP, XERBLA
  175: *     ..
  176: *     .. Intrinsic Functions ..
  177:       INTRINSIC          MAX
  178: *     ..
  179: *     .. Executable Statements ..
  180: *
  181: *     Test the input parameters
  182: *
  183:       RIGHTV = LSAME( SIDE, 'R' )
  184:       LEFTV = LSAME( SIDE, 'L' )
  185: *
  186:       INFO = 0
  187:       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
  188:      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
  189:          INFO = -1
  190:       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
  191:          INFO = -2
  192:       ELSE IF( N.LT.0 ) THEN
  193:          INFO = -3
  194:       ELSE IF( ILO.LT.1 ) THEN
  195:          INFO = -4
  196:       ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
  197:          INFO = -4
  198:       ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
  199:      $   THEN
  200:          INFO = -5
  201:       ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
  202:          INFO = -5
  203:       ELSE IF( M.LT.0 ) THEN
  204:          INFO = -8
  205:       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
  206:          INFO = -10
  207:       END IF
  208:       IF( INFO.NE.0 ) THEN
  209:          CALL XERBLA( 'DGGBAK', -INFO )
  210:          RETURN
  211:       END IF
  212: *
  213: *     Quick return if possible
  214: *
  215:       IF( N.EQ.0 )
  216:      $   RETURN
  217:       IF( M.EQ.0 )
  218:      $   RETURN
  219:       IF( LSAME( JOB, 'N' ) )
  220:      $   RETURN
  221: *
  222:       IF( ILO.EQ.IHI )
  223:      $   GO TO 30
  224: *
  225: *     Backward balance
  226: *
  227:       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
  228: *
  229: *        Backward transformation on right eigenvectors
  230: *
  231:          IF( RIGHTV ) THEN
  232:             DO 10 I = ILO, IHI
  233:                CALL DSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
  234:    10       CONTINUE
  235:          END IF
  236: *
  237: *        Backward transformation on left eigenvectors
  238: *
  239:          IF( LEFTV ) THEN
  240:             DO 20 I = ILO, IHI
  241:                CALL DSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
  242:    20       CONTINUE
  243:          END IF
  244:       END IF
  245: *
  246: *     Backward permutation
  247: *
  248:    30 CONTINUE
  249:       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
  250: *
  251: *        Backward permutation on right eigenvectors
  252: *
  253:          IF( RIGHTV ) THEN
  254:             IF( ILO.EQ.1 )
  255:      $         GO TO 50
  256: *
  257:             DO 40 I = ILO - 1, 1, -1
  258:                K = RSCALE( I )
  259:                IF( K.EQ.I )
  260:      $            GO TO 40
  261:                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  262:    40       CONTINUE
  263: *
  264:    50       CONTINUE
  265:             IF( IHI.EQ.N )
  266:      $         GO TO 70
  267:             DO 60 I = IHI + 1, N
  268:                K = RSCALE( I )
  269:                IF( K.EQ.I )
  270:      $            GO TO 60
  271:                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  272:    60       CONTINUE
  273:          END IF
  274: *
  275: *        Backward permutation on left eigenvectors
  276: *
  277:    70    CONTINUE
  278:          IF( LEFTV ) THEN
  279:             IF( ILO.EQ.1 )
  280:      $         GO TO 90
  281:             DO 80 I = ILO - 1, 1, -1
  282:                K = LSCALE( I )
  283:                IF( K.EQ.I )
  284:      $            GO TO 80
  285:                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  286:    80       CONTINUE
  287: *
  288:    90       CONTINUE
  289:             IF( IHI.EQ.N )
  290:      $         GO TO 110
  291:             DO 100 I = IHI + 1, N
  292:                K = LSCALE( I )
  293:                IF( K.EQ.I )
  294:      $            GO TO 100
  295:                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  296:   100       CONTINUE
  297:          END IF
  298:       END IF
  299: *
  300:   110 CONTINUE
  301: *
  302:       RETURN
  303: *
  304: *     End of DGGBAK
  305: *
  306:       END