cfftb1.f 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131
  1. *DECK CFFTB1
  2. SUBROUTINE CFFTB1 (N, C, CH, WA, IFAC)
  3. C***BEGIN PROLOGUE CFFTB1
  4. C***PURPOSE Compute the unnormalized inverse of CFFTF1.
  5. C***LIBRARY SLATEC (FFTPACK)
  6. C***CATEGORY J1A2
  7. C***TYPE COMPLEX (RFFTB1-S, CFFTB1-C)
  8. C***KEYWORDS FFTPACK, FOURIER TRANSFORM
  9. C***AUTHOR Swarztrauber, P. N., (NCAR)
  10. C***DESCRIPTION
  11. C
  12. C Subroutine CFFTB1 computes the backward complex discrete Fourier
  13. C transform (the Fourier synthesis). Equivalently, CFFTB1 computes
  14. C a complex periodic sequence from its Fourier coefficients.
  15. C The transform is defined below at output parameter C.
  16. C
  17. C A call of CFFTF1 followed by a call of CFFTB1 will multiply the
  18. C sequence by N.
  19. C
  20. C The arrays WA and IFAC which are used by subroutine CFFTB1 must be
  21. C initialized by calling subroutine CFFTI1 (N, WA, IFAC).
  22. C
  23. C Input Parameters
  24. C
  25. C N the length of the complex sequence C. The method is
  26. C more efficient when N is the product of small primes.
  27. C
  28. C C a complex array of length N which contains the sequence
  29. C
  30. C CH a real work array of length at least 2*N
  31. C
  32. C WA a real work array which must be dimensioned at least 2*N.
  33. C
  34. C IFAC an integer work array which must be dimensioned at least 15.
  35. C
  36. C The WA and IFAC arrays must be initialized by calling
  37. C subroutine CFFTI1 (N, WA, IFAC), and different WA and IFAC
  38. C arrays must be used for each different value of N. This
  39. C initialization does not have to be repeated so long as N
  40. C remains unchanged. Thus subsequent transforms can be
  41. C obtained faster than the first. The same WA and IFAC arrays
  42. C can be used by CFFTF1 and CFFTB1.
  43. C
  44. C Output Parameters
  45. C
  46. C C For J=1,...,N
  47. C
  48. C C(J)=the sum from K=1,...,N of
  49. C
  50. C C(K)*EXP(I*(J-1)*(K-1)*2*PI/N)
  51. C
  52. C where I=SQRT(-1)
  53. C
  54. C NOTE: WA and IFAC contain initialization calculations which must
  55. C not be destroyed between calls of subroutine CFFTF1 or CFFTB1
  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 PASSB, PASSB2, PASSB3, PASSB4, PASSB5
  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 881128 Modified by Dick Valent to meet prologue standards.
  67. C 891214 Prologue converted to Version 4.0 format. (BAB)
  68. C 900131 Routine changed from subsidiary to user-callable. (WRB)
  69. C 920501 Reformatted the REFERENCES section. (WRB)
  70. C***END PROLOGUE CFFTB1
  71. DIMENSION CH(*), C(*), WA(*), IFAC(*)
  72. C***FIRST EXECUTABLE STATEMENT CFFTB1
  73. NF = IFAC(2)
  74. NA = 0
  75. L1 = 1
  76. IW = 1
  77. DO 116 K1=1,NF
  78. IP = IFAC(K1+2)
  79. L2 = IP*L1
  80. IDO = N/L2
  81. IDOT = IDO+IDO
  82. IDL1 = IDOT*L1
  83. IF (IP .NE. 4) GO TO 103
  84. IX2 = IW+IDOT
  85. IX3 = IX2+IDOT
  86. IF (NA .NE. 0) GO TO 101
  87. CALL PASSB4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
  88. GO TO 102
  89. 101 CALL PASSB4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
  90. 102 NA = 1-NA
  91. GO TO 115
  92. 103 IF (IP .NE. 2) GO TO 106
  93. IF (NA .NE. 0) GO TO 104
  94. CALL PASSB2 (IDOT,L1,C,CH,WA(IW))
  95. GO TO 105
  96. 104 CALL PASSB2 (IDOT,L1,CH,C,WA(IW))
  97. 105 NA = 1-NA
  98. GO TO 115
  99. 106 IF (IP .NE. 3) GO TO 109
  100. IX2 = IW+IDOT
  101. IF (NA .NE. 0) GO TO 107
  102. CALL PASSB3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
  103. GO TO 108
  104. 107 CALL PASSB3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
  105. 108 NA = 1-NA
  106. GO TO 115
  107. 109 IF (IP .NE. 5) GO TO 112
  108. IX2 = IW+IDOT
  109. IX3 = IX2+IDOT
  110. IX4 = IX3+IDOT
  111. IF (NA .NE. 0) GO TO 110
  112. CALL PASSB5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
  113. GO TO 111
  114. 110 CALL PASSB5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
  115. 111 NA = 1-NA
  116. GO TO 115
  117. 112 IF (NA .NE. 0) GO TO 113
  118. CALL PASSB (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
  119. GO TO 114
  120. 113 CALL PASSB (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
  121. 114 IF (NAC .NE. 0) NA = 1-NA
  122. 115 L1 = L2
  123. IW = IW+(IP-1)*IDOT
  124. 116 CONTINUE
  125. IF (NA .EQ. 0) RETURN
  126. N2 = N+N
  127. DO 117 I=1,N2
  128. C(I) = CH(I)
  129. 117 CONTINUE
  130. RETURN
  131. END