zheevr.f.html

来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 613 行 · 第 1/4 页

</span><span class="comment">*</span><span class="comment">     stores the block indices of each of the M&lt;=N eigenvalues.
</span>      INDIBL = 1
<span class="comment">*</span><span class="comment">     IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in <a name="DSTEBZ.446"></a><a href="dstebz.f.html#DSTEBZ.1">DSTEBZ</a> and
</span><span class="comment">*</span><span class="comment">     stores the starting and finishing indices of each block.
</span>      INDISP = INDIBL + N
<span class="comment">*</span><span class="comment">     IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
</span><span class="comment">*</span><span class="comment">     that corresponding to eigenvectors that fail to converge in
</span><span class="comment">*</span><span class="comment">     <a name="DSTEIN.451"></a><a href="dstein.f.html#DSTEIN.1">DSTEIN</a>.  This information is discarded; if any fail, the driver
</span><span class="comment">*</span><span class="comment">     returns INFO &gt; 0.
</span>      INDIFL = INDISP + N
<span class="comment">*</span><span class="comment">     INDIWO is the offset of the remaining integer workspace.
</span>      INDIWO = INDISP + N

<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Call <a name="ZHETRD.458"></a><a href="zhetrd.f.html#ZHETRD.1">ZHETRD</a> to reduce Hermitian matrix to tridiagonal form.
</span><span class="comment">*</span><span class="comment">
</span>      CALL <a name="ZHETRD.460"></a><a href="zhetrd.f.html#ZHETRD.1">ZHETRD</a>( UPLO, N, A, LDA, RWORK( INDRD ), RWORK( INDRE ),
     $             WORK( INDTAU ), WORK( INDWK ), LLWORK, IINFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     If all eigenvalues are desired
</span><span class="comment">*</span><span class="comment">     then call <a name="DSTERF.464"></a><a href="dsterf.f.html#DSTERF.1">DSTERF</a> or <a name="ZSTEMR.464"></a><a href="zstemr.f.html#ZSTEMR.1">ZSTEMR</a> and <a name="ZUNMTR.464"></a><a href="zunmtr.f.html#ZUNMTR.1">ZUNMTR</a>.
</span><span class="comment">*</span><span class="comment">
</span>      TEST = .FALSE.
      IF( INDEIG ) THEN
         IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
            TEST = .TRUE.
         END IF
      END IF
      IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN
         IF( .NOT.WANTZ ) THEN
            CALL DCOPY( N, RWORK( INDRD ), 1, W, 1 )
            CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
            CALL <a name="DSTERF.476"></a><a href="dsterf.f.html#DSTERF.1">DSTERF</a>( N, W, RWORK( INDREE ), INFO )
         ELSE
            CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
            CALL DCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 )
