passb5.f 5.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143
  1. *DECK PASSB5
  2. SUBROUTINE PASSB5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4)
  3. C***BEGIN PROLOGUE PASSB5
  4. C***SUBSIDIARY
  5. C***PURPOSE Calculate the fast Fourier transform of subvectors of
  6. C length five.
  7. C***LIBRARY SLATEC (FFTPACK)
  8. C***TYPE SINGLE PRECISION (PASSB5-S)
  9. C***AUTHOR Swarztrauber, P. N., (NCAR)
  10. C***ROUTINES CALLED (NONE)
  11. C***REVISION HISTORY (YYMMDD)
  12. C 790601 DATE WRITTEN
  13. C 830401 Modified to use SLATEC library source file format.
  14. C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
  15. C (a) changing dummy array size declarations (1) to (*),
  16. C (b) changing definition of variables PI, TI11, TI12,
  17. C TR11, TR12 by using FORTRAN intrinsic functions ATAN
  18. C and SIN instead of DATA statements.
  19. C 881128 Modified by Dick Valent to meet prologue standards.
  20. C 890831 Modified array declarations. (WRB)
  21. C 891214 Prologue converted to Version 4.0 format. (BAB)
  22. C 900402 Added TYPE section. (WRB)
  23. C***END PROLOGUE PASSB5
  24. DIMENSION CC(IDO,5,*), CH(IDO,L1,5), WA1(*), WA2(*), WA3(*),
  25. + WA4(*)
  26. C***FIRST EXECUTABLE STATEMENT PASSB5
  27. PI = 4.*ATAN(1.)
  28. TR11 = SIN(.1*PI)
  29. TI11 = SIN(.4*PI)
  30. TR12 = -SIN(.3*PI)
  31. TI12 = SIN(.2*PI)
  32. IF (IDO .NE. 2) GO TO 102
  33. DO 101 K=1,L1
  34. TI5 = CC(2,2,K)-CC(2,5,K)
  35. TI2 = CC(2,2,K)+CC(2,5,K)
  36. TI4 = CC(2,3,K)-CC(2,4,K)
  37. TI3 = CC(2,3,K)+CC(2,4,K)
  38. TR5 = CC(1,2,K)-CC(1,5,K)
  39. TR2 = CC(1,2,K)+CC(1,5,K)
  40. TR4 = CC(1,3,K)-CC(1,4,K)
  41. TR3 = CC(1,3,K)+CC(1,4,K)
  42. CH(1,K,1) = CC(1,1,K)+TR2+TR3
  43. CH(2,K,1) = CC(2,1,K)+TI2+TI3
  44. CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
  45. CI2 = CC(2,1,K)+TR11*TI2+TR12*TI3
  46. CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
  47. CI3 = CC(2,1,K)+TR12*TI2+TR11*TI3
  48. CR5 = TI11*TR5+TI12*TR4
  49. CI5 = TI11*TI5+TI12*TI4
  50. CR4 = TI12*TR5-TI11*TR4
  51. CI4 = TI12*TI5-TI11*TI4
  52. CH(1,K,2) = CR2-CI5
  53. CH(1,K,5) = CR2+CI5
  54. CH(2,K,2) = CI2+CR5
  55. CH(2,K,3) = CI3+CR4
  56. CH(1,K,3) = CR3-CI4
  57. CH(1,K,4) = CR3+CI4
  58. CH(2,K,4) = CI3-CR4
  59. CH(2,K,5) = CI2-CR5
  60. 101 CONTINUE
  61. RETURN
  62. 102 IF(IDO/2.LT.L1) GO TO 105
  63. DO 104 K=1,L1
  64. CDIR$ IVDEP
  65. DO 103 I=2,IDO,2
  66. TI5 = CC(I,2,K)-CC(I,5,K)
  67. TI2 = CC(I,2,K)+CC(I,5,K)
  68. TI4 = CC(I,3,K)-CC(I,4,K)
  69. TI3 = CC(I,3,K)+CC(I,4,K)
  70. TR5 = CC(I-1,2,K)-CC(I-1,5,K)
  71. TR2 = CC(I-1,2,K)+CC(I-1,5,K)
  72. TR4 = CC(I-1,3,K)-CC(I-1,4,K)
  73. TR3 = CC(I-1,3,K)+CC(I-1,4,K)
  74. CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
  75. CH(I,K,1) = CC(I,1,K)+TI2+TI3
  76. CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
  77. CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
  78. CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
  79. CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
  80. CR5 = TI11*TR5+TI12*TR4
  81. CI5 = TI11*TI5+TI12*TI4
  82. CR4 = TI12*TR5-TI11*TR4
  83. CI4 = TI12*TI5-TI11*TI4
  84. DR3 = CR3-CI4
  85. DR4 = CR3+CI4
  86. DI3 = CI3+CR4
  87. DI4 = CI3-CR4
  88. DR5 = CR2+CI5
  89. DR2 = CR2-CI5
  90. DI5 = CI2-CR5
  91. DI2 = CI2+CR5
  92. CH(I-1,K,2) = WA1(I-1)*DR2-WA1(I)*DI2
  93. CH(I,K,2) = WA1(I-1)*DI2+WA1(I)*DR2
  94. CH(I-1,K,3) = WA2(I-1)*DR3-WA2(I)*DI3
  95. CH(I,K,3) = WA2(I-1)*DI3+WA2(I)*DR3
  96. CH(I-1,K,4) = WA3(I-1)*DR4-WA3(I)*DI4
  97. CH(I,K,4) = WA3(I-1)*DI4+WA3(I)*DR4
  98. CH(I-1,K,5) = WA4(I-1)*DR5-WA4(I)*DI5
  99. CH(I,K,5) = WA4(I-1)*DI5+WA4(I)*DR5
  100. 103 CONTINUE
  101. 104 CONTINUE
  102. RETURN
  103. 105 DO 107 I=2,IDO,2
  104. CDIR$ IVDEP
  105. DO 106 K=1,L1
  106. TI5 = CC(I,2,K)-CC(I,5,K)
  107. TI2 = CC(I,2,K)+CC(I,5,K)
  108. TI4 = CC(I,3,K)-CC(I,4,K)
  109. TI3 = CC(I,3,K)+CC(I,4,K)
  110. TR5 = CC(I-1,2,K)-CC(I-1,5,K)
  111. TR2 = CC(I-1,2,K)+CC(I-1,5,K)
  112. TR4 = CC(I-1,3,K)-CC(I-1,4,K)
  113. TR3 = CC(I-1,3,K)+CC(I-1,4,K)
  114. CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
  115. CH(I,K,1) = CC(I,1,K)+TI2+TI3
  116. CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
  117. CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
  118. CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
  119. CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
  120. CR5 = TI11*TR5+TI12*TR4
  121. CI5 = TI11*TI5+TI12*TI4
  122. CR4 = TI12*TR5-TI11*TR4
  123. CI4 = TI12*TI5-TI11*TI4
  124. DR3 = CR3-CI4
  125. DR4 = CR3+CI4
  126. DI3 = CI3+CR4
  127. DI4 = CI3-CR4
  128. DR5 = CR2+CI5
  129. DR2 = CR2-CI5
  130. DI5 = CI2-CR5
  131. DI2 = CI2+CR5
  132. CH(I-1,K,2) = WA1(I-1)*DR2-WA1(I)*DI2
  133. CH(I,K,2) = WA1(I-1)*DI2+WA1(I)*DR2
  134. CH(I-1,K,3) = WA2(I-1)*DR3-WA2(I)*DI3
  135. CH(I,K,3) = WA2(I-1)*DI3+WA2(I)*DR3
  136. CH(I-1,K,4) = WA3(I-1)*DR4-WA3(I)*DI4
  137. CH(I,K,4) = WA3(I-1)*DI4+WA3(I)*DR4
  138. CH(I-1,K,5) = WA4(I-1)*DR5-WA4(I)*DI5
  139. CH(I,K,5) = WA4(I-1)*DI5+WA4(I)*DR5
  140. 106 CONTINUE
  141. 107 CONTINUE
  142. RETURN
  143. END