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.NE.0.0) GO TO 10
00028       C = 1.0
00029       S = 0.0
00030       R = 0.0
00031       Z = 0.0
00032       GO TO 20
00033    10 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    20 SA = R
00041       SB = Z
00042       RETURN
00043       END