SRC/zggev3.f

   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