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.

drot.f 2.3 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101
  1. *> \brief \b DROT
  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 DROT(N,DX,INCX,DY,INCY,C,S)
  12. *
  13. * .. Scalar Arguments ..
  14. * DOUBLE PRECISION C,S
  15. * INTEGER INCX,INCY,N
  16. * ..
  17. * .. Array Arguments ..
  18. * DOUBLE PRECISION DX(*),DY(*)
  19. * ..
  20. *
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> DROT applies a plane rotation.
  28. *> \endverbatim
  29. *
  30. * Authors:
  31. * ========
  32. *
  33. *> \author Univ. of Tennessee
  34. *> \author Univ. of California Berkeley
  35. *> \author Univ. of Colorado Denver
  36. *> \author NAG Ltd.
  37. *
  38. *> \date November 2011
  39. *
  40. *> \ingroup double_blas_level1
  41. *
  42. *> \par Further Details:
  43. * =====================
  44. *>
  45. *> \verbatim
  46. *>
  47. *> jack dongarra, linpack, 3/11/78.
  48. *> modified 12/3/93, array(1) declarations changed to array(*)
  49. *> \endverbatim
  50. *>
  51. * =====================================================================
  52. SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
  53. *
  54. * -- Reference BLAS level1 routine (version 3.4.0) --
  55. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  56. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  57. * November 2011
  58. *
  59. * .. Scalar Arguments ..
  60. DOUBLE PRECISION C,S
  61. INTEGER INCX,INCY,N
  62. * ..
  63. * .. Array Arguments ..
  64. DOUBLE PRECISION DX(*),DY(*)
  65. * ..
  66. *
  67. * =====================================================================
  68. *
  69. * .. Local Scalars ..
  70. DOUBLE PRECISION DTEMP
  71. INTEGER I,IX,IY
  72. * ..
  73. IF (N.LE.0) RETURN
  74. IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
  75. *
  76. * code for both increments equal to 1
  77. *
  78. DO I = 1,N
  79. DTEMP = C*DX(I) + S*DY(I)
  80. DY(I) = C*DY(I) - S*DX(I)
  81. DX(I) = DTEMP
  82. END DO
  83. ELSE
  84. *
  85. * code for unequal increments or equal increments not equal
  86. * to 1
  87. *
  88. IX = 1
  89. IY = 1
  90. IF (INCX.LT.0) IX = (-N+1)*INCX + 1
  91. IF (INCY.LT.0) IY = (-N+1)*INCY + 1
  92. DO I = 1,N
  93. DTEMP = C*DX(IX) + S*DY(IY)
  94. DY(IY) = C*DY(IY) - S*DX(IX)
  95. DX(IX) = DTEMP
  96. IX = IX + INCX
  97. IY = IY + INCY
  98. END DO
  99. END IF
  100. RETURN
  101. END