File:  [local] / rpl / lapack / lapack / zgebak.f
Revision 1.18: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:16 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    1: *> \brief \b ZGEBAK
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download ZGEBAK + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgebak.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgebak.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgebak.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
   22: *                          INFO )
   23: *
   24: *       .. Scalar Arguments ..
   25: *       CHARACTER          JOB, SIDE
   26: *       INTEGER            IHI, ILO, INFO, LDV, M, N
   27: *       ..
   28: *       .. Array Arguments ..
   29: *       DOUBLE PRECISION   SCALE( * )
   30: *       COMPLEX*16         V( LDV, * )
   31: *       ..
   32: *
   33: *
   34: *> \par Purpose:
   35: *  =============
   36: *>
   37: *> \verbatim
   38: *>
   39: *> ZGEBAK forms the right or left eigenvectors of a complex general
   40: *> matrix by backward transformation on the computed eigenvectors of the
   41: *> balanced matrix output by ZGEBAL.
   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 ZGEBAL.
   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 ZGEBAL.
   81: *>          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
   82: *> \endverbatim
   83: *>
   84: *> \param[in] SCALE
   85: *> \verbatim
   86: *>          SCALE is DOUBLE PRECISION array, dimension (N)
   87: *>          Details of the permutation and scaling factors, as returned
   88: *>          by ZGEBAL.
   89: *> \endverbatim
   90: *>
   91: *> \param[in] M
   92: *> \verbatim
   93: *>          M is INTEGER
   94: *>          The number of columns of the matrix V.  M >= 0.
   95: *> \endverbatim
   96: *>
   97: *> \param[in,out] V
   98: *> \verbatim
   99: *>          V is COMPLEX*16 array, dimension (LDV,M)
  100: *>          On entry, the matrix of right or left eigenvectors to be
  101: *>          transformed, as returned by ZHSEIN or ZTREVC.
  102: *>          On exit, V is overwritten by the transformed eigenvectors.
  103: *> \endverbatim
  104: *>
  105: *> \param[in] LDV
  106: *> \verbatim
  107: *>          LDV is INTEGER
  108: *>          The leading dimension of the array V. LDV >= max(1,N).
  109: *> \endverbatim
  110: *>
  111: *> \param[out] INFO
  112: *> \verbatim
  113: *>          INFO is INTEGER
  114: *>          = 0:  successful exit
  115: *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
  116: *> \endverbatim
  117: *
  118: *  Authors:
  119: *  ========
  120: *
  121: *> \author Univ. of Tennessee
  122: *> \author Univ. of California Berkeley
  123: *> \author Univ. of Colorado Denver
  124: *> \author NAG Ltd.
  125: *
  126: *> \ingroup complex16GEcomputational
  127: *
  128: *  =====================================================================
  129:       SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
  130:      $                   INFO )
  131: *
  132: *  -- LAPACK computational routine --
  133: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  134: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  135: *
  136: *     .. Scalar Arguments ..
  137:       CHARACTER          JOB, SIDE
  138:       INTEGER            IHI, ILO, INFO, LDV, M, N
  139: *     ..
  140: *     .. Array Arguments ..
  141:       DOUBLE PRECISION   SCALE( * )
  142:       COMPLEX*16         V( LDV, * )
  143: *     ..
  144: *
  145: *  =====================================================================
  146: *
  147: *     .. Parameters ..
  148:       DOUBLE PRECISION   ONE
  149:       PARAMETER          ( ONE = 1.0D+0 )
  150: *     ..
  151: *     .. Local Scalars ..
  152:       LOGICAL            LEFTV, RIGHTV
  153:       INTEGER            I, II, K
  154:       DOUBLE PRECISION   S
  155: *     ..
  156: *     .. External Functions ..
  157:       LOGICAL            LSAME
  158:       EXTERNAL           LSAME
  159: *     ..
  160: *     .. External Subroutines ..
  161:       EXTERNAL           XERBLA, ZDSCAL, ZSWAP
  162: *     ..
  163: *     .. Intrinsic Functions ..
  164:       INTRINSIC          MAX, MIN
  165: *     ..
  166: *     .. Executable Statements ..
  167: *
  168: *     Decode and Test the input parameters
  169: *
  170:       RIGHTV = LSAME( SIDE, 'R' )
  171:       LEFTV = LSAME( SIDE, 'L' )
  172: *
  173:       INFO = 0
  174:       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
  175:      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
  176:          INFO = -1
  177:       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
  178:          INFO = -2
  179:       ELSE IF( N.LT.0 ) THEN
  180:          INFO = -3
  181:       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
  182:          INFO = -4
  183:       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
  184:          INFO = -5
  185:       ELSE IF( M.LT.0 ) THEN
  186:          INFO = -7
  187:       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
  188:          INFO = -9
  189:       END IF
  190:       IF( INFO.NE.0 ) THEN
  191:          CALL XERBLA( 'ZGEBAK', -INFO )
  192:          RETURN
  193:       END IF
  194: *
  195: *     Quick return if possible
  196: *
  197:       IF( N.EQ.0 )
  198:      $   RETURN
  199:       IF( M.EQ.0 )
  200:      $   RETURN
  201:       IF( LSAME( JOB, 'N' ) )
  202:      $   RETURN
  203: *
  204:       IF( ILO.EQ.IHI )
  205:      $   GO TO 30
  206: *
  207: *     Backward balance
  208: *
  209:       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
  210: *
  211:          IF( RIGHTV ) THEN
  212:             DO 10 I = ILO, IHI
  213:                S = SCALE( I )
  214:                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
  215:    10       CONTINUE
  216:          END IF
  217: *
  218:          IF( LEFTV ) THEN
  219:             DO 20 I = ILO, IHI
  220:                S = ONE / SCALE( I )
  221:                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
  222:    20       CONTINUE
  223:          END IF
  224: *
  225:       END IF
  226: *
  227: *     Backward permutation
  228: *
  229: *     For  I = ILO-1 step -1 until 1,
  230: *              IHI+1 step 1 until N do --
  231: *
  232:    30 CONTINUE
  233:       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
  234:          IF( RIGHTV ) THEN
  235:             DO 40 II = 1, N
  236:                I = II
  237:                IF( I.GE.ILO .AND. I.LE.IHI )
  238:      $            GO TO 40
  239:                IF( I.LT.ILO )
  240:      $            I = ILO - II
  241:                K = INT( SCALE( I ) )
  242:                IF( K.EQ.I )
  243:      $            GO TO 40
  244:                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  245:    40       CONTINUE
  246:          END IF
  247: *
  248:          IF( LEFTV ) THEN
  249:             DO 50 II = 1, N
  250:                I = II
  251:                IF( I.GE.ILO .AND. I.LE.IHI )
  252:      $            GO TO 50
  253:                IF( I.LT.ILO )
  254:      $            I = ILO - II
  255:                K = INT( SCALE( I ) )
  256:                IF( K.EQ.I )
  257:      $            GO TO 50
  258:                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  259:    50       CONTINUE
  260:          END IF
  261:       END IF
  262: *
  263:       RETURN
  264: *
  265: *     End of ZGEBAK
  266: *
  267:       END

CVSweb interface <joel.bertrand@systella.fr>