[BACK]Return to dlasq5.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/dlasq5.f between versions 1.9 and 1.10

version 1.9, 2011/11/21 22:19:35 version 1.10, 2012/07/31 11:06:36
Line 18 Line 18
 *  Definition:  *  Definition:
 *  ===========  *  ===========
 *  *
 *       SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,  *       SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, DN,
 *                          DNM1, DNM2, IEEE )  *                          DNM1, DNM2, IEEE, EPS )
 *   * 
 *       .. Scalar Arguments ..  *       .. Scalar Arguments ..
 *       LOGICAL            IEEE  *       LOGICAL            IEEE
 *       INTEGER            I0, N0, PP  *       INTEGER            I0, N0, PP
 *       DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU  *       DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU, SIGMA, EPS
 *       ..  *       ..
 *       .. Array Arguments ..  *       .. Array Arguments ..
 *       DOUBLE PRECISION   Z( * )  *       DOUBLE PRECISION   Z( * )
Line 74 Line 74
 *>        This is the shift.  *>        This is the shift.
 *> \endverbatim  *> \endverbatim
 *>  *>
   *> \param[in] SIGMA
   *> \verbatim
   *>          SIGMA is DOUBLE PRECISION
   *>        This is the accumulated shift up to this step.
   *> \endverbatim
   *>
 *> \param[out] DMIN  *> \param[out] DMIN
 *> \verbatim  *> \verbatim
 *>          DMIN is DOUBLE PRECISION  *>          DMIN is DOUBLE PRECISION
Line 116 Line 122
 *>        Flag for IEEE or non IEEE arithmetic.  *>        Flag for IEEE or non IEEE arithmetic.
 *> \endverbatim  *> \endverbatim
 *  *
   *> \param[in] EPS
   *> \verbatim
   *>          EPS is DOUBLE PRECISION
   *>        This is the value of epsilon used.
   *> \endverbatim
   *>
 *  Authors:  *  Authors:
 *  ========  *  ========
 *  *
Line 124 Line 136
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver 
 *> \author NAG Ltd.   *> \author NAG Ltd. 
 *  *
 *> \date November 2011  *> \date April 2012
 *  *
 *> \ingroup auxOTHERcomputational  *> \ingroup auxOTHERcomputational
 *  *
 *  =====================================================================  *  =====================================================================
       SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,        SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2,
      $                   DNM1, DNM2, IEEE )       $                   DN, DNM1, DNM2, IEEE, EPS )
 *  *
 *  -- LAPACK computational routine (version 3.4.0) --  *  -- LAPACK computational routine (version 3.4.1) --
 *  -- 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  *     April 2012
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       LOGICAL            IEEE        LOGICAL            IEEE
       INTEGER            I0, N0, PP        INTEGER            I0, N0, PP
       DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU        DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU,
        $                   SIGMA, EPS
 *     ..  *     ..
 *     .. Array Arguments ..  *     .. Array Arguments ..
       DOUBLE PRECISION   Z( * )        DOUBLE PRECISION   Z( * )
Line 149 Line 162
 *  =====================================================================  *  =====================================================================
 *  *
 *     .. Parameter ..  *     .. Parameter ..
       DOUBLE PRECISION   ZERO        DOUBLE PRECISION   ZERO, HALF
       PARAMETER          ( ZERO = 0.0D0 )        PARAMETER          ( ZERO = 0.0D0, HALF = 0.5 )
 *     ..  *     ..
 *     .. Local Scalars ..  *     .. Local Scalars ..
       INTEGER            J4, J4P2        INTEGER            J4, J4P2
       DOUBLE PRECISION   D, EMIN, TEMP        DOUBLE PRECISION   D, EMIN, TEMP, DTHRESH
 *     ..  *     ..
 *     .. Intrinsic Functions ..  *     .. Intrinsic Functions ..
       INTRINSIC          MIN        INTRINSIC          MIN
Line 164 Line 177
       IF( ( N0-I0-1 ).LE.0 )        IF( ( N0-I0-1 ).LE.0 )
      $   RETURN       $   RETURN
 *  *
         DTHRESH = EPS*(SIGMA+TAU)
         IF( TAU.LT.DTHRESH*HALF ) TAU = ZERO
         IF( TAU.NE.ZERO ) THEN
       J4 = 4*I0 + PP - 3        J4 = 4*I0 + PP - 3
       EMIN = Z( J4+4 )         EMIN = Z( J4+4 ) 
       D = Z( J4 ) - TAU        D = Z( J4 ) - TAU
