[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.8 and 1.17

version 1.8, 2011/11/21 20:43:08 version 1.17, 2018/05/29 07:18:14
Line 2 Line 2
 *  *
 *  =========== DOCUMENTATION ===========  *  =========== DOCUMENTATION ===========
 *  *
 * Online html documentation available at   * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/   *            http://www.netlib.org/lapack/explore-html/
 *  *
 *> \htmlonly  *> \htmlonly
 *> Download ZGEEV + dependencies   *> Download ZGEEV + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgeev.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgeev.f">
 *> [TGZ]</a>   *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgeev.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgeev.f">
 *> [ZIP]</a>   *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgeev.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgeev.f">
 *> [TXT]</a>  *> [TXT]</a>
 *> \endhtmlonly   *> \endhtmlonly
 *  *
 *  Definition:  *  Definition:
 *  ===========  *  ===========
 *  *
 *       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 )
 *   *
 *       .. Scalar Arguments ..  *       .. Scalar Arguments ..
 *       CHARACTER          JOBVL, JOBVR  *       CHARACTER          JOBVL, JOBVR
 *       INTEGER            INFO, LDA, LDVL, LDVR, LWORK, N  *       INTEGER            INFO, LDA, LDVL, LDVR, LWORK, N
Line 30 Line 30
 *       COMPLEX*16         A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),  *       COMPLEX*16         A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
 *      $                   W( * ), WORK( * )  *      $                   W( * ), WORK( * )
 *       ..  *       ..
 *    *
 *  *
 *> \par Purpose:  *> \par Purpose:
 *  =============  *  =============
Line 164 Line 164
 *  Authors:  *  Authors:
 *  ========  *  ========
 *  *
 *> \author Univ. of Tennessee   *> \author Univ. of Tennessee
 *> \author Univ. of California Berkeley   *> \author Univ. of California Berkeley
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.   *> \author NAG Ltd.
   *
   *> \date June 2016
 *  *
 *> \date November 2011  *  @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.7.0) --
 *  -- 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.8  
changed lines
  Added in v.1.17

CVSweb interface <joel.bertrand@systella.fr>