slarrb.f.html

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

</span><span class="comment">*</span><span class="comment">     The Sturm Count, Count( WORK(2*I-1) ) is arranged to be I-1, while
</span><span class="comment">*</span><span class="comment">     Count( WORK(2*I) ) is stored in IWORK( 2*I ). The integer IWORK( 2*I-1 )
</span><span class="comment">*</span><span class="comment">     for an unconverged interval is set to the index of the next unconverged
</span><span class="comment">*</span><span class="comment">     interval, and is -1 or 0 for a converged interval. Thus a linked
</span><span class="comment">*</span><span class="comment">     list of unconverged intervals is set up.
</span><span class="comment">*</span><span class="comment">
</span>      I1 = IFIRST
<span class="comment">*</span><span class="comment">     The number of unconverged intervals
</span>      NINT = 0
<span class="comment">*</span><span class="comment">     The last unconverged interval found
</span>      PREV = 0

      RGAP = WGAP( I1-OFFSET )
      DO 75 I = I1, ILAST
         K = 2*I
         II = I - OFFSET
         LEFT = W( II ) - WERR( II )
         RIGHT = W( II ) + WERR( II )
         LGAP = RGAP
         RGAP = WGAP( II )
         GAP = MIN( LGAP, RGAP )

<span class="comment">*</span><span class="comment">        Make sure that [LEFT,RIGHT] contains the desired eigenvalue
</span><span class="comment">*</span><span class="comment">        Compute negcount from dstqds facto L+D+L+^T = L D L^T - LEFT
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Do while( NEGCNT(LEFT).GT.I-1 )
</span><span class="comment">*</span><span class="comment">
</span>         BACK = WERR( II )
 20      CONTINUE
         NEGCNT = <a name="SLANEG.174"></a><a href="slaneg.f.html#SLANEG.1">SLANEG</a>( N, D, LLD, LEFT, PIVMIN, R )
         IF( NEGCNT.GT.I-1 ) THEN
            LEFT = LEFT - BACK
            BACK = TWO*BACK
            GO TO 20
         END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Do while( NEGCNT(RIGHT).LT.I )
</span><span class="comment">*</span><span class="comment">        Compute negcount from dstqds facto L+D+L+^T = L D L^T - RIGHT
</span><span class="comment">*</span><span class="comment">
</span>         BACK = WERR( II )
 50      CONTINUE

         NEGCNT = <a name="SLANEG.187"></a><a href="slaneg.f.html#SLANEG.1">SLANEG</a>( N, D, LLD, RIGHT, PIVMIN, R )
          IF( NEGCNT.LT.I ) THEN
             RIGHT = RIGHT + BACK
             BACK = TWO*BACK
             GO TO 50
          END IF
         WIDTH = HALF*ABS( LEFT - RIGHT )
         TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
         CVRGD = MAX(RTOL1*GAP,RTOL2*TMP)
         IF( WIDTH.LE.CVRGD .OR. WIDTH.LE.MNWDTH ) THEN
<span class="comment">*</span><span class="comment">           This interval has already converged and does not need refinement.
</span><span class="comment">*</span><span class="comment">           (Note that the gaps might change through refining the
</span><span class="comment">*</span><span class="comment">            eigenvalues, however, they can only get bigger.)
</span><span class="comment">*</span><span class="comment">           Remove it from the list.
</span>            IWORK( K-1 ) = -1
<span class="comment">*</span><span class="comment">           Make sure that I1 always points to the first unconverged interval
</span>            IF((I.EQ.I1).AND.(I.LT.ILAST)) I1 = I + 1
            IF((PREV.GE.I1).AND.(I.LE.ILAST)) IWORK( 2*PREV-1 ) = I + 1
         ELSE
<span class="comment">*</span><span class="comment">           unconverged interval found
</span>            PREV = I
            NINT = NINT + 1
            IWORK( K-1 ) = I + 1
            IWORK( K ) = NEGCNT
         END IF
         WORK( K-1 ) = LEFT
         WORK( K ) = RIGHT
 75   CONTINUE

<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Do while( NINT.GT.0 ), i.e. there are still unconverged intervals
</span><span class="comment">*</span><span class="comment">     and while (ITER.LT.MAXITR)
</span><span class="comment">*</span><span class="comment">
</span>      ITER = 0
 80   CONTINUE
      PREV = I1 - 1
      I = I1
      OLNINT = NINT

      DO 100 IP = 1, OLNINT
         K = 2*I
         II = I - OFFSET
         RGAP = WGAP( II )
         LGAP = RGAP
         IF(II.GT.1) LGAP = WGAP( II-1 )
         GAP = MIN( LGAP, RGAP )
         NEXT = IWORK( K-1 )
         LEFT = WORK( K-1 )
         RIGHT = WORK( K )
         MID = HALF*( LEFT + RIGHT )

<span class="comment">*</span><span class="comment">        semiwidth of interval
</span>         WIDTH = RIGHT - MID
         TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
         CVRGD = MAX(RTOL1*GAP,RTOL2*TMP)
         IF( ( WIDTH.LE.CVRGD ) .OR. ( WIDTH.LE.MNWDTH ).OR.
     $       ( ITER.EQ.MAXITR ) )THEN
<span class="comment">*</span><span class="comment">           reduce number of unconverged intervals
</span>            NINT = NINT - 1
<span class="comment">*</span><span class="comment">           Mark interval as converged.
</span>            IWORK( K-1 ) = 0
            IF( I1.EQ.I ) THEN
               I1 = NEXT
            ELSE
<span class="comment">*</span><span class="comment">              Prev holds the last unconverged interval previously examined
</span>               IF(PREV.GE.I1) IWORK( 2*PREV-1 ) = NEXT
            END IF
            I = NEXT
            GO TO 100
         END IF
         PREV = I
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Perform one bisection step
</span><span class="comment">*</span><span class="comment">
</span>         NEGCNT = <a name="SLANEG.261"></a><a href="slaneg.f.html#SLANEG.1">SLANEG</a>( N, D, LLD, MID, PIVMIN, R )
         IF( NEGCNT.LE.I-1 ) THEN
            WORK( K-1 ) = MID
         ELSE
            WORK( K ) = MID
         END IF
         I = NEXT
 100  CONTINUE
      ITER = ITER + 1
<span class="comment">*</span><span class="comment">     do another loop if there are still unconverged intervals
</span><span class="comment">*</span><span class="comment">     However, in the last iteration, all intervals are accepted
</span><span class="comment">*</span><span class="comment">     since this is the best we can do.
</span>      IF( ( NINT.GT.0 ).AND.(ITER.LE.MAXITR) ) GO TO 80
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     At this point, all the intervals have converged
</span>      DO 110 I = IFIRST, ILAST
         K = 2*I
         II = I - OFFSET
<span class="comment">*</span><span class="comment">        All intervals marked by '0' have been refined.
</span>         IF( IWORK( K-1 ).EQ.0 ) THEN
            W( II ) = HALF*( WORK( K-1 )+WORK( K ) )
            WERR( II ) = WORK( K ) - W( II )
         END IF
 110  CONTINUE
<span class="comment">*</span><span class="comment">
</span>      DO 111 I = IFIRST+1, ILAST
         K = 2*I
         II = I - OFFSET
         WGAP( II-1 ) = MAX( ZERO,
     $                     W(II) - WERR (II) - W( II-1 ) - WERR( II-1 ))
 111  CONTINUE

      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="SLARRB.296"></a><a href="slarrb.f.html#SLARRB.1">SLARRB</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>