110 lines
		
	
	
		
			2.2 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			110 lines
		
	
	
		
			2.2 KiB
		
	
	
	
		
			Fortran
		
	
	
	
*> \brief \b DROTG
 | 
						|
*
 | 
						|
*  =========== DOCUMENTATION ===========
 | 
						|
*
 | 
						|
* Online html documentation available at
 | 
						|
*            http://www.netlib.org/lapack/explore-html/
 | 
						|
*
 | 
						|
*  Definition:
 | 
						|
*  ===========
 | 
						|
*
 | 
						|
*       SUBROUTINE DROTG(DA,DB,C,S)
 | 
						|
*
 | 
						|
*       .. Scalar Arguments ..
 | 
						|
*       DOUBLE PRECISION C,DA,DB,S
 | 
						|
*       ..
 | 
						|
*
 | 
						|
*
 | 
						|
*> \par Purpose:
 | 
						|
*  =============
 | 
						|
*>
 | 
						|
*> \verbatim
 | 
						|
*>
 | 
						|
*>    DROTG construct givens plane rotation.
 | 
						|
*> \endverbatim
 | 
						|
*
 | 
						|
*  Arguments:
 | 
						|
*  ==========
 | 
						|
*
 | 
						|
*> \param[in] DA
 | 
						|
*> \verbatim
 | 
						|
*>          DA is DOUBLE PRECISION
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] DB
 | 
						|
*> \verbatim
 | 
						|
*>          DB is DOUBLE PRECISION
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[out] C
 | 
						|
*> \verbatim
 | 
						|
*>          C is DOUBLE PRECISION
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[out] S
 | 
						|
*> \verbatim
 | 
						|
*>          S is DOUBLE PRECISION
 | 
						|
*> \endverbatim
 | 
						|
*
 | 
						|
*  Authors:
 | 
						|
*  ========
 | 
						|
*
 | 
						|
*> \author Univ. of Tennessee
 | 
						|
*> \author Univ. of California Berkeley
 | 
						|
*> \author Univ. of Colorado Denver
 | 
						|
*> \author NAG Ltd.
 | 
						|
*
 | 
						|
*> \date November 2017
 | 
						|
*
 | 
						|
*> \ingroup double_blas_level1
 | 
						|
*
 | 
						|
*> \par Further Details:
 | 
						|
*  =====================
 | 
						|
*>
 | 
						|
*> \verbatim
 | 
						|
*>
 | 
						|
*>     jack dongarra, linpack, 3/11/78.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*  =====================================================================
 | 
						|
      SUBROUTINE DROTG(DA,DB,C,S)
 | 
						|
*
 | 
						|
*  -- Reference BLAS level1 routine (version 3.8.0) --
 | 
						|
*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 | 
						|
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 | 
						|
*     November 2017
 | 
						|
*
 | 
						|
*     .. Scalar Arguments ..
 | 
						|
      DOUBLE PRECISION C,DA,DB,S
 | 
						|
*     ..
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
*
 | 
						|
*     .. Local Scalars ..
 | 
						|
      DOUBLE PRECISION R,ROE,SCALE,Z
 | 
						|
*     ..
 | 
						|
*     .. Intrinsic Functions ..
 | 
						|
      INTRINSIC DABS,DSIGN,DSQRT
 | 
						|
*     ..
 | 
						|
      ROE = DB
 | 
						|
      IF (DABS(DA).GT.DABS(DB)) ROE = DA
 | 
						|
      SCALE = DABS(DA) + DABS(DB)
 | 
						|
      IF (SCALE.EQ.0.0d0) THEN
 | 
						|
         C = 1.0d0
 | 
						|
         S = 0.0d0
 | 
						|
         R = 0.0d0
 | 
						|
         Z = 0.0d0
 | 
						|
      ELSE
 | 
						|
         R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2)
 | 
						|
         R = DSIGN(1.0d0,ROE)*R
 | 
						|
         C = DA/R
 | 
						|
         S = DB/R
 | 
						|
         Z = 1.0d0
 | 
						|
         IF (DABS(DA).GT.DABS(DB)) Z = S
 | 
						|
         IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C
 | 
						|
      END IF
 | 
						|
      DA = R
 | 
						|
      DB = Z
 | 
						|
      RETURN
 | 
						|
      END
 |