Diff for /rpl/lapack/lapack/dlanv2.f between versions 1.19 and 1.20

version 1.19, 2020/05/21 21:45:59 version 1.20, 2023/08/07 08:38:55
Line 109 Line 109
 *> \author Univ. of Colorado Denver  *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.  *> \author NAG Ltd.
 *  *
 *> \date December 2016  
 *  
 *> \ingroup doubleOTHERauxiliary  *> \ingroup doubleOTHERauxiliary
 *  *
 *> \par Further Details:  *> \par Further Details:
Line 127 Line 125
 *  =====================================================================  *  =====================================================================
       SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )        SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
 *  *
 *  -- LAPACK auxiliary routine (version 3.7.0) --  *  -- LAPACK auxiliary 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..--
 *     December 2016  
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       DOUBLE PRECISION   A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN        DOUBLE PRECISION   A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
Line 139 Line 136
 *  =====================================================================  *  =====================================================================
 *  *
 *     .. Parameters ..  *     .. Parameters ..
       DOUBLE PRECISION   ZERO, HALF, ONE        DOUBLE PRECISION   ZERO, HALF, ONE, TWO
       PARAMETER          ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )        PARAMETER          ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0,
        $                     TWO = 2.0D0 )
       DOUBLE PRECISION   MULTPL        DOUBLE PRECISION   MULTPL
       PARAMETER          ( MULTPL = 4.0D+0 )        PARAMETER          ( MULTPL = 4.0D+0 )
 *     ..  *     ..
 *     .. Local Scalars ..  *     .. Local Scalars ..
       DOUBLE PRECISION   AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,        DOUBLE PRECISION   AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,
      $                   SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z       $                   SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z, SAFMIN, 
        $                   SAFMN2, SAFMX2
         INTEGER            COUNT
 *     ..  *     ..
 *     .. External Functions ..  *     .. External Functions ..
       DOUBLE PRECISION   DLAMCH, DLAPY2        DOUBLE PRECISION   DLAMCH, DLAPY2
Line 157 Line 157
 *     ..  *     ..
 *     .. Executable Statements ..  *     .. Executable Statements ..
 *  *
         SAFMIN = DLAMCH( 'S' )
       EPS = DLAMCH( 'P' )        EPS = DLAMCH( 'P' )
         SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
        $            LOG( DLAMCH( 'B' ) ) / TWO )
         SAFMX2 = ONE / SAFMN2
       IF( C.EQ.ZERO ) THEN        IF( C.EQ.ZERO ) THEN
          CS = ONE           CS = ONE
          SN = ZERO           SN = ZERO
Line 212 Line 216
 *           Complex eigenvalues, or real (almost) equal eigenvalues.  *           Complex eigenvalues, or real (almost) equal eigenvalues.
 *           Make diagonal elements equal.  *           Make diagonal elements equal.
 *  *
               COUNT = 0
             SIGMA = B + C              SIGMA = B + C
      10       CONTINUE
               COUNT = COUNT + 1
               SCALE = MAX( ABS(TEMP), ABS(SIGMA) )
               IF( SCALE.GE.SAFMX2 ) THEN
                  SIGMA = SIGMA * SAFMN2
                  TEMP = TEMP * SAFMN2
                  IF (COUNT .LE. 20)
        $            GOTO 10
               END IF
               IF( SCALE.LE.SAFMN2 ) THEN
                  SIGMA = SIGMA * SAFMX2
                  TEMP = TEMP * SAFMX2
                  IF (COUNT .LE. 20)
        $            GOTO 10
               END IF
               P = HALF*TEMP
             TAU = DLAPY2( SIGMA, TEMP )              TAU = DLAPY2( SIGMA, TEMP )
             CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )              CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )
             SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA )              SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA )

Removed from v.1.19  
changed lines
  Added in v.1.20


CVSweb interface <joel.bertrand@systella.fr>