224 SUBROUTINE cgegs( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA,
225 $ VSL, LDVSL, VSR, LDVSR, WORK, LWORK, RWORK,
234 CHARACTER JOBVSL, JOBVSR
235 INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N
239 COMPLEX A( LDA, * ), ALPHA( * ), B( LDB, * ),
240 $ beta( * ), vsl( ldvsl, * ), vsr( ldvsr, * ),
248 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
250 parameter( czero = ( 0.0e0, 0.0e0 ),
251 $ cone = ( 1.0e0, 0.0e0 ) )
254 LOGICAL ILASCL, ILBSCL, ILVSL, ILVSR, LQUERY
255 INTEGER ICOLS, IHI, IINFO, IJOBVL, IJOBVR, ILEFT,
256 $ ilo, iright, irows, irwork, itau, iwork,
257 $ lopt, lwkmin, lwkopt, nb, nb1, nb2, nb3
258 REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
269 EXTERNAL ilaenv, lsame, clange, slamch
278 IF( lsame( jobvsl,
'N' ) )
THEN
281 ELSE IF( lsame( jobvsl,
'V' ) )
THEN
289 IF( lsame( jobvsr,
'N' ) )
THEN
292 ELSE IF( lsame( jobvsr,
'V' ) )
THEN
302 lwkmin = max( 2*n, 1 )
305 lquery = ( lwork.EQ.-1 )
307 IF( ijobvl.LE.0 )
THEN
309 ELSE IF( ijobvr.LE.0 )
THEN
311 ELSE IF( n.LT.0 )
THEN
313 ELSE IF( lda.LT.max( 1, n ) )
THEN
315 ELSE IF( ldb.LT.max( 1, n ) )
THEN
317 ELSE IF( ldvsl.LT.1 .OR. ( ilvsl .AND. ldvsl.LT.n ) )
THEN
319 ELSE IF( ldvsr.LT.1 .OR. ( ilvsr .AND. ldvsr.LT.n ) )
THEN
321 ELSE IF( lwork.LT.lwkmin .AND. .NOT.lquery )
THEN
326 nb1 = ilaenv( 1,
'CGEQRF',
' ', n, n, -1, -1 )
327 nb2 = ilaenv( 1,
'CUNMQR',
' ', n, n, n, -1 )
328 nb3 = ilaenv( 1,
'CUNGQR',
' ', n, n, n, -1 )
329 nb = max( nb1, nb2, nb3 )
335 CALL xerbla(
'CGEGS ', -info )
337 ELSE IF( lquery )
THEN
348 eps = slamch(
'E' )*slamch(
'B' )
349 safmin = slamch(
'S' )
350 smlnum = n*safmin / eps
351 bignum = one / smlnum
355 anrm = clange(
'M', n, n, a, lda, rwork )
357 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
360 ELSE IF( anrm.GT.bignum )
THEN
366 CALL clascl(
'G', -1, -1, anrm, anrmto, n, n, a, lda, iinfo )
367 IF( iinfo.NE.0 )
THEN
375 bnrm = clange(
'M', n, n, b, ldb, rwork )
377 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
380 ELSE IF( bnrm.GT.bignum )
THEN
386 CALL clascl(
'G', -1, -1, bnrm, bnrmto, n, n, b, ldb, iinfo )
387 IF( iinfo.NE.0 )
THEN
399 CALL cggbal(
'P', n, a, lda, b, ldb, ilo, ihi, rwork( ileft ),
400 $ rwork( iright ), rwork( irwork ), iinfo )
401 IF( iinfo.NE.0 )
THEN
408 irows = ihi + 1 - ilo
412 CALL cgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
413 $ work( iwork ), lwork+1-iwork, iinfo )
415 $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
416 IF( iinfo.NE.0 )
THEN
421 CALL cunmqr(
'L',
'C', irows, icols, irows, b( ilo, ilo ), ldb,
422 $ work( itau ), a( ilo, ilo ), lda, work( iwork ),
423 $ lwork+1-iwork, iinfo )
425 $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
426 IF( iinfo.NE.0 )
THEN
432 CALL claset(
'Full', n, n, czero, cone, vsl, ldvsl )
433 CALL clacpy(
'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
434 $ vsl( ilo+1, ilo ), ldvsl )
435 CALL cungqr( irows, irows, irows, vsl( ilo, ilo ), ldvsl,
436 $ work( itau ), work( iwork ), lwork+1-iwork,
439 $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
440 IF( iinfo.NE.0 )
THEN
447 $
CALL claset(
'Full', n, n, czero, cone, vsr, ldvsr )
451 CALL cgghrd( jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb, vsl,
452 $ ldvsl, vsr, ldvsr, iinfo )
453 IF( iinfo.NE.0 )
THEN
461 CALL chgeqz(
'S', jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb,
462 $ alpha, beta, vsl, ldvsl, vsr, ldvsr, work( iwork ),
463 $ lwork+1-iwork, rwork( irwork ), iinfo )
465 $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
466 IF( iinfo.NE.0 )
THEN
467 IF( iinfo.GT.0 .AND. iinfo.LE.n )
THEN
469 ELSE IF( iinfo.GT.n .AND. iinfo.LE.2*n )
THEN
480 CALL cggbak(
'P',
'L', n, ilo, ihi, rwork( ileft ),
481 $ rwork( iright ), n, vsl, ldvsl, iinfo )
482 IF( iinfo.NE.0 )
THEN
488 CALL cggbak(
'P',
'R', n, ilo, ihi, rwork( ileft ),
489 $ rwork( iright ), n, vsr, ldvsr, iinfo )
490 IF( iinfo.NE.0 )
THEN
499 CALL clascl(
'U', -1, -1, anrmto, anrm, n, n, a, lda, iinfo )
500 IF( iinfo.NE.0 )
THEN
504 CALL clascl(
'G', -1, -1, anrmto, anrm, n, 1, alpha, n, iinfo )
505 IF( iinfo.NE.0 )
THEN
512 CALL clascl(
'U', -1, -1, bnrmto, bnrm, n, n, b, ldb, iinfo )
513 IF( iinfo.NE.0 )
THEN
517 CALL clascl(
'G', -1, -1, bnrmto, bnrm, n, 1, beta, n, iinfo )
518 IF( iinfo.NE.0 )
THEN