File:  [local] / rpl / lapack / lapack / zggev3.f
Revision 1.2: download - view: text, annotated - select for diffs - revision graph
Sat Aug 27 15:27:12 2016 UTC (7 years, 8 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD

Mise à jour de lapack.

    1: *> \brief <b> ZGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm)</b>
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download ZGGEV3 + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zggev3.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zggev3.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zggev3.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
   22: *                          VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO )
   23: *
   24: *       .. Scalar Arguments ..
   25: *       CHARACTER          JOBVL, JOBVR
   26: *       INTEGER            INFO, LDA, LDB, LDVL, LDVR, LWORK, N
   27: *       ..
   28: *       .. Array Arguments ..
   29: *       DOUBLE PRECISION   RWORK( * )
   30: *       COMPLEX*16         A( LDA, * ), ALPHA( * ), B( LDB, * ),
   31: *      $                   BETA( * ), VL( LDVL, * ), VR( LDVR, * ),
   32: *      $                   WORK( * )
   33: *       ..
   34: *
   35: *
   36: *> \par Purpose:
   37: *  =============
   38: *>
   39: *> \verbatim
   40: *>
   41: *> ZGGEV3 computes for a pair of N-by-N complex nonsymmetric matrices
   42: *> (A,B), the generalized eigenvalues, and optionally, the left and/or
   43: *> right generalized eigenvectors.
   44: *>
   45: *> A generalized eigenvalue for a pair of matrices (A,B) is a scalar
   46: *> lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
   47: *> singular. It is usually represented as the pair (alpha,beta), as
   48: *> there is a reasonable interpretation for beta=0, and even for both
   49: *> being zero.
   50: *>
   51: *> The right generalized eigenvector v(j) corresponding to the
   52: *> generalized eigenvalue lambda(j) of (A,B) satisfies
   53: *>
   54: *>              A * v(j) = lambda(j) * B * v(j).
   55: *>
   56: *> The left generalized eigenvector u(j) corresponding to the
   57: *> generalized eigenvalues lambda(j) of (A,B) satisfies
   58: *>
   59: *>              u(j)**H * A = lambda(j) * u(j)**H * B
   60: *>
   61: *> where u(j)**H is the conjugate-transpose of u(j).
   62: *> \endverbatim
   63: *
   64: *  Arguments:
   65: *  ==========
   66: *
   67: *> \param[in] JOBVL
   68: *> \verbatim
   69: *>          JOBVL is CHARACTER*1
   70: *>          = 'N':  do not compute the left generalized eigenvectors;
   71: *>          = 'V':  compute the left generalized eigenvectors.
   72: *> \endverbatim
   73: *>
   74: *> \param[in] JOBVR
   75: *> \verbatim
   76: *>          JOBVR is CHARACTER*1
   77: *>          = 'N':  do not compute the right generalized eigenvectors;
   78: *>          = 'V':  compute the right generalized eigenvectors.
   79: *> \endverbatim
   80: *>
   81: *> \param[in] N
   82: *> \verbatim
   83: *>          N is INTEGER
   84: *>          The order of the matrices A, B, VL, and VR.  N >= 0.
   85: *> \endverbatim
   86: *>
   87: *> \param[in,out] A
   88: *> \verbatim
   89: *>          A is COMPLEX*16 array, dimension (LDA, N)
   90: *>          On entry, the matrix A in the pair (A,B).
   91: *>          On exit, A has been overwritten.
   92: *> \endverbatim
   93: *>
   94: *> \param[in] LDA
   95: *> \verbatim
   96: *>          LDA is INTEGER
   97: *>          The leading dimension of A.  LDA >= max(1,N).
   98: *> \endverbatim
   99: *>
  100: *> \param[in,out] B
  101: *> \verbatim
  102: *>          B is COMPLEX*16 array, dimension (LDB, N)
  103: *>          On entry, the matrix B in the pair (A,B).
  104: *>          On exit, B has been overwritten.
  105: *> \endverbatim
  106: *>
  107: *> \param[in] LDB
  108: *> \verbatim
  109: *>          LDB is INTEGER
  110: *>          The leading dimension of B.  LDB >= max(1,N).
  111: *> \endverbatim
  112: *>
  113: *> \param[out] ALPHA
  114: *> \verbatim
  115: *>          ALPHA is COMPLEX*16 array, dimension (N)
  116: *> \endverbatim
  117: *>
  118: *> \param[out] BETA
  119: *> \verbatim
  120: *>          BETA is COMPLEX*16 array, dimension (N)
  121: *>          On exit, ALPHA(j)/BETA(j), j=1,...,N, will be the
  122: *>          generalized eigenvalues.
  123: *>
  124: *>          Note: the quotients ALPHA(j)/BETA(j) may easily over- or
  125: *>          underflow, and BETA(j) may even be zero.  Thus, the user
  126: *>          should avoid naively computing the ratio alpha/beta.
  127: *>          However, ALPHA will be always less than and usually
  128: *>          comparable with norm(A) in magnitude, and BETA always less
  129: *>          than and usually comparable with norm(B).
  130: *> \endverbatim
  131: *>
  132: *> \param[out] VL
  133: *> \verbatim
  134: *>          VL is COMPLEX*16 array, dimension (LDVL,N)
  135: *>          If JOBVL = 'V', the left generalized eigenvectors u(j) are
  136: *>          stored one after another in the columns of VL, in the same
  137: *>          order as their eigenvalues.
  138: *>          Each eigenvector is scaled so the largest component has
  139: *>          abs(real part) + abs(imag. part) = 1.
  140: *>          Not referenced if JOBVL = 'N'.
  141: *> \endverbatim
  142: *>
  143: *> \param[in] LDVL
  144: *> \verbatim
  145: *>          LDVL is INTEGER
  146: *>          The leading dimension of the matrix VL. LDVL >= 1, and
  147: *>          if JOBVL = 'V', LDVL >= N.
  148: *> \endverbatim
  149: *>
  150: *> \param[out] VR
  151: *> \verbatim
  152: *>          VR is COMPLEX*16 array, dimension (LDVR,N)
  153: *>          If JOBVR = 'V', the right generalized eigenvectors v(j) are
  154: *>          stored one after another in the columns of VR, in the same
  155: *>          order as their eigenvalues.
  156: *>          Each eigenvector is scaled so the largest component has
  157: *>          abs(real part) + abs(imag. part) = 1.
  158: *>          Not referenced if JOBVR = 'N'.
  159: *> \endverbatim
  160: *>
  161: *> \param[in] LDVR
  162: *> \verbatim
  163: *>          LDVR is INTEGER
  164: *>          The leading dimension of the matrix VR. LDVR >= 1, and
  165: *>          if JOBVR = 'V', LDVR >= N.
  166: *> \endverbatim
  167: *>
  168: *> \param[out] WORK
  169: *> \verbatim
  170: *>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
  171: *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  172: *> \endverbatim
  173: *>
  174: *> \param[in] LWORK
  175: *> \verbatim
  176: *>          LWORK is INTEGER
  177: *>          The dimension of the array WORK.
  178: *>
  179: *>          If LWORK = -1, then a workspace query is assumed; the routine
  180: *>          only calculates the optimal size of the WORK array, returns
  181: *>          this value as the first entry of the WORK array, and no error
  182: *>          message related to LWORK is issued by XERBLA.
  183: *> \endverbatim
  184: *>
  185: *> \param[out] RWORK
  186: *> \verbatim
  187: *>          RWORK is DOUBLE PRECISION array, dimension (8*N)
  188: *> \endverbatim
  189: *>
  190: *> \param[out] INFO
  191: *> \verbatim
  192: *>          INFO is INTEGER
  193: *>          = 0:  successful exit
  194: *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
  195: *>          =1,...,N:
  196: *>                The QZ iteration failed.  No eigenvectors have been
  197: *>                calculated, but ALPHA(j) and BETA(j) should be
  198: *>                correct for j=INFO+1,...,N.
  199: *>          > N:  =N+1: other then QZ iteration failed in DHGEQZ,
  200: *>                =N+2: error return from DTGEVC.
  201: *> \endverbatim
  202: *
  203: *  Authors:
  204: *  ========
  205: *
  206: *> \author Univ. of Tennessee
  207: *> \author Univ. of California Berkeley
  208: *> \author Univ. of Colorado Denver
  209: *> \author NAG Ltd.
  210: *
  211: *> \date January 2015
  212: *
  213: *> \ingroup complex16GEeigen
  214: *
  215: *  =====================================================================
  216:       SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
  217:      $                   VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO )
  218: *
  219: *  -- LAPACK driver routine (version 3.6.1) --
  220: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  221: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  222: *     January 2015
  223: *
  224: *     .. Scalar Arguments ..
  225:       CHARACTER          JOBVL, JOBVR
  226:       INTEGER            INFO, LDA, LDB, LDVL, LDVR, LWORK, N
  227: *     ..
  228: *     .. Array Arguments ..
  229:       DOUBLE PRECISION   RWORK( * )
  230:       COMPLEX*16         A( LDA, * ), ALPHA( * ), B( LDB, * ),
  231:      $                   BETA( * ), VL( LDVL, * ), VR( LDVR, * ),
  232:      $                   WORK( * )
  233: *     ..
  234: *
  235: *  =====================================================================
  236: *
  237: *     .. Parameters ..
  238:       DOUBLE PRECISION   ZERO, ONE
  239:       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
  240:       COMPLEX*16         CZERO, CONE
  241:       PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
  242:      $                   CONE = ( 1.0D0, 0.0D0 ) )
  243: *     ..
  244: *     .. Local Scalars ..
  245:       LOGICAL            ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
  246:       CHARACTER          CHTEMP
  247:       INTEGER            ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
  248:      $                   IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR,
  249:      $                   LWKOPT
  250:       DOUBLE PRECISION   ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
  251:      $                   SMLNUM, TEMP
  252:       COMPLEX*16         X
  253: *     ..
  254: *     .. Local Arrays ..
  255:       LOGICAL            LDUMMA( 1 )
  256: *     ..
  257: *     .. External Subroutines ..
  258:       EXTERNAL           DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3,
  259:      $                   ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR,
  260:      $                   ZUNMQR
  261: *     ..
  262: *     .. External Functions ..
  263:       LOGICAL            LSAME
  264:       DOUBLE PRECISION   DLAMCH, ZLANGE
  265:       EXTERNAL           LSAME, DLAMCH, ZLANGE
  266: *     ..
  267: *     .. Intrinsic Functions ..
  268:       INTRINSIC          ABS, DBLE, DIMAG, MAX, SQRT
  269: *     ..
  270: *     .. Statement Functions ..
  271:       DOUBLE PRECISION   ABS1
  272: *     ..
  273: *     .. Statement Function definitions ..
  274:       ABS1( X ) = ABS( DBLE( X ) ) + ABS( DIMAG( X ) )
  275: *     ..
  276: *     .. Executable Statements ..
  277: *
  278: *     Decode the input arguments
  279: *
  280:       IF( LSAME( JOBVL, 'N' ) ) THEN
  281:          IJOBVL = 1
  282:          ILVL = .FALSE.
  283:       ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
  284:          IJOBVL = 2
  285:          ILVL = .TRUE.
  286:       ELSE
  287:          IJOBVL = -1
  288:          ILVL = .FALSE.
  289:       END IF
  290: *
  291:       IF( LSAME( JOBVR, 'N' ) ) THEN
  292:          IJOBVR = 1
  293:          ILVR = .FALSE.
  294:       ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
  295:          IJOBVR = 2
  296:          ILVR = .TRUE.
  297:       ELSE
  298:          IJOBVR = -1
  299:          ILVR = .FALSE.
  300:       END IF
  301:       ILV = ILVL .OR. ILVR
  302: *
  303: *     Test the input arguments
  304: *
  305:       INFO = 0
  306:       LQUERY = ( LWORK.EQ.-1 )
  307:       IF( IJOBVL.LE.0 ) THEN
  308:          INFO = -1
  309:       ELSE IF( IJOBVR.LE.0 ) THEN
  310:          INFO = -2
  311:       ELSE IF( N.LT.0 ) THEN
  312:          INFO = -3
  313:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  314:          INFO = -5
  315:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  316:          INFO = -7
  317:       ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
  318:          INFO = -11
  319:       ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
  320:          INFO = -13
  321:       ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
  322:          INFO = -15
  323:       END IF
  324: *
  325: *     Compute workspace
  326: *
  327:       IF( INFO.EQ.0 ) THEN
  328:          CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
  329:          LWKOPT = MAX( 1,  N+INT( WORK( 1 ) ) )
  330:          CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK,
  331:      $                -1, IERR )
  332:          LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
  333:          IF( ILVL ) THEN
  334:             CALL ZUNGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR )
  335:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
  336:          END IF
  337:          IF( ILV ) THEN
  338:             CALL ZGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL,
  339:      $                   LDVL, VR, LDVR, WORK, -1, IERR )
  340:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
  341:             CALL ZHGEQZ( 'S', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
  342:      $                   ALPHA, BETA, VL, LDVL, VR, LDVR, WORK, -1,
  343:      $                   RWORK, IERR )
  344:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
  345:          ELSE
  346:             CALL ZGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL,
  347:      $                   LDVL, VR, LDVR, WORK, -1, IERR )
  348:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
  349:             CALL ZHGEQZ( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
  350:      $                   ALPHA, BETA, VL, LDVL, VR, LDVR, WORK, -1,
  351:      $                   RWORK, IERR )
  352:             LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
  353:          END IF
  354:          WORK( 1 ) = DCMPLX( LWKOPT )
  355:       END IF
  356: *
  357:       IF( INFO.NE.0 ) THEN
  358:          CALL XERBLA( 'ZGGEV3 ', -INFO )
  359:          RETURN
  360:       ELSE IF( LQUERY ) THEN
  361:          RETURN
  362:       END IF
  363: *
  364: *     Quick return if possible
  365: *
  366:       IF( N.EQ.0 )
  367:      $   RETURN
  368: *
  369: *     Get machine constants
  370: *
  371:       EPS = DLAMCH( 'E' )*DLAMCH( 'B' )
  372:       SMLNUM = DLAMCH( 'S' )
  373:       BIGNUM = ONE / SMLNUM
  374:       CALL DLABAD( SMLNUM, BIGNUM )
  375:       SMLNUM = SQRT( SMLNUM ) / EPS
  376:       BIGNUM = ONE / SMLNUM
  377: *
  378: *     Scale A if max element outside range [SMLNUM,BIGNUM]
  379: *
  380:       ANRM = ZLANGE( 'M', N, N, A, LDA, RWORK )
  381:       ILASCL = .FALSE.
  382:       IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
  383:          ANRMTO = SMLNUM
  384:          ILASCL = .TRUE.
  385:       ELSE IF( ANRM.GT.BIGNUM ) THEN
  386:          ANRMTO = BIGNUM
  387:          ILASCL = .TRUE.
  388:       END IF
  389:       IF( ILASCL )
  390:      $   CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
  391: *
  392: *     Scale B if max element outside range [SMLNUM,BIGNUM]
  393: *
  394:       BNRM = ZLANGE( 'M', N, N, B, LDB, RWORK )
  395:       ILBSCL = .FALSE.
  396:       IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
  397:          BNRMTO = SMLNUM
  398:          ILBSCL = .TRUE.
  399:       ELSE IF( BNRM.GT.BIGNUM ) THEN
  400:          BNRMTO = BIGNUM
  401:          ILBSCL = .TRUE.
  402:       END IF
  403:       IF( ILBSCL )
  404:      $   CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
  405: *
  406: *     Permute the matrices A, B to isolate eigenvalues if possible
  407: *
  408:       ILEFT = 1
  409:       IRIGHT = N + 1
  410:       IRWRK = IRIGHT + N
  411:       CALL ZGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, RWORK( ILEFT ),
  412:      $             RWORK( IRIGHT ), RWORK( IRWRK ), IERR )
  413: *
  414: *     Reduce B to triangular form (QR decomposition of B)
  415: *
  416:       IROWS = IHI + 1 - ILO
  417:       IF( ILV ) THEN
  418:          ICOLS = N + 1 - ILO
  419:       ELSE
  420:          ICOLS = IROWS
  421:       END IF
  422:       ITAU = 1
  423:       IWRK = ITAU + IROWS
  424:       CALL ZGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
  425:      $             WORK( IWRK ), LWORK+1-IWRK, IERR )
  426: *
  427: *     Apply the orthogonal transformation to matrix A
  428: *
  429:       CALL ZUNMQR( 'L', 'C', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
  430:      $             WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
  431:      $             LWORK+1-IWRK, IERR )
  432: *
  433: *     Initialize VL
  434: *
  435:       IF( ILVL ) THEN
  436:          CALL ZLASET( 'Full', N, N, CZERO, CONE, VL, LDVL )
  437:          IF( IROWS.GT.1 ) THEN
  438:             CALL ZLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
  439:      $                   VL( ILO+1, ILO ), LDVL )
  440:          END IF
  441:          CALL ZUNGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
  442:      $                WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
  443:       END IF
  444: *
  445: *     Initialize VR
  446: *
  447:       IF( ILVR )
  448:      $   CALL ZLASET( 'Full', N, N, CZERO, CONE, VR, LDVR )
  449: *
  450: *     Reduce to generalized Hessenberg form
  451: *
  452:       IF( ILV ) THEN
  453: *
  454: *        Eigenvectors requested -- work on whole matrix.
  455: *
  456:          CALL ZGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
  457:      $                LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR )
  458:       ELSE
  459:          CALL ZGGHD3( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
  460:      $                B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR,
  461:      $                WORK( IWRK ), LWORK+1-IWRK, IERR )
  462:       END IF
  463: *
  464: *     Perform QZ algorithm (Compute eigenvalues, and optionally, the
  465: *     Schur form and Schur vectors)
  466: *
  467:       IWRK = ITAU
  468:       IF( ILV ) THEN
  469:          CHTEMP = 'S'
  470:       ELSE
  471:          CHTEMP = 'E'
  472:       END IF
  473:       CALL ZHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
  474:      $             ALPHA, BETA, VL, LDVL, VR, LDVR, WORK( IWRK ),
  475:      $             LWORK+1-IWRK, RWORK( IRWRK ), IERR )
  476:       IF( IERR.NE.0 ) THEN
  477:          IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
  478:             INFO = IERR
  479:          ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
  480:             INFO = IERR - N
  481:          ELSE
  482:             INFO = N + 1
  483:          END IF
  484:          GO TO 70
  485:       END IF
  486: *
  487: *     Compute Eigenvectors
  488: *
  489:       IF( ILV ) THEN
  490:          IF( ILVL ) THEN
  491:             IF( ILVR ) THEN
  492:                CHTEMP = 'B'
  493:             ELSE
  494:                CHTEMP = 'L'
  495:             END IF
  496:          ELSE
  497:             CHTEMP = 'R'
  498:          END IF
  499: *
  500:          CALL ZTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
  501:      $                VR, LDVR, N, IN, WORK( IWRK ), RWORK( IRWRK ),
  502:      $                IERR )
  503:          IF( IERR.NE.0 ) THEN
  504:             INFO = N + 2
  505:             GO TO 70
  506:          END IF
  507: *
  508: *        Undo balancing on VL and VR and normalization
  509: *
  510:          IF( ILVL ) THEN
  511:             CALL ZGGBAK( 'P', 'L', N, ILO, IHI, RWORK( ILEFT ),
  512:      $                   RWORK( IRIGHT ), N, VL, LDVL, IERR )
  513:             DO 30 JC = 1, N
  514:                TEMP = ZERO
  515:                DO 10 JR = 1, N
  516:                   TEMP = MAX( TEMP, ABS1( VL( JR, JC ) ) )
  517:    10          CONTINUE
  518:                IF( TEMP.LT.SMLNUM )
  519:      $            GO TO 30
  520:                TEMP = ONE / TEMP
  521:                DO 20 JR = 1, N
  522:                   VL( JR, JC ) = VL( JR, JC )*TEMP
  523:    20          CONTINUE
  524:    30       CONTINUE
  525:          END IF
  526:          IF( ILVR ) THEN
  527:             CALL ZGGBAK( 'P', 'R', N, ILO, IHI, RWORK( ILEFT ),
  528:      $                   RWORK( IRIGHT ), N, VR, LDVR, IERR )
  529:             DO 60 JC = 1, N
  530:                TEMP = ZERO
  531:                DO 40 JR = 1, N
  532:                   TEMP = MAX( TEMP, ABS1( VR( JR, JC ) ) )
  533:    40          CONTINUE
  534:                IF( TEMP.LT.SMLNUM )
  535:      $            GO TO 60
  536:                TEMP = ONE / TEMP
  537:                DO 50 JR = 1, N
  538:                   VR( JR, JC ) = VR( JR, JC )*TEMP
  539:    50          CONTINUE
  540:    60       CONTINUE
  541:          END IF
  542:       END IF
  543: *
  544: *     Undo scaling if necessary
  545: *
  546:    70 CONTINUE
  547: *
  548:       IF( ILASCL )
  549:      $   CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
  550: *
  551:       IF( ILBSCL )
  552:      $   CALL ZLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
  553: *
  554:       WORK( 1 ) = DCMPLX( LWKOPT )
  555:       RETURN
  556: *
  557: *     End of ZGGEV3
  558: *
  559:       END

CVSweb interface <joel.bertrand@systella.fr>