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 1.7 kB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374
  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