cfftf1.f 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133
  1. *DECK CFFTF1
  2. SUBROUTINE CFFTF1 (N, C, CH, WA, IFAC)
  3. C***BEGIN PROLOGUE CFFTF1
  4. C***PURPOSE Compute the forward transform of a complex, periodic
  5. C sequence.
  6. C***LIBRARY SLATEC (FFTPACK)
  7. C***CATEGORY J1A2
  8. C***TYPE COMPLEX (RFFTF1-S, CFFTF1-C)
  9. C***KEYWORDS FFTPACK, FOURIER TRANSFORM
  10. C***AUTHOR Swarztrauber, P. N., (NCAR)
  11. C***DESCRIPTION
  12. C
  13. C Subroutine CFFTF1 computes the forward complex discrete Fourier
  14. C transform (the Fourier analysis). Equivalently, CFFTF1 computes
  15. C the Fourier coefficients of a complex periodic sequence.
  16. C The transform is defined below at output parameter C.
  17. C
  18. C The transform is not normalized. To obtain a normalized transform
  19. C the output must be divided by N. Otherwise a call of CFFTF1
  20. C followed by a call of CFFTB1 will multiply the sequence by N.
  21. C
  22. C The arrays WA and IFAC which are used by subroutine CFFTB1 must be
  23. C initialized by calling subroutine CFFTI1 (N, WA, IFAC).
  24. C
  25. C Input Parameters
  26. C
  27. C N the length of the complex sequence C. The method is
  28. C more efficient when N is the product of small primes.
  29. C
  30. C C a complex array of length N which contains the sequence
  31. C
  32. C CH a real work array of length at least 2*N
  33. C
  34. C WA a real work array which must be dimensioned at least 2*N.
  35. C
  36. C IFAC an integer work array which must be dimensioned at least 15.
  37. C
  38. C The WA and IFAC arrays must be initialized by calling
  39. C subroutine CFFTI1 (N, WA, IFAC), and different WA and IFAC
  40. C arrays must be used for each different value of N. This
  41. C initialization does not have to be repeated so long as N
  42. C remains unchanged. Thus subsequent transforms can be
  43. C obtained faster than the first. The same WA and IFAC arrays
  44. C can be used by CFFTF1 and CFFTB1.
  45. C
  46. C Output Parameters
  47. C
  48. C C For J=1,...,N
  49. C
  50. C C(J)=the sum from K=1,...,N of
  51. C
  52. C C(K)*EXP(-I*(J-1)*(K-1)*2*PI/N)
  53. C
  54. C where I=SQRT(-1)
  55. C
  56. C NOTE: WA and IFAC contain initialization calculations which must
  57. C not be destroyed between calls of subroutine CFFTF1 or CFFTB1
  58. C
  59. C***REFERENCES P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
  60. C Computations (G. Rodrigue, ed.), Academic Press,
  61. C 1982, pp. 51-83.
  62. C***ROUTINES CALLED PASSF, PASSF2, PASSF3, PASSF4, PASSF5
  63. C***REVISION HISTORY (YYMMDD)
  64. C 790601 DATE WRITTEN
  65. C 830401 Modified to use SLATEC library source file format.
  66. C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
  67. C changing dummy array size declarations (1) to (*).
  68. C 881128 Modified by Dick Valent to meet prologue standards.
  69. C 891214 Prologue converted to Version 4.0 format. (BAB)
  70. C 900131 Routine changed from subsidiary to user-callable. (WRB)
  71. C 920501 Reformatted the REFERENCES section. (WRB)
  72. C***END PROLOGUE CFFTF1
  73. DIMENSION CH(*), C(*), WA(*), IFAC(*)
  74. C***FIRST EXECUTABLE STATEMENT CFFTF1
  75. NF = IFAC(2)
  76. NA = 0
  77. L1 = 1
  78. IW = 1
  79. DO 116 K1=1,NF
  80. IP = IFAC(K1+2)
  81. L2 = IP*L1
  82. IDO = N/L2
  83. IDOT = IDO+IDO
  84. IDL1 = IDOT*L1
  85. IF (IP .NE. 4) GO TO 103
  86. IX2 = IW+IDOT
  87. IX3 = IX2+IDOT
  88. IF (NA .NE. 0) GO TO 101
  89. CALL PASSF4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
  90. GO TO 102
  91. 101 CALL PASSF4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
  92. 102 NA = 1-NA
  93. GO TO 115
  94. 103 IF (IP .NE. 2) GO TO 106
  95. IF (NA .NE. 0) GO TO 104
  96. CALL PASSF2 (IDOT,L1,C,CH,WA(IW))
  97. GO TO 105
  98. 104 CALL PASSF2 (IDOT,L1,CH,C,WA(IW))
  99. 105 NA = 1-NA
  100. GO TO 115
  101. 106 IF (IP .NE. 3) GO TO 109
  102. IX2 = IW+IDOT
  103. IF (NA .NE. 0) GO TO 107
  104. CALL PASSF3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
  105. GO TO 108
  106. 107 CALL PASSF3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
  107. 108 NA = 1-NA
  108. GO TO 115
  109. 109 IF (IP .NE. 5) GO TO 112
  110. IX2 = IW+IDOT
  111. IX3 = IX2+IDOT
  112. IX4 = IX3+IDOT
  113. IF (NA .NE. 0) GO TO 110
  114. CALL PASSF5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
  115. GO TO 111
  116. 110 CALL PASSF5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
  117. 111 NA = 1-NA
  118. GO TO 115
  119. 112 IF (NA .NE. 0) GO TO 113
  120. CALL PASSF (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
  121. GO TO 114
  122. 113 CALL PASSF (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
  123. 114 IF (NAC .NE. 0) NA = 1-NA
  124. 115 L1 = L2
  125. IW = IW+(IP-1)*IDOT
  126. 116 CONTINUE
  127. IF (NA .EQ. 0) RETURN
  128. N2 = N+N
  129. DO 117 I=1,N2
  130. C(I) = CH(I)
  131. 117 CONTINUE
  132. RETURN
  133. END