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.

zrotg.f 2.1 kB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798
  1. *> \brief \b ZROTG
  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 ZROTG(CA,CB,C,S)
  12. *
  13. * .. Scalar Arguments ..
  14. * COMPLEX*16 CA,CB,S
  15. * DOUBLE PRECISION C
  16. * ..
  17. *
  18. *
  19. *> \par Purpose:
  20. * =============
  21. *>
  22. *> \verbatim
  23. *>
  24. *> ZROTG determines a double complex Givens rotation.
  25. *> \endverbatim
  26. *
  27. * Arguments:
  28. * ==========
  29. *
  30. *> \param[in] CA
  31. *> \verbatim
  32. *> CA is COMPLEX*16
  33. *> \endverbatim
  34. *>
  35. *> \param[in] CB
  36. *> \verbatim
  37. *> CB is COMPLEX*16
  38. *> \endverbatim
  39. *>
  40. *> \param[out] C
  41. *> \verbatim
  42. *> C is DOUBLE PRECISION
  43. *> \endverbatim
  44. *>
  45. *> \param[out] S
  46. *> \verbatim
  47. *> S is COMPLEX*16
  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 complex16_blas_level1
  61. *
  62. * =====================================================================
  63. SUBROUTINE ZROTG(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*16 CA,CB,S
  72. DOUBLE PRECISION C
  73. * ..
  74. *
  75. * =====================================================================
  76. *
  77. * .. Local Scalars ..
  78. COMPLEX*16 ALPHA
  79. DOUBLE PRECISION NORM,SCALE
  80. * ..
  81. * .. Intrinsic Functions ..
  82. INTRINSIC CDABS,DCMPLX,DCONJG,DSQRT
  83. * ..
  84. IF (CDABS(CA).EQ.0.0d0) THEN
  85. C = 0.0d0
  86. S = (1.0d0,0.0d0)
  87. CA = CB
  88. ELSE
  89. SCALE = CDABS(CA) + CDABS(CB)
  90. NORM = SCALE*DSQRT((CDABS(CA/DCMPLX(SCALE,0.0d0)))**2+
  91. $ (CDABS(CB/DCMPLX(SCALE,0.0d0)))**2)
  92. ALPHA = CA/CDABS(CA)
  93. C = CDABS(CA)/NORM
  94. S = ALPHA*DCONJG(CB)/NORM
  95. CA = ALPHA*NORM
  96. END IF
  97. RETURN
  98. END