csrot.f 2.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485
  1. *DECK CSROT
  2. SUBROUTINE CSROT (N, CX, INCX, CY, INCY, C, S)
  3. C***BEGIN PROLOGUE CSROT
  4. C***PURPOSE Apply a plane Givens rotation.
  5. C***LIBRARY SLATEC (BLAS)
  6. C***CATEGORY D1B10
  7. C***TYPE COMPLEX (SROT-S, DROT-D, CSROT-C)
  8. C***KEYWORDS BLAS, GIVENS ROTATION, GIVENS TRANSFORMATION,
  9. C LINEAR ALGEBRA, PLANE ROTATION, VECTOR
  10. C***AUTHOR Dongarra, J., (ANL)
  11. C***DESCRIPTION
  12. C
  13. C CSROT applies the complex Givens rotation
  14. C
  15. C (X) ( C S)(X)
  16. C (Y) = (-S C)(Y)
  17. C
  18. C N times where for I = 0,...,N-1
  19. C
  20. C X = CX(LX+I*INCX)
  21. C Y = CY(LY+I*INCY),
  22. C
  23. C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
  24. C defined in a similar way using INCY.
  25. C
  26. C Argument Description
  27. C
  28. C N (integer) number of elements in each vector
  29. C
  30. C CX (complex array) beginning of one vector
  31. C
  32. C INCX (integer) memory spacing of successive elements
  33. C of vector CX
  34. C
  35. C CY (complex array) beginning of the other vector
  36. C
  37. C INCY (integer) memory spacing of successive elements
  38. C of vector CY
  39. C
  40. C C (real) cosine term of the rotation
  41. C
  42. C S (real) sine term of the rotation.
  43. C
  44. C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
  45. C Stewart, LINPACK Users' Guide, SIAM, 1979.
  46. C***ROUTINES CALLED (NONE)
  47. C***REVISION HISTORY (YYMMDD)
  48. C 810223 DATE WRITTEN
  49. C 890831 Modified array declarations. (WRB)
  50. C 890831 REVISION DATE from Version 3.2
  51. C 891214 Prologue converted to Version 4.0 format. (BAB)
  52. C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
  53. C 920501 Reformatted the REFERENCES section. (WRB)
  54. C***END PROLOGUE CSROT
  55. COMPLEX CX(*), CY(*), CTEMP
  56. REAL C, S
  57. INTEGER I, INCX, INCY, IX, IY, N
  58. C***FIRST EXECUTABLE STATEMENT CSROT
  59. IF (N .LE. 0) RETURN
  60. IF (INCX.EQ.1 .AND. INCY.EQ.1)GO TO 20
  61. C
  62. C Code for unequal increments or equal increments not equal to 1.
  63. C
  64. IX = 1
  65. IY = 1
  66. IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
  67. IF (INCY .LT. 0) IY = (-N+1)*INCY + 1
  68. DO 10 I = 1,N
  69. CTEMP = C*CX(IX) + S*CY(IY)
  70. CY(IY) = C*CY(IY) - S*CX(IX)
  71. CX(IX) = CTEMP
  72. IX = IX + INCX
  73. IY = IY + INCY
  74. 10 CONTINUE
  75. RETURN
  76. C
  77. C Code for both increments equal to 1.
  78. C
  79. 20 DO 30 I = 1,N
  80. CTEMP = C*CX(I) + S*CY(I)
  81. CY(I) = C*CY(I) - S*CX(I)
  82. CX(I) = CTEMP
  83. 30 CONTINUE
  84. RETURN
  85. END