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

Diff for /rpl/lapack/lapack/zgeev.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 169 Line 169
 *> \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
 *  *
 *  =====================================================================  *  =====================================================================
       SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,        SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
      $                  WORK, LWORK, RWORK, INFO )       $                  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          JOBVL, JOBVR        CHARACTER          JOBVL, JOBVR
Line 202 Line 205
       LOGICAL            LQUERY, SCALEA, WANTVL, WANTVR        LOGICAL            LQUERY, SCALEA, WANTVL, WANTVR
       CHARACTER          SIDE        CHARACTER          SIDE
       INTEGER            HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,        INTEGER            HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
      $                   IWRK, K, MAXWRK, MINWRK, NOUT       $                   IWRK, K, 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 212 Line 215
 *     ..  *     ..
 *     .. External Subroutines ..  *     .. External Subroutines ..
       EXTERNAL           DLABAD, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD,        EXTERNAL           DLABAD, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD,
      $                   ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZUNGHR       $                   ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZUNGHR
 *     ..  *     ..
 *     .. External Functions ..  *     .. External Functions ..
       LOGICAL            LSAME        LOGICAL            LSAME
Line 221 Line 224
       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 266 Line 269
             IF( WANTVL ) THEN              IF( WANTVL ) THEN
                MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',                 MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
      $                       ' ', N, 1, N, -1 ) )       $                       ' ', N, 1, N, -1 ) )
                  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, N + 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
                MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',                 MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
      $                       ' ', N, 1, N, -1 ) )       $                       ' ', N, 1, N, -1 ) )
                  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, N + 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
                CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR,                 CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR,
      $                WORK, -1, INFO )       $                      WORK, -1, INFO )
             END IF              END IF
             HSWORK = WORK( 1 )              HSWORK = INT( WORK(1) )
             MAXWRK = MAX( MAXWRK, HSWORK, MINWRK )              MAXWRK = MAX( MAXWRK, HSWORK, MINWRK )
          END IF           END IF
          WORK( 1 ) = MAXWRK           WORK( 1 ) = MAXWRK
Line 404 Line 417
      $                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 2*N)  *        (RWorkspace: need 2*N)
 *  *
          IRWORK = IBAL + N           IRWORK = IBAL + 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( IRWORK ), IERR )       $                 N, NOUT, WORK( IWRK ), LWORK-IWRK+1,
        $                 RWORK( IRWORK ), N, IERR )
       END IF        END IF
 *  *
       IF( WANTVL ) THEN        IF( WANTVL ) THEN
Line 436 Line 450
             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( IRWORK+K-1 ) = DBLE( VL( K, I ) )**2 +                 RWORK( IRWORK+K-1 ) = DBLE( VL( K, I ) )**2 +
      $                               DIMAG( VL( K, I ) )**2       $                               AIMAG( VL( K, I ) )**2
    10       CONTINUE     10       CONTINUE
             K = IDAMAX( N, RWORK( IRWORK ), 1 )              K = IDAMAX( N, RWORK( IRWORK ), 1 )
             TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) )              TMP = CONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) )
             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 461 Line 475
             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( IRWORK+K-1 ) = DBLE( VR( K, I ) )**2 +                 RWORK( IRWORK+K-1 ) = DBLE( VR( K, I ) )**2 +
      $                               DIMAG( VR( K, I ) )**2       $                               AIMAG( VR( K, I ) )**2
    30       CONTINUE     30       CONTINUE
             K = IDAMAX( N, RWORK( IRWORK ), 1 )              K = IDAMAX( N, RWORK( IRWORK ), 1 )
             TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) )              TMP = CONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) )
             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>