LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
drotg.f
Go to the documentation of this file.
1 *> \brief \b DROTG
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 DROTG(DA,DB,C,S)
12 *
13 * .. Scalar Arguments ..
14 * DOUBLE PRECISION C,DA,DB,S
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> DROTG 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 double_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 drotg(DA,DB,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  DOUBLE PRECISION C,DA,DB,S
56 * ..
57 *
58 * =====================================================================
59 *
60 * .. Local Scalars ..
61  DOUBLE PRECISION R,ROE,SCALE,Z
62 * ..
63 * .. Intrinsic Functions ..
64  INTRINSIC dabs,dsign,dsqrt
65 * ..
66  roe = db
67  IF (dabs(da).GT.dabs(db)) roe = da
68  scale = dabs(da) + dabs(db)
69  IF (scale.EQ.0.0d0) THEN
70  c = 1.0d0
71  s = 0.0d0
72  r = 0.0d0
73  z = 0.0d0
74  ELSE
75  r = scale*dsqrt((da/scale)**2+ (db/scale)**2)
76  r = dsign(1.0d0,roe)*r
77  c = da/r
78  s = db/r
79  z = 1.0d0
80  IF (dabs(da).GT.dabs(db)) z = s
81  IF (dabs(db).GE.dabs(da) .AND. c.NE.0.0d0) z = 1.0d0/c
82  END IF
83  da = r
84  db = z
85  RETURN
86  END
subroutine drotg(DA, DB, C, S)
DROTG
Definition: drotg.f:48