LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
crotg.f
Go to the documentation of this file.
00001 *> \brief \b CROTG
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE CROTG(CA,CB,C,S)
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       COMPLEX CA,CB,S
00015 *       REAL C
00016 *       ..
00017 *  
00018 *
00019 *> \par Purpose:
00020 *  =============
00021 *>
00022 *> \verbatim
00023 *>
00024 *> CROTG determines a complex Givens rotation.
00025 *> \endverbatim
00026 *
00027 *  Authors:
00028 *  ========
00029 *
00030 *> \author Univ. of Tennessee 
00031 *> \author Univ. of California Berkeley 
00032 *> \author Univ. of Colorado Denver 
00033 *> \author NAG Ltd. 
00034 *
00035 *> \date November 2011
00036 *
00037 *> \ingroup complex_blas_level1
00038 *
00039 *  =====================================================================
00040       SUBROUTINE CROTG(CA,CB,C,S)
00041 *
00042 *  -- Reference BLAS level1 routine (version 3.4.0) --
00043 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
00044 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00045 *     November 2011
00046 *
00047 *     .. Scalar Arguments ..
00048       COMPLEX CA,CB,S
00049       REAL C
00050 *     ..
00051 *
00052 *  =====================================================================
00053 *
00054 *     .. Local Scalars ..
00055       COMPLEX ALPHA
00056       REAL NORM,SCALE
00057 *     ..
00058 *     .. Intrinsic Functions ..
00059       INTRINSIC CABS,CONJG,SQRT
00060 *     ..
00061       IF (CABS(CA).EQ.0.) THEN
00062          C = 0.
00063          S = (1.,0.)
00064          CA = CB
00065       ELSE
00066          SCALE = CABS(CA) + CABS(CB)
00067          NORM = SCALE*SQRT((CABS(CA/SCALE))**2+ (CABS(CB/SCALE))**2)
00068          ALPHA = CA/CABS(CA)
00069          C = CABS(CA)/NORM
00070          S = ALPHA*CONJG(CB)/NORM
00071          CA = ALPHA*NORM
00072       END IF
00073       RETURN
00074       END
 All Files Functions