*> \brief \b DLARTGP generates a plane rotation so that the diagonal is nonnegative.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DLARTGP + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE DLARTGP( F, G, CS, SN, R )
*
* .. Scalar Arguments ..
* DOUBLE PRECISION CS, F, G, R, SN
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DLARTGP generates 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 Level 1 BLAS 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.
*>
*> The sign is chosen so that R >= 0.
*> \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 September 2012
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE DLARTGP( F, G, CS, SN, R )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
*
* .. 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, SIGN, 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 = SIGN( ONE, F )
SN = ZERO
R = ABS( F )
ELSE IF( F.EQ.ZERO ) THEN
CS = ZERO
SN = SIGN( ONE, G )
R = ABS( 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( R.LT.ZERO ) THEN
CS = -CS
SN = -SN
R = -R
END IF
END IF
RETURN
*
* End of DLARTGP
*
END