1 SUBROUTINE SROTG(SA,SB,C,S)
2 * .. Scalar Arguments ..
3 REAL C,S,SA,SB
4 * ..
5 *
6 * Purpose
7 * =======
8 *
9 * SROTG construct givens plane rotation.
10 *
11 * Further Details
12 * ===============
13 *
14 * jack dongarra, linpack, 3/11/78.
15 *
16 * =====================================================================
17 *
18 * .. Local Scalars ..
19 REAL R,ROE,SCALE,Z
20 * ..
21 * .. Intrinsic Functions ..
22 INTRINSIC ABS,SIGN,SQRT
23 * ..
24 ROE = SB
25 IF (ABS(SA).GT.ABS(SB)) ROE = SA
26 SCALE = ABS(SA) + ABS(SB)
27 IF (SCALE.EQ.0.0) THEN
28 C = 1.0
29 S = 0.0
30 R = 0.0
31 Z = 0.0
32 ELSE
33 R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2)
34 R = SIGN(1.0,ROE)*R
35 C = SA/R
36 S = SB/R
37 Z = 1.0
38 IF (ABS(SA).GT.ABS(SB)) Z = S
39 IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C
40 END IF
41 SA = R
42 SB = Z
43 RETURN
44 END
2 * .. Scalar Arguments ..
3 REAL C,S,SA,SB
4 * ..
5 *
6 * Purpose
7 * =======
8 *
9 * SROTG construct givens plane rotation.
10 *
11 * Further Details
12 * ===============
13 *
14 * jack dongarra, linpack, 3/11/78.
15 *
16 * =====================================================================
17 *
18 * .. Local Scalars ..
19 REAL R,ROE,SCALE,Z
20 * ..
21 * .. Intrinsic Functions ..
22 INTRINSIC ABS,SIGN,SQRT
23 * ..
24 ROE = SB
25 IF (ABS(SA).GT.ABS(SB)) ROE = SA
26 SCALE = ABS(SA) + ABS(SB)
27 IF (SCALE.EQ.0.0) THEN
28 C = 1.0
29 S = 0.0
30 R = 0.0
31 Z = 0.0
32 ELSE
33 R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2)
34 R = SIGN(1.0,ROE)*R
35 C = SA/R
36 S = SB/R
37 Z = 1.0
38 IF (ABS(SA).GT.ABS(SB)) Z = S
39 IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C
40 END IF
41 SA = R
42 SB = Z
43 RETURN
44 END