001:       SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA,
002:      $                   B, LDB, SDIM, ALPHA, BETA, VSL, LDVSL, VSR,
003:      $                   LDVSR, RCONDE, RCONDV, WORK, LWORK, RWORK,
004:      $                   IWORK, LIWORK, BWORK, INFO )
005: *
006: *  -- LAPACK driver routine (version 3.2) --
007: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
008: *     November 2006
009: *
010: *     .. Scalar Arguments ..
011:       CHARACTER          JOBVSL, JOBVSR, SENSE, SORT
012:       INTEGER            INFO, LDA, LDB, LDVSL, LDVSR, LIWORK, LWORK, N,
013:      $                   SDIM
014: *     ..
015: *     .. Array Arguments ..
016:       LOGICAL            BWORK( * )
017:       INTEGER            IWORK( * )
018:       REAL               RCONDE( 2 ), RCONDV( 2 ), RWORK( * )
019:       COMPLEX            A( LDA, * ), ALPHA( * ), B( LDB, * ),
020:      $                   BETA( * ), VSL( LDVSL, * ), VSR( LDVSR, * ),
021:      $                   WORK( * )
022: *     ..
023: *     .. Function Arguments ..
024:       LOGICAL            SELCTG
025:       EXTERNAL           SELCTG
026: *     ..
027: *
028: *  Purpose
029: *  =======
030: *
031: *  CGGESX computes for a pair of N-by-N complex nonsymmetric matrices
032: *  (A,B), the generalized eigenvalues, the complex Schur form (S,T),
033: *  and, optionally, the left and/or right matrices of Schur vectors (VSL
034: *  and VSR).  This gives the generalized Schur factorization
035: *
036: *       (A,B) = ( (VSL) S (VSR)**H, (VSL) T (VSR)**H )
037: *
038: *  where (VSR)**H is the conjugate-transpose of VSR.
039: *
040: *  Optionally, it also orders the eigenvalues so that a selected cluster
041: *  of eigenvalues appears in the leading diagonal blocks of the upper
042: *  triangular matrix S and the upper triangular matrix T; computes
043: *  a reciprocal condition number for the average of the selected
044: *  eigenvalues (RCONDE); and computes a reciprocal condition number for
045: *  the right and left deflating subspaces corresponding to the selected
046: *  eigenvalues (RCONDV). The leading columns of VSL and VSR then form
047: *  an orthonormal basis for the corresponding left and right eigenspaces
048: *  (deflating subspaces).
049: *
050: *  A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
051: *  or a ratio alpha/beta = w, such that  A - w*B is singular.  It is
052: *  usually represented as the pair (alpha,beta), as there is a
053: *  reasonable interpretation for beta=0 or for both being zero.
054: *
055: *  A pair of matrices (S,T) is in generalized complex Schur form if T is
056: *  upper triangular with non-negative diagonal and S is upper
057: *  triangular.
058: *
059: *  Arguments
060: *  =========
061: *
062: *  JOBVSL  (input) CHARACTER*1
063: *          = 'N':  do not compute the left Schur vectors;
064: *          = 'V':  compute the left Schur vectors.
065: *
066: *  JOBVSR  (input) CHARACTER*1
067: *          = 'N':  do not compute the right Schur vectors;
068: *          = 'V':  compute the right Schur vectors.
069: *
070: *  SORT    (input) CHARACTER*1
071: *          Specifies whether or not to order the eigenvalues on the
072: *          diagonal of the generalized Schur form.
073: *          = 'N':  Eigenvalues are not ordered;
074: *          = 'S':  Eigenvalues are ordered (see SELCTG).
075: *
076: *  SELCTG  (external procedure) LOGICAL FUNCTION of two COMPLEX arguments
077: *          SELCTG must be declared EXTERNAL in the calling subroutine.
078: *          If SORT = 'N', SELCTG is not referenced.
079: *          If SORT = 'S', SELCTG is used to select eigenvalues to sort
080: *          to the top left of the Schur form.
081: *          Note that a selected complex eigenvalue may no longer satisfy
082: *          SELCTG(ALPHA(j),BETA(j)) = .TRUE. after ordering, since
083: *          ordering may change the value of complex eigenvalues
084: *          (especially if the eigenvalue is ill-conditioned), in this
085: *          case INFO is set to N+3 see INFO below).
086: *
087: *  SENSE   (input) CHARACTER*1
088: *          Determines which reciprocal condition numbers are computed.
089: *          = 'N' : None are computed;
090: *          = 'E' : Computed for average of selected eigenvalues only;
091: *          = 'V' : Computed for selected deflating subspaces only;
092: *          = 'B' : Computed for both.
093: *          If SENSE = 'E', 'V', or 'B', SORT must equal 'S'.
094: *
095: *  N       (input) INTEGER
096: *          The order of the matrices A, B, VSL, and VSR.  N >= 0.
097: *
098: *  A       (input/output) COMPLEX array, dimension (LDA, N)
099: *          On entry, the first of the pair of matrices.
100: *          On exit, A has been overwritten by its generalized Schur
101: *          form S.
102: *
103: *  LDA     (input) INTEGER
104: *          The leading dimension of A.  LDA >= max(1,N).
105: *
106: *  B       (input/output) COMPLEX array, dimension (LDB, N)
107: *          On entry, the second of the pair of matrices.
108: *          On exit, B has been overwritten by its generalized Schur
109: *          form T.
110: *
111: *  LDB     (input) INTEGER
112: *          The leading dimension of B.  LDB >= max(1,N).
113: *
114: *  SDIM    (output) INTEGER
115: *          If SORT = 'N', SDIM = 0.
116: *          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
117: *          for which SELCTG is true.
118: *
119: *  ALPHA   (output) COMPLEX array, dimension (N)
120: *  BETA    (output) COMPLEX array, dimension (N)
121: *          On exit, ALPHA(j)/BETA(j), j=1,...,N, will be the
122: *          generalized eigenvalues.  ALPHA(j) and BETA(j),j=1,...,N  are
123: *          the diagonals of the complex Schur form (S,T).  BETA(j) will
124: *          be non-negative real.
125: *
126: *          Note: the quotients ALPHA(j)/BETA(j) may easily over- or
127: *          underflow, and BETA(j) may even be zero.  Thus, the user
128: *          should avoid naively computing the ratio alpha/beta.
129: *          However, ALPHA will be always less than and usually
130: *          comparable with norm(A) in magnitude, and BETA always less
131: *          than and usually comparable with norm(B).
132: *
133: *  VSL     (output) COMPLEX array, dimension (LDVSL,N)
134: *          If JOBVSL = 'V', VSL will contain the left Schur vectors.
135: *          Not referenced if JOBVSL = 'N'.
136: *
137: *  LDVSL   (input) INTEGER
138: *          The leading dimension of the matrix VSL. LDVSL >=1, and
139: *          if JOBVSL = 'V', LDVSL >= N.
140: *
141: *  VSR     (output) COMPLEX array, dimension (LDVSR,N)
142: *          If JOBVSR = 'V', VSR will contain the right Schur vectors.
143: *          Not referenced if JOBVSR = 'N'.
144: *
145: *  LDVSR   (input) INTEGER
146: *          The leading dimension of the matrix VSR. LDVSR >= 1, and
147: *          if JOBVSR = 'V', LDVSR >= N.
148: *
149: *  RCONDE  (output) REAL array, dimension ( 2 )
150: *          If SENSE = 'E' or 'B', RCONDE(1) and RCONDE(2) contain the
151: *          reciprocal condition numbers for the average of the selected
152: *          eigenvalues.
153: *          Not referenced if SENSE = 'N' or 'V'.
154: *
155: *  RCONDV  (output) REAL array, dimension ( 2 )
156: *          If SENSE = 'V' or 'B', RCONDV(1) and RCONDV(2) contain the
157: *          reciprocal condition number for the selected deflating
158: *          subspaces.
159: *          Not referenced if SENSE = 'N' or 'E'.
160: *
161: *  WORK    (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))
162: *          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
163: *
164: *  LWORK   (input) INTEGER
165: *          The dimension of the array WORK.
166: *          If N = 0, LWORK >= 1, else if SENSE = 'E', 'V', or 'B',
167: *          LWORK >= MAX(1,2*N,2*SDIM*(N-SDIM)), else
168: *          LWORK >= MAX(1,2*N).  Note that 2*SDIM*(N-SDIM) <= N*N/2.
169: *          Note also that an error is only returned if
170: *          LWORK < MAX(1,2*N), but if SENSE = 'E' or 'V' or 'B' this may
171: *          not be large enough.
172: *
173: *          If LWORK = -1, then a workspace query is assumed; the routine
174: *          only calculates the bound on the optimal size of the WORK
175: *          array and the minimum size of the IWORK array, returns these
176: *          values as the first entries of the WORK and IWORK arrays, and
177: *          no error message related to LWORK or LIWORK is issued by
178: *          XERBLA.
179: *
180: *  RWORK   (workspace) REAL array, dimension ( 8*N )
181: *          Real workspace.
182: *
183: *  IWORK   (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
184: *          On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
185: *
186: *  LIWORK  (input) INTEGER
187: *          The dimension of the array WORK.
188: *          If SENSE = 'N' or N = 0, LIWORK >= 1, otherwise
189: *          LIWORK >= N+2.
190: *
191: *          If LIWORK = -1, then a workspace query is assumed; the
192: *          routine only calculates the bound on the optimal size of the
193: *          WORK array and the minimum size of the IWORK array, returns
194: *          these values as the first entries of the WORK and IWORK
195: *          arrays, and no error message related to LWORK or LIWORK is
196: *          issued by XERBLA.
197: *
198: *  BWORK   (workspace) LOGICAL array, dimension (N)
199: *          Not referenced if SORT = 'N'.
200: *
201: *  INFO    (output) INTEGER
202: *          = 0:  successful exit
203: *          < 0:  if INFO = -i, the i-th argument had an illegal value.
204: *          = 1,...,N:
205: *                The QZ iteration failed.  (A,B) are not in Schur
206: *                form, but ALPHA(j) and BETA(j) should be correct for
207: *                j=INFO+1,...,N.
208: *          > N:  =N+1: other than QZ iteration failed in CHGEQZ
209: *                =N+2: after reordering, roundoff changed values of
210: *                      some complex eigenvalues so that leading
211: *                      eigenvalues in the Generalized Schur form no
212: *                      longer satisfy SELCTG=.TRUE.  This could also
213: *                      be caused due to scaling.
214: *                =N+3: reordering failed in CTGSEN.
215: *
216: *  =====================================================================
217: *
218: *     .. Parameters ..
219:       REAL               ZERO, ONE
220:       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
221:       COMPLEX            CZERO, CONE
222:       PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
223:      $                   CONE = ( 1.0E+0, 0.0E+0 ) )
224: *     ..
225: *     .. Local Scalars ..
226:       LOGICAL            CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
227:      $                   LQUERY, WANTSB, WANTSE, WANTSN, WANTST, WANTSV
228:       INTEGER            I, ICOLS, IERR, IHI, IJOB, IJOBVL, IJOBVR,
229:      $                   ILEFT, ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK,
230:      $                   LIWMIN, LWRK, MAXWRK, MINWRK
231:       REAL               ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PL,
232:      $                   PR, SMLNUM
233: *     ..
234: *     .. Local Arrays ..
235:       REAL               DIF( 2 )
236: *     ..
237: *     .. External Subroutines ..
238:       EXTERNAL           CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY,
239:      $                   CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, SLABAD,
240:      $                   XERBLA
241: *     ..
242: *     .. External Functions ..
243:       LOGICAL            LSAME
244:       INTEGER            ILAENV
245:       REAL               CLANGE, SLAMCH
246:       EXTERNAL           LSAME, ILAENV, CLANGE, SLAMCH
247: *     ..
248: *     .. Intrinsic Functions ..
249:       INTRINSIC          MAX, SQRT
250: *     ..
251: *     .. Executable Statements ..
252: *
253: *     Decode the input arguments
254: *
255:       IF( LSAME( JOBVSL, 'N' ) ) THEN
256:          IJOBVL = 1
257:          ILVSL = .FALSE.
258:       ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
259:          IJOBVL = 2
260:          ILVSL = .TRUE.
261:       ELSE
262:          IJOBVL = -1
263:          ILVSL = .FALSE.
264:       END IF
265: *
266:       IF( LSAME( JOBVSR, 'N' ) ) THEN
267:          IJOBVR = 1
268:          ILVSR = .FALSE.
269:       ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
270:          IJOBVR = 2
271:          ILVSR = .TRUE.
272:       ELSE
273:          IJOBVR = -1
274:          ILVSR = .FALSE.
275:       END IF
276: *
277:       WANTST = LSAME( SORT, 'S' )
278:       WANTSN = LSAME( SENSE, 'N' )
279:       WANTSE = LSAME( SENSE, 'E' )
280:       WANTSV = LSAME( SENSE, 'V' )
281:       WANTSB = LSAME( SENSE, 'B' )
282:       LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
283:       IF( WANTSN ) THEN
284:          IJOB = 0
285:       ELSE IF( WANTSE ) THEN
286:          IJOB = 1
287:       ELSE IF( WANTSV ) THEN
288:          IJOB = 2
289:       ELSE IF( WANTSB ) THEN
290:          IJOB = 4
291:       END IF
292: *
293: *     Test the input arguments
294: *
295:       INFO = 0
296:       IF( IJOBVL.LE.0 ) THEN
297:          INFO = -1
298:       ELSE IF( IJOBVR.LE.0 ) THEN
299:          INFO = -2
300:       ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
301:          INFO = -3
302:       ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR.
303:      $         ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN
304:          INFO = -5
305:       ELSE IF( N.LT.0 ) THEN
306:          INFO = -6
307:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
308:          INFO = -8
309:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
310:          INFO = -10
311:       ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
312:          INFO = -15
313:       ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
314:          INFO = -17
315:       END IF
316: *
317: *     Compute workspace
318: *      (Note: Comments in the code beginning "Workspace:" describe the
319: *       minimal amount of workspace needed at that point in the code,
320: *       as well as the preferred amount for good performance.
321: *       NB refers to the optimal block size for the immediately
322: *       following subroutine, as returned by ILAENV.)
323: *
324:       IF( INFO.EQ.0 ) THEN
325:          IF( N.GT.0) THEN
326:             MINWRK = 2*N
327:             MAXWRK = N*(1 + ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 ) )
328:             MAXWRK = MAX( MAXWRK, N*( 1 +
329:      $                    ILAENV( 1, 'CUNMQR', ' ', N, 1, N, -1 ) ) )
330:             IF( ILVSL ) THEN
331:                MAXWRK = MAX( MAXWRK, N*( 1 +
332:      $                       ILAENV( 1, 'CUNGQR', ' ', N, 1, N, -1 ) ) )
333:             END IF
334:             LWRK = MAXWRK
335:             IF( IJOB.GE.1 )
336:      $         LWRK = MAX( LWRK, N*N/2 )
337:          ELSE
338:             MINWRK = 1
339:             MAXWRK = 1
340:             LWRK   = 1
341:          END IF
342:          WORK( 1 ) = LWRK
343:          IF( WANTSN .OR. N.EQ.0 ) THEN
344:             LIWMIN = 1
345:          ELSE
346:             LIWMIN = N + 2
347:          END IF
348:          IWORK( 1 ) = LIWMIN
349: *
350:          IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
351:             INFO = -21
352:          ELSE IF( LIWORK.LT.LIWMIN  .AND. .NOT.LQUERY) THEN
353:             INFO = -24
354:          END IF
355:       END IF
356: *
357:       IF( INFO.NE.0 ) THEN
358:          CALL XERBLA( 'CGGESX', -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 ) THEN
367:          SDIM = 0
368:          RETURN
369:       END IF
370: *
371: *     Get machine constants
372: *
373:       EPS = SLAMCH( 'P' )
374:       SMLNUM = SLAMCH( 'S' )
375:       BIGNUM = ONE / SMLNUM
376:       CALL SLABAD( SMLNUM, BIGNUM )
377:       SMLNUM = SQRT( SMLNUM ) / EPS
378:       BIGNUM = ONE / SMLNUM
379: *
380: *     Scale A if max element outside range [SMLNUM,BIGNUM]
381: *
382:       ANRM = CLANGE( 'M', N, N, A, LDA, RWORK )
383:       ILASCL = .FALSE.
384:       IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
385:          ANRMTO = SMLNUM
386:          ILASCL = .TRUE.
387:       ELSE IF( ANRM.GT.BIGNUM ) THEN
388:          ANRMTO = BIGNUM
389:          ILASCL = .TRUE.
390:       END IF
391:       IF( ILASCL )
392:      $   CALL CLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
393: *
394: *     Scale B if max element outside range [SMLNUM,BIGNUM]
395: *
396:       BNRM = CLANGE( 'M', N, N, B, LDB, RWORK )
397:       ILBSCL = .FALSE.
398:       IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
399:          BNRMTO = SMLNUM
400:          ILBSCL = .TRUE.
401:       ELSE IF( BNRM.GT.BIGNUM ) THEN
402:          BNRMTO = BIGNUM
403:          ILBSCL = .TRUE.
404:       END IF
405:       IF( ILBSCL )
406:      $   CALL CLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
407: *
408: *     Permute the matrix to make it more nearly triangular
409: *     (Real Workspace: need 6*N)
410: *
411:       ILEFT = 1
412:       IRIGHT = N + 1
413:       IRWRK = IRIGHT + N
414:       CALL CGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, RWORK( ILEFT ),
415:      $             RWORK( IRIGHT ), RWORK( IRWRK ), IERR )
416: *
417: *     Reduce B to triangular form (QR decomposition of B)
418: *     (Complex Workspace: need N, prefer N*NB)
419: *
420:       IROWS = IHI + 1 - ILO
421:       ICOLS = N + 1 - ILO
422:       ITAU = 1
423:       IWRK = ITAU + IROWS
424:       CALL CGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
425:      $             WORK( IWRK ), LWORK+1-IWRK, IERR )
426: *
427: *     Apply the unitary transformation to matrix A
428: *     (Complex Workspace: need N, prefer N*NB)
429: *
430:       CALL CUNMQR( 'L', 'C', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
431:      $             WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
432:      $             LWORK+1-IWRK, IERR )
433: *
434: *     Initialize VSL
435: *     (Complex Workspace: need N, prefer N*NB)
436: *
437:       IF( ILVSL ) THEN
438:          CALL CLASET( 'Full', N, N, CZERO, CONE, VSL, LDVSL )
439:          IF( IROWS.GT.1 ) THEN
440:             CALL CLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
441:      $                   VSL( ILO+1, ILO ), LDVSL )
442:          END IF
443:          CALL CUNGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
444:      $                WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
445:       END IF
446: *
447: *     Initialize VSR
448: *
449:       IF( ILVSR )
450:      $   CALL CLASET( 'Full', N, N, CZERO, CONE, VSR, LDVSR )
451: *
452: *     Reduce to generalized Hessenberg form
453: *     (Workspace: none needed)
454: *
455:       CALL CGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
456:      $             LDVSL, VSR, LDVSR, IERR )
457: *
458:       SDIM = 0
459: *
460: *     Perform QZ algorithm, computing Schur vectors if desired
461: *     (Complex Workspace: need N)
462: *     (Real Workspace:    need N)
463: *
464:       IWRK = ITAU
465:       CALL CHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
466:      $             ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK( IWRK ),
467:      $             LWORK+1-IWRK, RWORK( IRWRK ), IERR )
468:       IF( IERR.NE.0 ) THEN
469:          IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
470:             INFO = IERR
471:          ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
472:             INFO = IERR - N
473:          ELSE
474:             INFO = N + 1
475:          END IF
476:          GO TO 40
477:       END IF
478: *
479: *     Sort eigenvalues ALPHA/BETA and compute the reciprocal of
480: *     condition number(s)
481: *
482:       IF( WANTST ) THEN
483: *
484: *        Undo scaling on eigenvalues before SELCTGing
485: *
486:          IF( ILASCL )
487:      $      CALL CLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
488:          IF( ILBSCL )
489:      $      CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
490: *
491: *        Select eigenvalues
492: *
493:          DO 10 I = 1, N
494:             BWORK( I ) = SELCTG( ALPHA( I ), BETA( I ) )
495:    10    CONTINUE
496: *
497: *        Reorder eigenvalues, transform Generalized Schur vectors, and
498: *        compute reciprocal condition numbers
499: *        (Complex Workspace: If IJOB >= 1, need MAX(1, 2*SDIM*(N-SDIM))
500: *                            otherwise, need 1 )
501: *
502:          CALL CTGSEN( IJOB, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
503:      $                ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PL, PR,
504:      $                DIF, WORK( IWRK ), LWORK-IWRK+1, IWORK, LIWORK,
505:      $                IERR )
506: *
507:          IF( IJOB.GE.1 )
508:      $      MAXWRK = MAX( MAXWRK, 2*SDIM*( N-SDIM ) )
509:          IF( IERR.EQ.-21 ) THEN
510: *
511: *            not enough complex workspace
512: *
513:             INFO = -21
514:          ELSE
515:             IF( IJOB.EQ.1 .OR. IJOB.EQ.4 ) THEN
516:                RCONDE( 1 ) = PL
517:                RCONDE( 2 ) = PR
518:             END IF
519:             IF( IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN
520:                RCONDV( 1 ) = DIF( 1 )
521:                RCONDV( 2 ) = DIF( 2 )
522:             END IF
523:             IF( IERR.EQ.1 )
524:      $         INFO = N + 3
525:          END IF
526: *
527:       END IF
528: *
529: *     Apply permutation to VSL and VSR
530: *     (Workspace: none needed)
531: *
532:       IF( ILVSL )
533:      $   CALL CGGBAK( 'P', 'L', N, ILO, IHI, RWORK( ILEFT ),
534:      $                RWORK( IRIGHT ), N, VSL, LDVSL, IERR )
535: *
536:       IF( ILVSR )
537:      $   CALL CGGBAK( 'P', 'R', N, ILO, IHI, RWORK( ILEFT ),
538:      $                RWORK( IRIGHT ), N, VSR, LDVSR, IERR )
539: *
540: *     Undo scaling
541: *
542:       IF( ILASCL ) THEN
543:          CALL CLASCL( 'U', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR )
544:          CALL CLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
545:       END IF
546: *
547:       IF( ILBSCL ) THEN
548:          CALL CLASCL( 'U', 0, 0, BNRMTO, BNRM, N, N, B, LDB, IERR )
549:          CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
550:       END IF
551: *
552:       IF( WANTST ) THEN
553: *
554: *        Check if reordering is correct
555: *
556:          LASTSL = .TRUE.
557:          SDIM = 0
558:          DO 30 I = 1, N
559:             CURSL = SELCTG( ALPHA( I ), BETA( I ) )
560:             IF( CURSL )
561:      $         SDIM = SDIM + 1
562:             IF( CURSL .AND. .NOT.LASTSL )
563:      $         INFO = N + 2
564:             LASTSL = CURSL
565:    30    CONTINUE
566: *
567:       END IF
568: *
569:    40 CONTINUE
570: *
571:       WORK( 1 ) = MAXWRK
572:       IWORK( 1 ) = LIWMIN
573: *
574:       RETURN
575: *
576: *     End of CGGESX
577: *
578:       END
579: