d7/d26/srotg_8f_source.html

00001       SUBROUTINE SROTG(SA,SB,C,S)
00002 *     .. Scalar Arguments ..
00003       REAL C,S,SA,SB
00004 *     ..
00005 *
00006 *  Purpose
00007 *  =======
00008 *
00009 *     SROTG construct givens plane rotation.
00010 *
00011 *  Further Details
00012 *  ===============
00013 *
00014 *     jack dongarra, linpack, 3/11/78.
00015 *
00016 *  =====================================================================
00017 *
00018 *     .. Local Scalars ..
00019       REAL R,ROE,SCALE,Z
00020 *     ..
00021 *     .. Intrinsic Functions ..
00022       INTRINSIC ABS,SIGN,SQRT
00023 *     ..
00024       ROE = SB
00025       IF (ABS(SA).GT.ABS(SB)) ROE = SA
00026       SCALE = ABS(SA) + ABS(SB)
00027       IF (SCALE.EQ.0.0) THEN
00028          C = 1.0
00029          S = 0.0
00030          R = 0.0
00031          Z = 0.0
00032       ELSE
00033          R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2)
00034          R = SIGN(1.0,ROE)*R
00035          C = SA/R
00036          S = SB/R
00037          Z = 1.0
00038          IF (ABS(SA).GT.ABS(SB)) Z = S
00039          IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C
00040       END IF
00041       SA = R
00042       SB = Z
00043       RETURN
00044       END