LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
srotg.f
Go to the documentation of this file.
00001 *> \brief \b SROTG
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE SROTG(SA,SB,C,S)
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       REAL C,S,SA,SB
00015 *       ..
00016 *  
00017 *
00018 *> \par Purpose:
00019 *  =============
00020 *>
00021 *> \verbatim
00022 *>
00023 *>    SROTG construct givens plane rotation.
00024 *> \endverbatim
00025 *
00026 *  Authors:
00027 *  ========
00028 *
00029 *> \author Univ. of Tennessee 
00030 *> \author Univ. of California Berkeley 
00031 *> \author Univ. of Colorado Denver 
00032 *> \author NAG Ltd. 
00033 *
00034 *> \date November 2011
00035 *
00036 *> \ingroup single_blas_level1
00037 *
00038 *> \par Further Details:
00039 *  =====================
00040 *>
00041 *> \verbatim
00042 *>
00043 *>     jack dongarra, linpack, 3/11/78.
00044 *> \endverbatim
00045 *>
00046 *  =====================================================================
00047       SUBROUTINE SROTG(SA,SB,C,S)
00048 *
00049 *  -- Reference BLAS level1 routine (version 3.4.0) --
00050 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
00051 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00052 *     November 2011
00053 *
00054 *     .. Scalar Arguments ..
00055       REAL C,S,SA,SB
00056 *     ..
00057 *
00058 *  =====================================================================
00059 *
00060 *     .. Local Scalars ..
00061       REAL R,ROE,SCALE,Z
00062 *     ..
00063 *     .. Intrinsic Functions ..
00064       INTRINSIC ABS,SIGN,SQRT
00065 *     ..
00066       ROE = SB
00067       IF (ABS(SA).GT.ABS(SB)) ROE = SA
00068       SCALE = ABS(SA) + ABS(SB)
00069       IF (SCALE.EQ.0.0) THEN
00070          C = 1.0
00071          S = 0.0
00072          R = 0.0
00073          Z = 0.0
00074       ELSE
00075          R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2)
00076          R = SIGN(1.0,ROE)*R
00077          C = SA/R
00078          S = SB/R
00079          Z = 1.0
00080          IF (ABS(SA).GT.ABS(SB)) Z = S
00081          IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C
00082       END IF
00083       SA = R
00084       SB = Z
00085       RETURN
00086       END
 All Files Functions