Diff for /rpl/lapack/lapack/dlaed6.f between versions 1.9 and 1.21

version 1.9, 2011/11/21 20:42:54 version 1.21, 2023/08/07 08:38:53
Line 1 Line 1
 *> \brief \b DLAED6  *> \brief \b DLAED6 used by DSTEDC. Computes one Newton step in solution of the secular equation.
 *  *
 *  =========== 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 DLAED6 + dependencies   *> Download DLAED6 + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed6.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaed6.f">
 *> [TGZ]</a>   *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed6.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaed6.f">
 *> [ZIP]</a>   *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed6.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaed6.f">
 *> [TXT]</a>  *> [TXT]</a>
 *> \endhtmlonly   *> \endhtmlonly
 *  *
 *  Definition:  *  Definition:
 *  ===========  *  ===========
 *  *
 *       SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )  *       SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )
 *   *
 *       .. Scalar Arguments ..  *       .. Scalar Arguments ..
 *       LOGICAL            ORGATI  *       LOGICAL            ORGATI
 *       INTEGER            INFO, KNITER  *       INTEGER            INFO, KNITER
Line 28 Line 28
 *       .. Array Arguments ..  *       .. Array Arguments ..
 *       DOUBLE PRECISION   D( 3 ), Z( 3 )  *       DOUBLE PRECISION   D( 3 ), Z( 3 )
 *       ..  *       ..
 *    *
 *  *
 *> \par Purpose:  *> \par Purpose:
 *  =============  *  =============
Line 110 Line 110
 *  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 November 2011  
 *  *
 *> \ingroup auxOTHERcomputational  *> \ingroup auxOTHERcomputational
 *  *
Line 140 Line 138
 *  =====================================================================  *  =====================================================================
       SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )        SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )
 *  *
 *  -- LAPACK computational routine (version 3.4.0) --  *  -- LAPACK computational routine --
 *  -- 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  
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       LOGICAL            ORGATI        LOGICAL            ORGATI
Line 175 Line 172
       INTEGER            I, ITER, NITER        INTEGER            I, ITER, NITER
       DOUBLE PRECISION   A, B, BASE, C, DDF, DF, EPS, ERRETM, ETA, F,        DOUBLE PRECISION   A, B, BASE, C, DDF, DF, EPS, ERRETM, ETA, F,
      $                   FC, SCLFAC, SCLINV, SMALL1, SMALL2, SMINV1,       $                   FC, SCLFAC, SCLINV, SMALL1, SMALL2, SMINV1,
      $                   SMINV2, TEMP, TEMP1, TEMP2, TEMP3, TEMP4,        $                   SMINV2, TEMP, TEMP1, TEMP2, TEMP3, TEMP4,
      $                   LBD, UBD       $                   LBD, UBD
 *     ..  *     ..
 *     .. Intrinsic Functions ..  *     .. Intrinsic Functions ..
Line 195 Line 192
       IF( FINIT .LT. ZERO )THEN        IF( FINIT .LT. ZERO )THEN
          LBD = ZERO           LBD = ZERO
       ELSE        ELSE
          UBD = ZERO            UBD = ZERO
       END IF        END IF
 *  *
       NITER = 1        NITER = 1
Line 363 Line 360
 *  *
          TAU = TAU + ETA           TAU = TAU + ETA
          IF( TAU .LT. LBD .OR. TAU .GT. UBD )           IF( TAU .LT. LBD .OR. TAU .GT. UBD )
      $      TAU = ( LBD + UBD )/TWO        $      TAU = ( LBD + UBD )/TWO
 *  *
          FC = ZERO           FC = ZERO
          ERRETM = ZERO           ERRETM = ZERO
          DF = ZERO           DF = ZERO
          DDF = ZERO           DDF = ZERO
          DO 40 I = 1, 3           DO 40 I = 1, 3
             TEMP = ONE / ( DSCALE( I )-TAU )              IF ( ( DSCALE( I )-TAU ).NE.ZERO ) THEN
             TEMP1 = ZSCALE( I )*TEMP                 TEMP = ONE / ( DSCALE( I )-TAU )
             TEMP2 = TEMP1*TEMP                 TEMP1 = ZSCALE( I )*TEMP
             TEMP3 = TEMP2*TEMP                 TEMP2 = TEMP1*TEMP
             TEMP4 = TEMP1 / DSCALE( I )                 TEMP3 = TEMP2*TEMP
             FC = FC + TEMP4                 TEMP4 = TEMP1 / DSCALE( I )
             ERRETM = ERRETM + ABS( TEMP4 )                 FC = FC + TEMP4
             DF = DF + TEMP2                 ERRETM = ERRETM + ABS( TEMP4 )
             DDF = DDF + TEMP3                 DF = DF + TEMP2
                  DDF = DDF + TEMP3
               ELSE
                  GO TO 60
               END IF
    40    CONTINUE     40    CONTINUE
          F = FINIT + TAU*FC           F = FINIT + TAU*FC
          ERRETM = EIGHT*( ABS( FINIT )+ABS( TAU )*ERRETM ) +           ERRETM = EIGHT*( ABS( FINIT )+ABS( TAU )*ERRETM ) +
      $            ABS( TAU )*DF       $            ABS( TAU )*DF
          IF( ABS( F ).LE.EPS*ERRETM )           IF( ( ABS( F ).LE.FOUR*EPS*ERRETM ) .OR.
        $      ( (UBD-LBD).LE.FOUR*EPS*ABS(TAU) )  )
      $      GO TO 60       $      GO TO 60
          IF( F .LE. ZERO )THEN           IF( F .LE. ZERO )THEN
             LBD = TAU              LBD = TAU

Removed from v.1.9  
changed lines
  Added in v.1.21


CVSweb interface <joel.bertrand@systella.fr>