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.

zdrot.f 3.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. *> \brief \b ZDROT
  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 ZDROT( N, CX, INCX, CY, INCY, C, S )
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER INCX, INCY, N
  15. * DOUBLE PRECISION C, S
  16. * ..
  17. * .. Array Arguments ..
  18. * COMPLEX*16 CX( * ), CY( * )
  19. * ..
  20. *
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> Applies a plane rotation, where the cos and sin (c and s) are real
  28. *> and the vectors cx and cy are complex.
  29. *> jack dongarra, linpack, 3/11/78.
  30. *> \endverbatim
  31. *
  32. * Arguments:
  33. * ==========
  34. *
  35. *> \param[in] N
  36. *> \verbatim
  37. *> N is INTEGER
  38. *> On entry, N specifies the order of the vectors cx and cy.
  39. *> N must be at least zero.
  40. *> \endverbatim
  41. *>
  42. *> \param[in,out] CX
  43. *> \verbatim
  44. *> CX is COMPLEX*16 array, dimension at least
  45. *> ( 1 + ( N - 1 )*abs( INCX ) ).
  46. *> Before entry, the incremented array CX must contain the n
  47. *> element vector cx. On exit, CX is overwritten by the updated
  48. *> vector cx.
  49. *> \endverbatim
  50. *>
  51. *> \param[in] INCX
  52. *> \verbatim
  53. *> INCX is INTEGER
  54. *> On entry, INCX specifies the increment for the elements of
  55. *> CX. INCX must not be zero.
  56. *> \endverbatim
  57. *>
  58. *> \param[in,out] CY
  59. *> \verbatim
  60. *> CY is COMPLEX*16 array, dimension at least
  61. *> ( 1 + ( N - 1 )*abs( INCY ) ).
  62. *> Before entry, the incremented array CY must contain the n
  63. *> element vector cy. On exit, CY is overwritten by the updated
  64. *> vector cy.
  65. *> \endverbatim
  66. *>
  67. *> \param[in] INCY
  68. *> \verbatim
  69. *> INCY is INTEGER
  70. *> On entry, INCY specifies the increment for the elements of
  71. *> CY. INCY must not be zero.
  72. *> \endverbatim
  73. *>
  74. *> \param[in] C
  75. *> \verbatim
  76. *> C is DOUBLE PRECISION
  77. *> On entry, C specifies the cosine, cos.
  78. *> \endverbatim
  79. *>
  80. *> \param[in] S
  81. *> \verbatim
  82. *> S is DOUBLE PRECISION
  83. *> On entry, S specifies the sine, sin.
  84. *> \endverbatim
  85. *
  86. * Authors:
  87. * ========
  88. *
  89. *> \author Univ. of Tennessee
  90. *> \author Univ. of California Berkeley
  91. *> \author Univ. of Colorado Denver
  92. *> \author NAG Ltd.
  93. *
  94. *> \date November 2011
  95. *
  96. *> \ingroup complex16_blas_level1
  97. *
  98. * =====================================================================
  99. SUBROUTINE ZDROT( N, CX, INCX, CY, INCY, C, S )
  100. *
  101. * -- Reference BLAS level1 routine (version 3.4.0) --
  102. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  103. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  104. * November 2011
  105. *
  106. * .. Scalar Arguments ..
  107. INTEGER INCX, INCY, N
  108. DOUBLE PRECISION C, S
  109. * ..
  110. * .. Array Arguments ..
  111. COMPLEX*16 CX( * ), CY( * )
  112. * ..
  113. *
  114. * =====================================================================
  115. *
  116. * .. Local Scalars ..
  117. INTEGER I, IX, IY
  118. COMPLEX*16 CTEMP
  119. * ..
  120. * .. Executable Statements ..
  121. *
  122. IF( N.LE.0 )
  123. $ RETURN
  124. IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN
  125. *
  126. * code for both increments equal to 1
  127. *
  128. DO I = 1, N
  129. CTEMP = C*CX( I ) + S*CY( I )
  130. CY( I ) = C*CY( I ) - S*CX( I )
  131. CX( I ) = CTEMP
  132. END DO
  133. ELSE
  134. *
  135. * code for unequal increments or equal increments not equal
  136. * to 1
  137. *
  138. IX = 1
  139. IY = 1
  140. IF( INCX.LT.0 )
  141. $ IX = ( -N+1 )*INCX + 1
  142. IF( INCY.LT.0 )
  143. $ IY = ( -N+1 )*INCY + 1
  144. DO I = 1, N
  145. CTEMP = C*CX( IX ) + S*CY( IY )
  146. CY( IY ) = C*CY( IY ) - S*CX( IX )
  147. CX( IX ) = CTEMP
  148. IX = IX + INCX
  149. IY = IY + INCY
  150. END DO
  151. END IF
  152. RETURN
  153. END