radf5.f 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. *DECK RADF5
  2. SUBROUTINE RADF5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4)
  3. C***BEGIN PROLOGUE RADF5
  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 (RADF5-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 RADF5
  24. DIMENSION CC(IDO,L1,5), CH(IDO,5,*), WA1(*), WA2(*), WA3(*),
  25. + WA4(*)
  26. C***FIRST EXECUTABLE STATEMENT RADF5
  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. DO 101 K=1,L1
  33. CR2 = CC(1,K,5)+CC(1,K,2)
  34. CI5 = CC(1,K,5)-CC(1,K,2)
  35. CR3 = CC(1,K,4)+CC(1,K,3)
  36. CI4 = CC(1,K,4)-CC(1,K,3)
  37. CH(1,1,K) = CC(1,K,1)+CR2+CR3
  38. CH(IDO,2,K) = CC(1,K,1)+TR11*CR2+TR12*CR3
  39. CH(1,3,K) = TI11*CI5+TI12*CI4
  40. CH(IDO,4,K) = CC(1,K,1)+TR12*CR2+TR11*CR3
  41. CH(1,5,K) = TI12*CI5-TI11*CI4
  42. 101 CONTINUE
  43. IF (IDO .EQ. 1) RETURN
  44. IDP2 = IDO+2
  45. IF((IDO-1)/2.LT.L1) GO TO 104
  46. DO 103 K=1,L1
  47. CDIR$ IVDEP
  48. DO 102 I=3,IDO,2
  49. IC = IDP2-I
  50. DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
  51. DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
  52. DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
  53. DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
  54. DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
  55. DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
  56. DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
  57. DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
  58. CR2 = DR2+DR5
  59. CI5 = DR5-DR2
  60. CR5 = DI2-DI5
  61. CI2 = DI2+DI5
  62. CR3 = DR3+DR4
  63. CI4 = DR4-DR3
  64. CR4 = DI3-DI4
  65. CI3 = DI3+DI4
  66. CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
  67. CH(I,1,K) = CC(I,K,1)+CI2+CI3
  68. TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
  69. TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
  70. TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
  71. TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
  72. TR5 = TI11*CR5+TI12*CR4
  73. TI5 = TI11*CI5+TI12*CI4
  74. TR4 = TI12*CR5-TI11*CR4
  75. TI4 = TI12*CI5-TI11*CI4
  76. CH(I-1,3,K) = TR2+TR5
  77. CH(IC-1,2,K) = TR2-TR5
  78. CH(I,3,K) = TI2+TI5
  79. CH(IC,2,K) = TI5-TI2
  80. CH(I-1,5,K) = TR3+TR4
  81. CH(IC-1,4,K) = TR3-TR4
  82. CH(I,5,K) = TI3+TI4
  83. CH(IC,4,K) = TI4-TI3
  84. 102 CONTINUE
  85. 103 CONTINUE
  86. RETURN
  87. 104 DO 106 I=3,IDO,2
  88. IC = IDP2-I
  89. CDIR$ IVDEP
  90. DO 105 K=1,L1
  91. DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
  92. DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
  93. DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
  94. DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
  95. DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
  96. DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
  97. DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
  98. DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
  99. CR2 = DR2+DR5
  100. CI5 = DR5-DR2
  101. CR5 = DI2-DI5
  102. CI2 = DI2+DI5
  103. CR3 = DR3+DR4
  104. CI4 = DR4-DR3
  105. CR4 = DI3-DI4
  106. CI3 = DI3+DI4
  107. CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
  108. CH(I,1,K) = CC(I,K,1)+CI2+CI3
  109. TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
  110. TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
  111. TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
  112. TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
  113. TR5 = TI11*CR5+TI12*CR4
  114. TI5 = TI11*CI5+TI12*CI4
  115. TR4 = TI12*CR5-TI11*CR4
  116. TI4 = TI12*CI5-TI11*CI4
  117. CH(I-1,3,K) = TR2+TR5
  118. CH(IC-1,2,K) = TR2-TR5
  119. CH(I,3,K) = TI2+TI5
  120. CH(IC,2,K) = TI5-TI2
  121. CH(I-1,5,K) = TR3+TR4
  122. CH(IC-1,4,K) = TR3-TR4
  123. CH(I,5,K) = TI3+TI4
  124. CH(IC,4,K) = TI4-TI3
  125. 105 CONTINUE
  126. 106 CONTINUE
  127. RETURN
  128. END