Line 271 Line 287
          DMIN = MIN( DMIN, DN )           DMIN = MIN( DMIN, DN )
 *  *
       END IF        END IF
 *        ELSE
   *     This is the version that sets d's to zero if they are small enough
            J4 = 4*I0 + PP - 3
            EMIN = Z( J4+4 ) 
            D = Z( J4 ) - TAU
            DMIN = D
            DMIN1 = -Z( J4 )
            IF( IEEE ) THEN
   *     
   *     Code for IEEE arithmetic.
   *     
               IF( PP.EQ.0 ) THEN
                  DO 50 J4 = 4*I0, 4*( N0-3 ), 4
                     Z( J4-2 ) = D + Z( J4-1 ) 
                     TEMP = Z( J4+1 ) / Z( J4-2 )
                     D = D*TEMP - TAU
                     IF( D.LT.DTHRESH ) D = ZERO
                     DMIN = MIN( DMIN, D )
                     Z( J4 ) = Z( J4-1 )*TEMP
                     EMIN = MIN( Z( J4 ), EMIN )
    50            CONTINUE
               ELSE
                  DO 60 J4 = 4*I0, 4*( N0-3 ), 4
                     Z( J4-3 ) = D + Z( J4 ) 
                     TEMP = Z( J4+2 ) / Z( J4-3 )
                     D = D*TEMP - TAU
                     IF( D.LT.DTHRESH ) D = ZERO
                     DMIN = MIN( DMIN, D )
                     Z( J4-1 ) = Z( J4 )*TEMP
                     EMIN = MIN( Z( J4-1 ), EMIN )
    60            CONTINUE
               END IF
   *     
   *     Unroll last two steps. 
   *     
               DNM2 = D
               DMIN2 = DMIN
               J4 = 4*( N0-2 ) - PP
               J4P2 = J4 + 2*PP - 1
               Z( J4-2 ) = DNM2 + Z( J4P2 )
               Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
               DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
               DMIN = MIN( DMIN, DNM1 )
   *     
               DMIN1 = DMIN
               J4 = J4 + 4
               J4P2 = J4 + 2*PP - 1
               Z( J4-2 ) = DNM1 + Z( J4P2 )
               Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
               DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
               DMIN = MIN( DMIN, DN )
   *     
            ELSE
   *     
   *     Code for non IEEE arithmetic.
   *     
               IF( PP.EQ.0 ) THEN
                  DO 70 J4 = 4*I0, 4*( N0-3 ), 4
                     Z( J4-2 ) = D + Z( J4-1 ) 
                     IF( D.LT.ZERO ) THEN
                        RETURN
                     ELSE 
                        Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
                        D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
                     END IF
                     IF( D.LT.DTHRESH) D = ZERO
                     DMIN = MIN( DMIN, D )
                     EMIN = MIN( EMIN, Z( J4 ) )
    70            CONTINUE
               ELSE
                  DO 80 J4 = 4*I0, 4*( N0-3 ), 4
                     Z( J4-3 ) = D + Z( J4 ) 
                     IF( D.LT.ZERO ) THEN
                        RETURN
                     ELSE 
                        Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
                        D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
                     END IF
                     IF( D.LT.DTHRESH) D = ZERO
                     DMIN = MIN( DMIN, D )
                     EMIN = MIN( EMIN, Z( J4-1 ) )
    80            CONTINUE
               END IF
   *     
   *     Unroll last two steps. 
   *     
               DNM2 = D
               DMIN2 = DMIN
               J4 = 4*( N0-2 ) - PP
               J4P2 = J4 + 2*PP - 1
               Z( J4-2 ) = DNM2 + Z( J4P2 )
               IF( DNM2.LT.ZERO ) THEN
                  RETURN
               ELSE
                  Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
                  DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
               END IF
               DMIN = MIN( DMIN, DNM1 )
   *     
               DMIN1 = DMIN
               J4 = J4 + 4
               J4P2 = J4 + 2*PP - 1
               Z( J4-2 ) = DNM1 + Z( J4P2 )
               IF( DNM1.LT.ZERO ) THEN
                  RETURN
               ELSE
                  Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
                  DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
               END IF
               DMIN = MIN( DMIN, DN )
   *     
            END IF
         END IF
   *     
       Z( J4+2 ) = DN        Z( J4+2 ) = DN
       Z( 4*N0-PP ) = EMIN        Z( 4*N0-PP ) = EMIN
       RETURN        RETURN
Removed from v.1.9  
changed lines
  Added in v.1.10

CVSweb interface <joel.bertrand@systella.fr>