ssyevr.f.html

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

</span><span class="comment">*</span><span class="comment">     <a name="SSTEIN.423"></a><a href="sstein.f.html#SSTEIN.1">SSTEIN</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="SSYTRD.430"></a><a href="ssytrd.f.html#SSYTRD.1">SSYTRD</a> to reduce symmetric matrix to tridiagonal form.
</span><span class="comment">*</span><span class="comment">
</span>      CALL <a name="SSYTRD.432"></a><a href="ssytrd.f.html#SSYTRD.1">SSYTRD</a>( UPLO, N, A, LDA, WORK( INDD ), WORK( INDE ),
     $             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="SSTERF.436"></a><a href="ssterf.f.html#SSTERF.1">SSTERF</a> or <a name="SSTEMR.436"></a><a href="sstemr.f.html#SSTEMR.1">SSTEMR</a> and <a name="SORMTR.436"></a><a href="sormtr.f.html#SORMTR.1">SORMTR</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 SCOPY( N, WORK( INDD ), 1, W, 1 )
            CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
            CALL <a name="SSTERF.448"></a><a href="ssterf.f.html#SSTERF.1">SSTERF</a>( N, W, WORK( INDEE ), INFO )
         ELSE
            CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
            CALL SCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 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="SSTEMR.458"></a><a href="sstemr.f.html#SSTEMR.1">SSTEMR</a>( JOBZ, <span class="string">'A'</span>, N, WORK( INDDD ), WORK( INDEE ),
     $                   VL, VU, IL, IU, M, W, Z, LDZ, N, ISUPPZ,
     $                   TRYRAC, WORK( INDWK ), LWORK, IWORK, LIWORK,
     $                   INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Apply orthogonal matrix used in reduction to tridiagonal
</span><span class="comment">*</span><span class="comment">        form to eigenvectors returned by <a name="SSTEIN.466"></a><a href="sstein.f.html#SSTEIN.1">SSTEIN</a>.
</span><span class="comment">*</span><span class="comment">
</span>            IF( WANTZ .AND. INFO.EQ.0 ) THEN
               INDWKN = INDE
               LLWRKN = LWORK - INDWKN + 1
               CALL <a name="SORMTR.471"></a><a href="sormtr.f.html#SORMTR.1">SORMTR</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
<span class="comment">*</span><span class="comment">           Everything worked.  Skip <a name="SSTEBZ.479"></a><a href="sstebz.f.html#SSTEBZ.1">SSTEBZ</a>/<a name="SSTEIN.479"></a><a href="sstein.f.html#SSTEIN.1">SSTEIN</a>.  IWORK(:) are
</span><span class="comment">*</span><span class="comment">           undefined.
</span>            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="SSTEBZ.487"></a><a href="sstebz.f.html#SSTEBZ.1">SSTEBZ</a> and, if eigenvectors are desired, <a name="SSTEIN.487"></a><a href="sstein.f.html#SSTEIN.1">SSTEIN</a>.
</span><span class="comment">*</span><span class="comment">     Also call <a name="SSTEBZ.488"></a><a href="sstebz.f.html#SSTEBZ.1">SSTEBZ</a> and <a name="SSTEIN.488"></a><a href="sstein.f.html#SSTEIN.1">SSTEIN</a> if <a name="SSTEMR.488"></a><a href="sstemr.f.html#SSTEMR.1">SSTEMR</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="SSTEBZ.496"></a><a href="sstebz.f.html#SSTEBZ.1">SSTEBZ</a>( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
     $             WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
     $             IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWK ),
     $             IWORK( INDIWO ), INFO )
<span class="comment">*</span><span class="comment">
</span>      IF( WANTZ ) THEN
         CALL <a name="SSTEIN.502"></a><a href="sstein.f.html#SSTEIN.1">SSTEIN</a>( N, WORK( INDD ), WORK( INDE ), M, W,
     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
     $                WORK( INDWK ), IWORK( INDIWO ), IWORK( INDIFL ),
     $                INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Apply orthogonal matrix used in reduction to tridiagonal
</span><span class="comment">*</span><span class="comment">        form to eigenvectors returned by <a name="SSTEIN.508"></a><a href="sstein.f.html#SSTEIN.1">SSTEIN</a>.
</span><span class="comment">*</span><span class="comment">
</span>         INDWKN = INDE
         LLWRKN = LWORK - INDWKN + 1
         CALL <a name="SORMTR.512"></a><a href="sormtr.f.html#SORMTR.1">SORMTR</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><span class="comment">*</span><span class="comment">  Jump here if <a name="SSTEMR.518"></a><a href="sstemr.f.html#SSTEMR.1">SSTEMR</a>/<a name="SSTEIN.518"></a><a href="sstein.f.html#SSTEIN.1">SSTEIN</a> succeeded.
</span>   30 CONTINUE
      IF( ISCALE.EQ.1 ) THEN
         IF( INFO.EQ.0 ) THEN
            IMAX = M
         ELSE
            IMAX = INFO - 1
         END IF
         CALL SSCAL( 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.  Note: We do not sort the IFAIL portion of IWORK.
</span><span class="comment">*</span><span class="comment">     It may not be initialized (if <a name="SSTEMR.531"></a><a href="sstemr.f.html#SSTEMR.1">SSTEMR</a>/<a name="SSTEIN.531"></a><a href="sstein.f.html#SSTEIN.1">SSTEIN</a> succeeded), and we do
</span><span class="comment">*</span><span class="comment">     not return this detailed information to the user.
</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
               W( I ) = W( J )
               W( J ) = TMP1
               CALL SSWAP( 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
      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="SSYEVR.560"></a><a href="ssyevr.f.html#SSYEVR.1">SSYEVR</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>