diff options
| author | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
|---|---|---|
| committer | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
| commit | baba851215b44ac3b60b9248eb02bcce7eb76247 (patch) | |
| tree | 8c0f5c006875532a30d4409f5e94b0f310ff00a7 /BLAS/SRC/srotg.f | |
| download | lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.gz lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.bz2 lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.zip | |
Move LAPACK trunk into position.
Diffstat (limited to 'BLAS/SRC/srotg.f')
| -rw-r--r-- | BLAS/SRC/srotg.f | 38 |
1 files changed, 38 insertions, 0 deletions
diff --git a/BLAS/SRC/srotg.f b/BLAS/SRC/srotg.f new file mode 100644 index 00000000..2625bd58 --- /dev/null +++ b/BLAS/SRC/srotg.f @@ -0,0 +1,38 @@ + SUBROUTINE SROTG(SA,SB,C,S) +* .. Scalar Arguments .. + REAL C,S,SA,SB +* .. +* +* Purpose +* ======= +* +* construct givens plane rotation. +* jack dongarra, linpack, 3/11/78. +* +* +* .. Local Scalars .. + REAL R,ROE,SCALE,Z +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS,SIGN,SQRT +* .. + ROE = SB + IF (ABS(SA).GT.ABS(SB)) ROE = SA + SCALE = ABS(SA) + ABS(SB) + IF (SCALE.NE.0.0) GO TO 10 + C = 1.0 + S = 0.0 + R = 0.0 + Z = 0.0 + GO TO 20 + 10 R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2) + R = SIGN(1.0,ROE)*R + C = SA/R + S = SB/R + Z = 1.0 + IF (ABS(SA).GT.ABS(SB)) Z = S + IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C + 20 SA = R + SB = Z + RETURN + END |