[BACK]Return to zgeevx.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/zgeevx.f between versions 1.12 and 1.13

version 1.12, 2014/01/27 09:28:32 version 1.13, 2016/08/27 15:27:12
Line 276 Line 276
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver 
 *> \author NAG Ltd.   *> \author NAG Ltd. 
 *  *
 *> \date November 2011  *> \date June 2016
   *
   *  @precisions fortran z -> c
 *  *
 *> \ingroup complex16GEeigen  *> \ingroup complex16GEeigen
 *  *
Line 284 Line 286
       SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL,        SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL,
      $                   LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE,       $                   LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE,
      $                   RCONDV, WORK, LWORK, RWORK, INFO )       $                   RCONDV, WORK, LWORK, RWORK, INFO )
         implicit none
 *  *
 *  -- LAPACK driver routine (version 3.4.0) --  *  -- LAPACK driver routine (version 3.6.1) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --  *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--  *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     November 2011  *     June 2016
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER          BALANC, JOBVL, JOBVR, SENSE        CHARACTER          BALANC, JOBVL, JOBVR, SENSE
Line 312 Line 315
       LOGICAL            LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,        LOGICAL            LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
      $                   WNTSNN, WNTSNV       $                   WNTSNN, WNTSNV
       CHARACTER          JOB, SIDE        CHARACTER          JOB, SIDE
       INTEGER            HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK,        INTEGER            HSWORK, I, ICOND, IERR, ITAU, IWRK, K,
      $                   MINWRK, NOUT       $                   LWORK_TREVC, MAXWRK, MINWRK, NOUT
       DOUBLE PRECISION   ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM        DOUBLE PRECISION   ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
       COMPLEX*16         TMP        COMPLEX*16         TMP
 *     ..  *     ..
Line 323 Line 326
 *     ..  *     ..
 *     .. External Subroutines ..  *     .. External Subroutines ..
       EXTERNAL           DLABAD, DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL,        EXTERNAL           DLABAD, DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL,
      $                   ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC,       $                   ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3,
      $                   ZTRSNA, ZUNGHR       $                   ZTRSNA, ZUNGHR
 *     ..  *     ..
 *     .. External Functions ..  *     .. External Functions ..
Line 333 Line 336
       EXTERNAL           LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE        EXTERNAL           LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE
 *     ..  *     ..
 *     .. Intrinsic Functions ..  *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT        INTRINSIC          DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT
 *     ..  *     ..
 *     .. Executable Statements ..  *     .. Executable Statements ..
 *  *
Line 387 Line 390
             MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )              MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
 *  *
             IF( WANTVL ) THEN              IF( WANTVL ) THEN
                  CALL ZTREVC3( 'L', 'B', SELECT, N, A, LDA,
        $                       VL, LDVL, VR, LDVR,
        $                       N, NOUT, WORK, -1, RWORK, -1, IERR )
                  LWORK_TREVC = INT( WORK(1) )
                  MAXWRK = MAX( MAXWRK, LWORK_TREVC )
                CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL,                 CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL,
      $                WORK, -1, INFO )       $                WORK, -1, INFO )
             ELSE IF( WANTVR ) THEN              ELSE IF( WANTVR ) THEN
                  CALL ZTREVC3( 'R', 'B', SELECT, N, A, LDA,
        $                       VL, LDVL, VR, LDVR,
        $                       N, NOUT, WORK, -1, RWORK, -1, IERR )
                  LWORK_TREVC = INT( WORK(1) )
                  MAXWRK = MAX( MAXWRK, LWORK_TREVC )
                CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR,                 CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR,
      $                WORK, -1, INFO )       $                WORK, -1, INFO )
             ELSE              ELSE
Line 401 Line 414
      $                WORK, -1, INFO )       $                WORK, -1, INFO )
                END IF                 END IF
             END IF              END IF
             HSWORK = WORK( 1 )              HSWORK = INT( WORK(1) )
 *  *
             IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN              IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
                MINWRK = 2*N                 MINWRK = 2*N
Line 559 Line 572
      $                WORK( IWRK ), LWORK-IWRK+1, INFO )       $                WORK( IWRK ), LWORK-IWRK+1, INFO )
       END IF        END IF
 *  *
 *     If INFO > 0 from ZHSEQR, then quit  *     If INFO .NE. 0 from ZHSEQR, then quit
 *  *
       IF( INFO.GT.0 )        IF( INFO.NE.0 )
      $   GO TO 50       $   GO TO 50
 *  *
       IF( WANTVL .OR. WANTVR ) THEN        IF( WANTVL .OR. WANTVR ) THEN
 *  *
 *        Compute left and/or right eigenvectors  *        Compute left and/or right eigenvectors
 *        (CWorkspace: need 2*N)  *        (CWorkspace: need 2*N, prefer N + 2*N*NB)
 *        (RWorkspace: need N)  *        (RWorkspace: need N)
 *  *
          CALL ZTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,           CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
      $                N, NOUT, WORK( IWRK ), RWORK, IERR )       $                 N, NOUT, WORK( IWRK ), LWORK-IWRK+1,
        $                 RWORK, N, IERR )
       END IF        END IF
 *  *
 *     Compute condition numbers if desired  *     Compute condition numbers if desired
Line 598 Line 612
             CALL ZDSCAL( N, SCL, VL( 1, I ), 1 )              CALL ZDSCAL( N, SCL, VL( 1, I ), 1 )
             DO 10 K = 1, N              DO 10 K = 1, N
                RWORK( K ) = DBLE( VL( K, I ) )**2 +                 RWORK( K ) = DBLE( VL( K, I ) )**2 +
      $                      DIMAG( VL( K, I ) )**2       $                      AIMAG( VL( K, I ) )**2
    10       CONTINUE     10       CONTINUE
             K = IDAMAX( N, RWORK, 1 )              K = IDAMAX( N, RWORK, 1 )
             TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( K ) )              TMP = CONJG( VL( K, I ) ) / SQRT( RWORK( K ) )
             CALL ZSCAL( N, TMP, VL( 1, I ), 1 )              CALL ZSCAL( N, TMP, VL( 1, I ), 1 )
             VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO )              VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO )
    20    CONTINUE     20    CONTINUE
Line 621 Line 635
             CALL ZDSCAL( N, SCL, VR( 1, I ), 1 )              CALL ZDSCAL( N, SCL, VR( 1, I ), 1 )
             DO 30 K = 1, N              DO 30 K = 1, N
                RWORK( K ) = DBLE( VR( K, I ) )**2 +                 RWORK( K ) = DBLE( VR( K, I ) )**2 +
      $                      DIMAG( VR( K, I ) )**2       $                      AIMAG( VR( K, I ) )**2
    30       CONTINUE     30       CONTINUE
             K = IDAMAX( N, RWORK, 1 )              K = IDAMAX( N, RWORK, 1 )
             TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( K ) )              TMP = CONJG( VR( K, I ) ) / SQRT( RWORK( K ) )
             CALL ZSCAL( N, TMP, VR( 1, I ), 1 )              CALL ZSCAL( N, TMP, VR( 1, I ), 1 )
             VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO )              VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO )
    40    CONTINUE     40    CONTINUE
Removed from v.1.12  
changed lines
  Added in v.1.13

CVSweb interface <joel.bertrand@systella.fr>