*> \brief \b DLARTG generates a plane rotation with real cosine and real sine. * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * *> \htmlonly *> Download DLARTG + dependencies *> *> [TGZ] *> *> [ZIP] *> *> [TXT] *> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DLARTG( F, G, CS, SN, R ) * * .. Scalar Arguments .. * DOUBLE PRECISION CS, F, G, R, SN * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> DLARTG generate a plane rotation so that *> *> [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. *> [ -SN CS ] [ G ] [ 0 ] *> *> This is a slower, more accurate version of the BLAS1 routine DROTG, *> with the following other differences: *> F and G are unchanged on return. *> If G=0, then CS=1 and SN=0. *> If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any *> floating point operations (saves work in DBDSQR when *> there are zeros on the diagonal). *> *> If F exceeds G in magnitude, CS will be positive. *> \endverbatim * * Arguments: * ========== * *> \param[in] F *> \verbatim *> F is DOUBLE PRECISION *> The first component of vector to be rotated. *> \endverbatim *> *> \param[in] G *> \verbatim *> G is DOUBLE PRECISION *> The second component of vector to be rotated. *> \endverbatim *> *> \param[out] CS *> \verbatim *> CS is DOUBLE PRECISION *> The cosine of the rotation. *> \endverbatim *> *> \param[out] SN *> \verbatim *> SN is DOUBLE PRECISION *> The sine of the rotation. *> \endverbatim *> *> \param[out] R *> \verbatim *> R is DOUBLE PRECISION *> The nonzero component of the rotated vector. *> *> This version has a few statements commented out for thread safety *> (machine parameters are computed on each entry). 10 feb 03, SJH. *> \endverbatim * * Authors: * ======== * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. * *> \date December 2016 * *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLARTG( F, G, CS, SN, R ) * * -- LAPACK auxiliary routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION CS, F, G, R, SN * .. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ZERO PARAMETER ( ZERO = 0.0D0 ) DOUBLE PRECISION ONE PARAMETER ( ONE = 1.0D0 ) DOUBLE PRECISION TWO PARAMETER ( TWO = 2.0D0 ) * .. * .. Local Scalars .. * LOGICAL FIRST INTEGER COUNT, I DOUBLE PRECISION EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE * .. * .. External Functions .. DOUBLE PRECISION DLAMCH EXTERNAL DLAMCH * .. * .. Intrinsic Functions .. INTRINSIC ABS, INT, LOG, MAX, SQRT * .. * .. Save statement .. * SAVE FIRST, SAFMX2, SAFMIN, SAFMN2 * .. * .. Data statements .. * DATA FIRST / .TRUE. / * .. * .. Executable Statements .. * * IF( FIRST ) THEN SAFMIN = DLAMCH( 'S' ) EPS = DLAMCH( 'E' ) SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / \$ LOG( DLAMCH( 'B' ) ) / TWO ) SAFMX2 = ONE / SAFMN2 * FIRST = .FALSE. * END IF IF( G.EQ.ZERO ) THEN CS = ONE SN = ZERO R = F ELSE IF( F.EQ.ZERO ) THEN CS = ZERO SN = ONE R = G ELSE F1 = F G1 = G SCALE = MAX( ABS( F1 ), ABS( G1 ) ) IF( SCALE.GE.SAFMX2 ) THEN COUNT = 0 10 CONTINUE COUNT = COUNT + 1 F1 = F1*SAFMN2 G1 = G1*SAFMN2 SCALE = MAX( ABS( F1 ), ABS( G1 ) ) IF( SCALE.GE.SAFMX2 ) \$ GO TO 10 R = SQRT( F1**2+G1**2 ) CS = F1 / R SN = G1 / R DO 20 I = 1, COUNT R = R*SAFMX2 20 CONTINUE ELSE IF( SCALE.LE.SAFMN2 ) THEN COUNT = 0 30 CONTINUE COUNT = COUNT + 1 F1 = F1*SAFMX2 G1 = G1*SAFMX2 SCALE = MAX( ABS( F1 ), ABS( G1 ) ) IF( SCALE.LE.SAFMN2 ) \$ GO TO 30 R = SQRT( F1**2+G1**2 ) CS = F1 / R SN = G1 / R DO 40 I = 1, COUNT R = R*SAFMN2 40 CONTINUE ELSE R = SQRT( F1**2+G1**2 ) CS = F1 / R SN = G1 / R END IF IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN CS = -CS SN = -SN R = -R END IF END IF RETURN * * End of DLARTG * END