You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

crotg.f 2.0 kB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  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. * Arguments:
  28. * ==========
  29. *
  30. *> \param[in] CA
  31. *> \verbatim
  32. *> CA is COMPLEX
  33. *> \endverbatim
  34. *>
  35. *> \param[in] CB
  36. *> \verbatim
  37. *> CB is COMPLEX
  38. *> \endverbatim
  39. *>
  40. *> \param[out] C
  41. *> \verbatim
  42. *> C is REAL
  43. *> \endverbatim
  44. *>
  45. *> \param[out] S
  46. *> \verbatim
  47. *> S is COMPLEX
  48. *> \endverbatim
  49. *
  50. * Authors:
  51. * ========
  52. *
  53. *> \author Univ. of Tennessee
  54. *> \author Univ. of California Berkeley
  55. *> \author Univ. of Colorado Denver
  56. *> \author NAG Ltd.
  57. *
  58. *> \date November 2017
  59. *
  60. *> \ingroup complex_blas_level1
  61. *
  62. * =====================================================================
  63. SUBROUTINE CROTG(CA,CB,C,S)
  64. *
  65. * -- Reference BLAS level1 routine (version 3.8.0) --
  66. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  67. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  68. * November 2017
  69. *
  70. * .. Scalar Arguments ..
  71. COMPLEX CA,CB,S
  72. REAL C
  73. * ..
  74. *
  75. * =====================================================================
  76. *
  77. * .. Local Scalars ..
  78. COMPLEX ALPHA
  79. REAL NORM,SCALE
  80. * ..
  81. * .. Intrinsic Functions ..
  82. INTRINSIC CABS,CONJG,SQRT
  83. * ..
  84. IF (CABS(CA).EQ.0.) THEN
  85. C = 0.
  86. S = (1.,0.)
  87. CA = CB
  88. ELSE
  89. SCALE = CABS(CA) + CABS(CB)
  90. NORM = SCALE*SQRT((CABS(CA/SCALE))**2+ (CABS(CB/SCALE))**2)
  91. ALPHA = CA/CABS(CA)
  92. C = CABS(CA)/NORM
  93. S = ALPHA*CONJG(CB)/NORM
  94. CA = ALPHA*NORM
  95. END IF
  96. RETURN
  97. END