LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
srotg.f
Go to the documentation of this file.
1 *> \brief \b SROTG
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE SROTG(SA,SB,C,S)
12 *
13 * .. Scalar Arguments ..
14 * REAL C,S,SA,SB
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> SROTG construct givens plane rotation.
24 *> \endverbatim
25 *
26 * Authors:
27 * ========
28 *
29 *> \author Univ. of Tennessee
30 *> \author Univ. of California Berkeley
31 *> \author Univ. of Colorado Denver
32 *> \author NAG Ltd.
33 *
34 *> \date November 2011
35 *
36 *> \ingroup single_blas_level1
37 *
38 *> \par Further Details:
39 * =====================
40 *>
41 *> \verbatim
42 *>
43 *> jack dongarra, linpack, 3/11/78.
44 *> \endverbatim
45 *>
46 * =====================================================================
47  SUBROUTINE srotg(SA,SB,C,S)
48 *
49 * -- Reference BLAS level1 routine (version 3.4.0) --
50 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
51 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
52 * November 2011
53 *
54 * .. Scalar Arguments ..
55  REAL C,S,SA,SB
56 * ..
57 *
58 * =====================================================================
59 *
60 * .. Local Scalars ..
61  REAL R,ROE,SCALE,Z
62 * ..
63 * .. Intrinsic Functions ..
64  INTRINSIC abs,sign,sqrt
65 * ..
66  roe = sb
67  IF (abs(sa).GT.abs(sb)) roe = sa
68  scale = abs(sa) + abs(sb)
69  IF (scale.EQ.0.0) THEN
70  c = 1.0
71  s = 0.0
72  r = 0.0
73  z = 0.0
74  ELSE
75  r = scale*sqrt((sa/scale)**2+ (sb/scale)**2)
76  r = sign(1.0,roe)*r
77  c = sa/r
78  s = sb/r
79  z = 1.0
80  IF (abs(sa).GT.abs(sb)) z = s
81  IF (abs(sb).GE.abs(sa) .AND. c.NE.0.0) z = 1.0/c
82  END IF
83  sa = r
84  sb = z
85  RETURN
86  END
subroutine srotg(SA, SB, C, S)
SROTG
Definition: srotg.f:48