Return to dlartg.f CVS log

Up to [local] / rpl / lapack / lapack

Annotation of rpl/lapack/lapack/dlartg.f, revision 1.1

1.1     ! bertrand    1:       SUBROUTINE DLARTG( F, G, CS, SN, R )
        !             2: *
        !             3: *  -- LAPACK auxiliary routine (version 3.2) --
        !             4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
        !             5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
        !             6: *     November 2006
        !             7: *
        !             8: *     .. Scalar Arguments ..
        !             9:       DOUBLE PRECISION   CS, F, G, R, SN
        !            10: *     ..
        !            11: *
        !            12: *  Purpose
        !            13: *  =======
        !            14: *
        !            15: *  DLARTG generate a plane rotation so that
        !            16: *
        !            17: *     [  CS  SN  ]  .  [ F ]  =  [ R ]   where CS**2 + SN**2 = 1.
        !            18: *     [ -SN  CS  ]     [ G ]     [ 0 ]
        !            19: *
        !            20: *  This is a slower, more accurate version of the BLAS1 routine DROTG,
        !            21: *  with the following other differences:
        !            22: *     F and G are unchanged on return.
        !            23: *     If G=0, then CS=1 and SN=0.
        !            24: *     If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
        !            25: *        floating point operations (saves work in DBDSQR when
        !            26: *        there are zeros on the diagonal).
        !            27: *
        !            28: *  If F exceeds G in magnitude, CS will be positive.
        !            29: *
        !            30: *  Arguments
        !            31: *  =========
        !            32: *
        !            33: *  F       (input) DOUBLE PRECISION
        !            34: *          The first component of vector to be rotated.
        !            35: *
        !            36: *  G       (input) DOUBLE PRECISION
        !            37: *          The second component of vector to be rotated.
        !            38: *
        !            39: *  CS      (output) DOUBLE PRECISION
        !            40: *          The cosine of the rotation.
        !            41: *
        !            42: *  SN      (output) DOUBLE PRECISION
        !            43: *          The sine of the rotation.
        !            44: *
        !            45: *  R       (output) DOUBLE PRECISION
        !            46: *          The nonzero component of the rotated vector.
        !            47: *
        !            48: *  This version has a few statements commented out for thread safety
        !            49: *  (machine parameters are computed on each entry). 10 feb 03, SJH.
        !            50: *
        !            51: *  =====================================================================
        !            52: *
        !            53: *     .. Parameters ..
        !            54:       DOUBLE PRECISION   ZERO
        !            55:       PARAMETER          ( ZERO = 0.0D0 )
        !            56:       DOUBLE PRECISION   ONE
        !            57:       PARAMETER          ( ONE = 1.0D0 )
        !            58:       DOUBLE PRECISION   TWO
        !            59:       PARAMETER          ( TWO = 2.0D0 )
        !            60: *     ..
        !            61: *     .. Local Scalars ..
        !            62: *     LOGICAL            FIRST
        !            63:       INTEGER            COUNT, I
        !            64:       DOUBLE PRECISION   EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
        !            65: *     ..
        !            66: *     .. External Functions ..
        !            67:       DOUBLE PRECISION   DLAMCH
        !            68:       EXTERNAL           DLAMCH
        !            69: *     ..
        !            70: *     .. Intrinsic Functions ..
        !            71:       INTRINSIC          ABS, INT, LOG, MAX, SQRT
        !            72: *     ..
        !            73: *     .. Save statement ..
        !            74: *     SAVE               FIRST, SAFMX2, SAFMIN, SAFMN2
        !            75: *     ..
        !            76: *     .. Data statements ..
        !            77: *     DATA               FIRST / .TRUE. /
        !            78: *     ..
        !            79: *     .. Executable Statements ..
        !            80: *
        !            81: *     IF( FIRST ) THEN
        !            82:          SAFMIN = DLAMCH( 'S' )
        !            83:          EPS = DLAMCH( 'E' )
        !            84:          SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
        !            85:      $            LOG( DLAMCH( 'B' ) ) / TWO )
        !            86:          SAFMX2 = ONE / SAFMN2
        !            87: *        FIRST = .FALSE.
        !            88: *     END IF
        !            89:       IF( G.EQ.ZERO ) THEN
        !            90:          CS = ONE
        !            91:          SN = ZERO
        !            92:          R = F
        !            93:       ELSE IF( F.EQ.ZERO ) THEN
        !            94:          CS = ZERO
        !            95:          SN = ONE
        !            96:          R = G
        !            97:       ELSE
        !            98:          F1 = F
        !            99:          G1 = G
        !           100:          SCALE = MAX( ABS( F1 ), ABS( G1 ) )
        !           101:          IF( SCALE.GE.SAFMX2 ) THEN
        !           102:             COUNT = 0
        !           103:    10       CONTINUE
        !           104:             COUNT = COUNT + 1
        !           105:             F1 = F1*SAFMN2
        !           106:             G1 = G1*SAFMN2
        !           107:             SCALE = MAX( ABS( F1 ), ABS( G1 ) )
        !           108:             IF( SCALE.GE.SAFMX2 )
        !           109:      $         GO TO 10
        !           110:             R = SQRT( F1**2+G1**2 )
        !           111:             CS = F1 / R
        !           112:             SN = G1 / R
        !           113:             DO 20 I = 1, COUNT
        !           114:                R = R*SAFMX2
        !           115:    20       CONTINUE
        !           116:          ELSE IF( SCALE.LE.SAFMN2 ) THEN
        !           117:             COUNT = 0
        !           118:    30       CONTINUE
        !           119:             COUNT = COUNT + 1
        !           120:             F1 = F1*SAFMX2
        !           121:             G1 = G1*SAFMX2
        !           122:             SCALE = MAX( ABS( F1 ), ABS( G1 ) )
        !           123:             IF( SCALE.LE.SAFMN2 )
        !           124:      $         GO TO 30
        !           125:             R = SQRT( F1**2+G1**2 )
        !           126:             CS = F1 / R
        !           127:             SN = G1 / R
        !           128:             DO 40 I = 1, COUNT
        !           129:                R = R*SAFMN2
        !           130:    40       CONTINUE
        !           131:          ELSE
        !           132:             R = SQRT( F1**2+G1**2 )
        !           133:             CS = F1 / R
        !           134:             SN = G1 / R
        !           135:          END IF
        !           136:          IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN
        !           137:             CS = -CS
        !           138:             SN = -SN
        !           139:             R = -R
        !           140:          END IF
        !           141:       END IF
        !           142:       RETURN
        !           143: *
        !           144: *     End of DLARTG
        !           145: *
        !           146:       END