![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
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