cost.f 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112
  1. *DECK COST
  2. SUBROUTINE COST (N, X, WSAVE)
  3. C***BEGIN PROLOGUE COST
  4. C***PURPOSE Compute the cosine transform of a real, even sequence.
  5. C***LIBRARY SLATEC (FFTPACK)
  6. C***CATEGORY J1A3
  7. C***TYPE SINGLE PRECISION (COST-S)
  8. C***KEYWORDS COSINE FOURIER TRANSFORM, FFTPACK
  9. C***AUTHOR Swarztrauber, P. N., (NCAR)
  10. C***DESCRIPTION
  11. C
  12. C Subroutine COST computes the discrete Fourier cosine transform
  13. C of an even sequence X(I). The transform is defined below at output
  14. C parameter X.
  15. C
  16. C COST is the unnormalized inverse of itself since a call of COST
  17. C followed by another call of COST will multiply the input sequence
  18. C X by 2*(N-1). The transform is defined below at output parameter X.
  19. C
  20. C The array WSAVE which is used by subroutine COST must be
  21. C initialized by calling subroutine COSTI(N,WSAVE).
  22. C
  23. C Input Parameters
  24. C
  25. C N the length of the sequence X. N must be greater than 1.
  26. C The method is most efficient when N-1 is a product of
  27. C small primes.
  28. C
  29. C X an array which contains the sequence to be transformed
  30. C
  31. C WSAVE a work array which must be dimensioned at least 3*N+15
  32. C in the program that calls COST. The WSAVE array must be
  33. C initialized by calling subroutine COSTI(N,WSAVE), and a
  34. C different WSAVE array must be used for each different
  35. C value of N. This initialization does not have to be
  36. C repeated so long as N remains unchanged. Thus subsequent
  37. C transforms can be obtained faster than the first.
  38. C
  39. C Output Parameters
  40. C
  41. C X For I=1,...,N
  42. C
  43. C X(I) = X(1)+(-1)**(I-1)*X(N)
  44. C
  45. C + the sum from K=2 to K=N-1
  46. C
  47. C 2*X(K)*COS((K-1)*(I-1)*PI/(N-1))
  48. C
  49. C A call of COST followed by another call of
  50. C COST will multiply the sequence X by 2*(N-1).
  51. C Hence COST is the unnormalized inverse
  52. C of itself.
  53. C
  54. C WSAVE contains initialization calculations which must not be
  55. C destroyed between calls of COST.
  56. C
  57. C***REFERENCES P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
  58. C Computations (G. Rodrigue, ed.), Academic Press,
  59. C 1982, pp. 51-83.
  60. C***ROUTINES CALLED RFFTF
  61. C***REVISION HISTORY (YYMMDD)
  62. C 790601 DATE WRITTEN
  63. C 830401 Modified to use SLATEC library source file format.
  64. C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
  65. C changing dummy array size declarations (1) to (*)
  66. C 861211 REVISION DATE from Version 3.2
  67. C 881128 Modified by Dick Valent to meet prologue standards.
  68. C 891214 Prologue converted to Version 4.0 format. (BAB)
  69. C 920501 Reformatted the REFERENCES section. (WRB)
  70. C***END PROLOGUE COST
  71. DIMENSION X(*), WSAVE(*)
  72. C***FIRST EXECUTABLE STATEMENT COST
  73. NM1 = N-1
  74. NP1 = N+1
  75. NS2 = N/2
  76. IF (N-2) 106,101,102
  77. 101 X1H = X(1)+X(2)
  78. X(2) = X(1)-X(2)
  79. X(1) = X1H
  80. RETURN
  81. 102 IF (N .GT. 3) GO TO 103
  82. X1P3 = X(1)+X(3)
  83. TX2 = X(2)+X(2)
  84. X(2) = X(1)-X(3)
  85. X(1) = X1P3+TX2
  86. X(3) = X1P3-TX2
  87. RETURN
  88. 103 C1 = X(1)-X(N)
  89. X(1) = X(1)+X(N)
  90. DO 104 K=2,NS2
  91. KC = NP1-K
  92. T1 = X(K)+X(KC)
  93. T2 = X(K)-X(KC)
  94. C1 = C1+WSAVE(KC)*T2
  95. T2 = WSAVE(K)*T2
  96. X(K) = T1-T2
  97. X(KC) = T1+T2
  98. 104 CONTINUE
  99. MODN = MOD(N,2)
  100. IF (MODN .NE. 0) X(NS2+1) = X(NS2+1)+X(NS2+1)
  101. CALL RFFTF (NM1,X,WSAVE(N+1))
  102. XIM2 = X(2)
  103. X(2) = C1
  104. DO 105 I=4,N,2
  105. XI = X(I)
  106. X(I) = X(I-2)-X(I-1)
  107. X(I-1) = XIM2
  108. XIM2 = XI
  109. 105 CONTINUE
  110. IF (MODN .NE. 0) X(N) = XIM2
  111. 106 RETURN
  112. END