<span class="comment">*</span><span class="comment">
</span>            IF (ABSTOL .LE. TWO*N*EPS) THEN
               TRYRAC = .TRUE.
            ELSE
               TRYRAC = .FALSE.
            END IF
            CALL <a name="ZSTEMR.486"></a><a href="zstemr.f.html#ZSTEMR.1">ZSTEMR</a>( JOBZ, <span class="string">'A'</span>, N, RWORK( INDRDD ),
     $                   RWORK( INDREE ), VL, VU, IL, IU, M, W,
     $                   Z, LDZ, N, ISUPPZ, TRYRAC,
     $                   RWORK( INDRWK ), LLRWORK,
     $                   IWORK, LIWORK, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Apply unitary matrix used in reduction to tridiagonal
</span><span class="comment">*</span><span class="comment">           form to eigenvectors returned by <a name="ZSTEIN.493"></a><a href="zstein.f.html#ZSTEIN.1">ZSTEIN</a>.
</span><span class="comment">*</span><span class="comment">
</span>            IF( WANTZ .AND. INFO.EQ.0 ) THEN
               INDWKN = INDWK
               LLWRKN = LWORK - INDWKN + 1
               CALL <a name="ZUNMTR.498"></a><a href="zunmtr.f.html#ZUNMTR.1">ZUNMTR</a>( <span class="string">'L'</span>, UPLO, <span class="string">'N'</span>, N, M, A, LDA,
     $                      WORK( INDTAU ), Z, LDZ, WORK( INDWKN ),
     $                      LLWRKN, IINFO )
            END IF
         END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span>         IF( INFO.EQ.0 ) THEN
            M = N
            GO TO 30
         END IF
         INFO = 0
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Otherwise, call <a name="DSTEBZ.512"></a><a href="dstebz.f.html#DSTEBZ.1">DSTEBZ</a> and, if eigenvectors are desired, <a name="ZSTEIN.512"></a><a href="zstein.f.html#ZSTEIN.1">ZSTEIN</a>.
</span><span class="comment">*</span><span class="comment">     Also call <a name="DSTEBZ.513"></a><a href="dstebz.f.html#DSTEBZ.1">DSTEBZ</a> and <a name="ZSTEIN.513"></a><a href="zstein.f.html#ZSTEIN.1">ZSTEIN</a> if <a name="ZSTEMR.513"></a><a href="zstemr.f.html#ZSTEMR.1">ZSTEMR</a> fails.
</span><span class="comment">*</span><span class="comment">
</span>      IF( WANTZ ) THEN
         ORDER = <span class="string">'B'</span>
      ELSE
         ORDER = <span class="string">'E'</span>
      END IF

      CALL <a name="DSTEBZ.521"></a><a href="dstebz.f.html#DSTEBZ.1">DSTEBZ</a>( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
     $             RWORK( INDRD ), RWORK( INDRE ), M, NSPLIT, W,
     $             IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
     $             IWORK( INDIWO ), INFO )
<span class="comment">*</span><span class="comment">
</span>      IF( WANTZ ) THEN
         CALL <a name="ZSTEIN.527"></a><a href="zstein.f.html#ZSTEIN.1">ZSTEIN</a>( N, RWORK( INDRD ), RWORK( INDRE ), M, W,
     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
     $                RWORK( INDRWK ), IWORK( INDIWO ), IWORK( INDIFL ),
     $                INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Apply unitary matrix used in reduction to tridiagonal
</span><span class="comment">*</span><span class="comment">        form to eigenvectors returned by <a name="ZSTEIN.533"></a><a href="zstein.f.html#ZSTEIN.1">ZSTEIN</a>.
</span><span class="comment">*</span><span class="comment">
</span>         INDWKN = INDWK
         LLWRKN = LWORK - INDWKN + 1
         CALL <a name="ZUNMTR.537"></a><a href="zunmtr.f.html#ZUNMTR.1">ZUNMTR</a>( <span class="string">'L'</span>, UPLO, <span class="string">'N'</span>, N, M, A, LDA, WORK( INDTAU ), Z,
     $                LDZ, WORK( INDWKN ), LLWRKN, IINFO )
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     If matrix was scaled, then rescale eigenvalues appropriately.
</span><span class="comment">*</span><span class="comment">
</span>   30 CONTINUE
      IF( ISCALE.EQ.1 ) THEN
         IF( INFO.EQ.0 ) THEN
            IMAX = M
         ELSE
            IMAX = INFO - 1
         END IF
         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     If eigenvalues are not in order, then sort them, along with
</span><span class="comment">*</span><span class="comment">     eigenvectors.
</span><span class="comment">*</span><span class="comment">
</span>      IF( WANTZ ) THEN
         DO 50 J = 1, M - 1
            I = 0
            TMP1 = W( J )
            DO 40 JJ = J + 1, M
               IF( W( JJ ).LT.TMP1 ) THEN
                  I = JJ
                  TMP1 = W( JJ )
               END IF
   40       CONTINUE
<span class="comment">*</span><span class="comment">
</span>            IF( I.NE.0 ) THEN
               ITMP1 = IWORK( INDIBL+I-1 )
               W( I ) = W( J )
               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
               W( J ) = TMP1
               IWORK( INDIBL+J-1 ) = ITMP1
               CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
            END IF
   50    CONTINUE
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Set WORK(1) to optimal workspace size.
</span><span class="comment">*</span><span class="comment">
</span>      WORK( 1 ) = LWKOPT
      RWORK( 1 ) = LRWMIN
      IWORK( 1 ) = LIWMIN
<span class="comment">*</span><span class="comment">
</span>      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="ZHEEVR.586"></a><a href="zheevr.f.html#ZHEEVR.1">ZHEEVR</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>