LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
crotg.f
Go to the documentation of this file.
1 *> \brief \b CROTG
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 CROTG(CA,CB,C,S)
12 *
13 * .. Scalar Arguments ..
14 * COMPLEX CA,CB,S
15 * REAL C
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> CROTG determines a complex Givens rotation.
25 *> \endverbatim
26 *
27 * Authors:
28 * ========
29 *
30 *> \author Univ. of Tennessee
31 *> \author Univ. of California Berkeley
32 *> \author Univ. of Colorado Denver
33 *> \author NAG Ltd.
34 *
35 *> \date November 2011
36 *
37 *> \ingroup complex_blas_level1
38 *
39 * =====================================================================
40  SUBROUTINE crotg(CA,CB,C,S)
41 *
42 * -- Reference BLAS level1 routine (version 3.4.0) --
43 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
44 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
45 * November 2011
46 *
47 * .. Scalar Arguments ..
48  COMPLEX ca,cb,s
49  REAL c
50 * ..
51 *
52 * =====================================================================
53 *
54 * .. Local Scalars ..
55  COMPLEX alpha
56  REAL norm,scale
57 * ..
58 * .. Intrinsic Functions ..
59  INTRINSIC cabs,conjg,sqrt
60 * ..
61  IF (cabs(ca).EQ.0.) THEN
62  c = 0.
63  s = (1.,0.)
64  ca = cb
65  ELSE
66  scale = cabs(ca) + cabs(cb)
67  norm = scale*sqrt((cabs(ca/scale))**2+ (cabs(cb/scale))**2)
68  alpha = ca/cabs(ca)
69  c = cabs(ca)/norm
70  s = alpha*conjg(cb)/norm
71  ca = alpha*norm
72  END IF
73  return
74  END