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.

drotg.f 2.3 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109
  1. *> \brief \b DROTG
  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 DROTG(DA,DB,C,S)
  12. *
  13. * .. Scalar Arguments ..
  14. * DOUBLE PRECISION C,DA,DB,S
  15. * ..
  16. *
  17. *
  18. *> \par Purpose:
  19. * =============
  20. *>
  21. *> \verbatim
  22. *>
  23. *> DROTG construct givens plane rotation.
  24. *> \endverbatim
  25. *
  26. * Arguments:
  27. * ==========
  28. *
  29. *> \param[in] DA
  30. *> \verbatim
  31. *> DA is DOUBLE PRECISION
  32. *> \endverbatim
  33. *>
  34. *> \param[in] DB
  35. *> \verbatim
  36. *> DB is DOUBLE PRECISION
  37. *> \endverbatim
  38. *>
  39. *> \param[out] C
  40. *> \verbatim
  41. *> C is DOUBLE PRECISION
  42. *> \endverbatim
  43. *>
  44. *> \param[out] S
  45. *> \verbatim
  46. *> S is DOUBLE PRECISION
  47. *> \endverbatim
  48. *
  49. * Authors:
  50. * ========
  51. *
  52. *> \author Univ. of Tennessee
  53. *> \author Univ. of California Berkeley
  54. *> \author Univ. of Colorado Denver
  55. *> \author NAG Ltd.
  56. *
  57. *> \date November 2017
  58. *
  59. *> \ingroup double_blas_level1
  60. *
  61. *> \par Further Details:
  62. * =====================
  63. *>
  64. *> \verbatim
  65. *>
  66. *> jack dongarra, linpack, 3/11/78.
  67. *> \endverbatim
  68. *>
  69. * =====================================================================
  70. SUBROUTINE DROTG(DA,DB,C,S)
  71. *
  72. * -- Reference BLAS level1 routine (version 3.8.0) --
  73. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  74. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  75. * November 2017
  76. *
  77. * .. Scalar Arguments ..
  78. DOUBLE PRECISION C,DA,DB,S
  79. * ..
  80. *
  81. * =====================================================================
  82. *
  83. * .. Local Scalars ..
  84. DOUBLE PRECISION R,ROE,SCALE,Z
  85. * ..
  86. * .. Intrinsic Functions ..
  87. INTRINSIC DABS,DSIGN,DSQRT
  88. * ..
  89. ROE = DB
  90. IF (DABS(DA).GT.DABS(DB)) ROE = DA
  91. SCALE = DABS(DA) + DABS(DB)
  92. IF (SCALE.EQ.0.0d0) THEN
  93. C = 1.0d0
  94. S = 0.0d0
  95. R = 0.0d0
  96. Z = 0.0d0
  97. ELSE
  98. R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2)
  99. R = DSIGN(1.0d0,ROE)*R
  100. C = DA/R
  101. S = DB/R
  102. Z = 1.0d0
  103. IF (DABS(DA).GT.DABS(DB)) Z = S
  104. IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C
  105. END IF
  106. DA = R
  107. DB = Z
  108. RETURN
  109. END