![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
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