*> \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 
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlartg.f"> 
*> [TGZ]</a> 
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlartg.f"> 
*> [ZIP]</a> 
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlartg.f"> 
*> [TXT]</a>
*> \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 September 2012
*
*> \ingroup auxOTHERauxiliary
*
*  =====================================================================
      SUBROUTINE GAL_DLARTG(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 GAL_DLAMCH
      EXTERNAL GAL_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=GAL_DLAMCH('S')
      EPS=GAL_DLAMCH('E')
      SAFMN2=GAL_DLAMCH('B')**INT(LOG(SAFMIN/EPS)/
     $LOG(GAL_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 20I=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 40I=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 
