Télécharger r1f5kb.eso

Retour à la liste

Numérotation des lignes :

  1. C R1F5KB SOURCE BP208322 18/10/08 21:15:13 9952
  2. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  3. C
  4. C FFTPACK 5.1
  5. C
  6. C Authors: Paul N. Swarztrauber and Richard A. Valent
  7. C
  8. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  9.  
  10. SUBROUTINE R1F5KB (IDO,L1,CC,IN1,CH,IN2,
  11. 1 WA1,WA2,WA3,WA4)
  12. IMPLICIT INTEGER(I-N)
  13. IMPLICIT REAL*8(A-H,O-Z)
  14. REAL*8 CC(IN1,IDO,5,L1) ,CH(IN2,IDO,L1,5),
  15. 1 WA1(IDO) ,WA2(IDO) ,WA3(IDO) ,WA4(IDO)
  16. C
  17. ARG=8.D0*ATAN(1.0D0)/5.D0
  18. TR11=COS(ARG)
  19. TI11=SIN(ARG)
  20. TR12=COS(2.D0*ARG)
  21. TI12=SIN(2.D0*ARG)
  22. DO 101 K=1,L1
  23. CH(1,1,K,1) = CC(1,1,1,K)+2.*CC(1,IDO,2,K)+2.*CC(1,IDO,4,K)
  24. CH(1,1,K,2) = (CC(1,1,1,K)+TR11*2.*CC(1,IDO,2,K)
  25. 1 +TR12*2.*CC(1,IDO,4,K))-(TI11*2.*CC(1,1,3,K)
  26. 1 +TI12*2.*CC(1,1,5,K))
  27. CH(1,1,K,3) = (CC(1,1,1,K)+TR12*2.*CC(1,IDO,2,K)
  28. 1 +TR11*2.*CC(1,IDO,4,K))-(TI12*2.*CC(1,1,3,K)
  29. 1 -TI11*2.*CC(1,1,5,K))
  30. CH(1,1,K,4) = (CC(1,1,1,K)+TR12*2.*CC(1,IDO,2,K)
  31. 1 +TR11*2.*CC(1,IDO,4,K))+(TI12*2.*CC(1,1,3,K)
  32. 1 -TI11*2.*CC(1,1,5,K))
  33. CH(1,1,K,5) = (CC(1,1,1,K)+TR11*2.*CC(1,IDO,2,K)
  34. 1 +TR12*2.*CC(1,IDO,4,K))+(TI11*2.*CC(1,1,3,K)
  35. 1 +TI12*2.*CC(1,1,5,K))
  36. 101 CONTINUE
  37. IF (IDO .EQ. 1) RETURN
  38. IDP2 = IDO+2
  39. DO 103 K=1,L1
  40. DO 102 I=3,IDO,2
  41. IC = IDP2-I
  42. CH(1,I-1,K,1) = CC(1,I-1,1,K)+(CC(1,I-1,3,K)+CC(1,IC-1,2,K))
  43. 1 +(CC(1,I-1,5,K)+CC(1,IC-1,4,K))
  44. CH(1,I,K,1) = CC(1,I,1,K)+(CC(1,I,3,K)-CC(1,IC,2,K))
  45. 1 +(CC(1,I,5,K)-CC(1,IC,4,K))
  46. CH(1,I-1,K,2) = WA1(I-2)*((CC(1,I-1,1,K)+TR11*
  47. 1 (CC(1,I-1,3,K)+CC(1,IC-1,2,K))+TR12
  48. 1 *(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))-(TI11*(CC(1,I,3,K)
  49. 1 +CC(1,IC,2,K))+TI12*(CC(1,I,5,K)+CC(1,IC,4,K))))
  50. 1 -WA1(I-1)*((CC(1,I,1,K)+TR11*(CC(1,I,3,K)-CC(1,IC,2,K))
  51. 1 +TR12*(CC(1,I,5,K)-CC(1,IC,4,K)))+(TI11*(CC(1,I-1,3,K)
  52. 1 -CC(1,IC-1,2,K))+TI12*(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))
  53. CH(1,I,K,2) = WA1(I-2)*((CC(1,I,1,K)+TR11*(CC(1,I,3,K)
  54. 1 -CC(1,IC,2,K))+TR12*(CC(1,I,5,K)-CC(1,IC,4,K)))
  55. 1 +(TI11*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))+TI12
  56. 1 *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))+WA1(I-1)
  57. 1 *((CC(1,I-1,1,K)+TR11*(CC(1,I-1,3,K)
  58. 1 +CC(1,IC-1,2,K))+TR12*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))
  59. 1 -(TI11*(CC(1,I,3,K)+CC(1,IC,2,K))+TI12
  60. 1 *(CC(1,I,5,K)+CC(1,IC,4,K))))
  61. CH(1,I-1,K,3) = WA2(I-2)
  62. 1 *((CC(1,I-1,1,K)+TR12*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))
  63. 1 +TR11*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))-(TI12*(CC(1,I,3,K)
  64. 1 +CC(1,IC,2,K))-TI11*(CC(1,I,5,K)+CC(1,IC,4,K))))
  65. 1 -WA2(I-1)
  66. 1 *((CC(1,I,1,K)+TR12*(CC(1,I,3,K)-
  67. 1 CC(1,IC,2,K))+TR11*(CC(1,I,5,K)-CC(1,IC,4,K)))
  68. 1 +(TI12*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))-TI11
  69. 1 *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))
  70. CH(1,I,K,3) = WA2(I-2)
  71. 1 *((CC(1,I,1,K)+TR12*(CC(1,I,3,K)-
  72. 1 CC(1,IC,2,K))+TR11*(CC(1,I,5,K)-CC(1,IC,4,K)))
  73. 1 +(TI12*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))-TI11
  74. 1 *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))
  75. 1 +WA2(I-1)
  76. 1 *((CC(1,I-1,1,K)+TR12*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))
  77. 1 +TR11*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))-(TI12*(CC(1,I,3,K)
  78. 1 +CC(1,IC,2,K))-TI11*(CC(1,I,5,K)+CC(1,IC,4,K))))
  79. CH(1,I-1,K,4) = WA3(I-2)
  80. 1 *((CC(1,I-1,1,K)+TR12*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))
  81. 1 +TR11*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))+(TI12*(CC(1,I,3,K)
  82. 1 +CC(1,IC,2,K))-TI11*(CC(1,I,5,K)+CC(1,IC,4,K))))
  83. 1 -WA3(I-1)
  84. 1 *((CC(1,I,1,K)+TR12*(CC(1,I,3,K)-
  85. 1 CC(1,IC,2,K))+TR11*(CC(1,I,5,K)-CC(1,IC,4,K)))
  86. 1 -(TI12*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))-TI11
  87. 1 *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))
  88. CH(1,I,K,4) = WA3(I-2)
  89. 1 *((CC(1,I,1,K)+TR12*(CC(1,I,3,K)-
  90. 1 CC(1,IC,2,K))+TR11*(CC(1,I,5,K)-CC(1,IC,4,K)))
  91. 1 -(TI12*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))-TI11
  92. 1 *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))
  93. 1 +WA3(I-1)
  94. 1 *((CC(1,I-1,1,K)+TR12*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))
  95. 1 +TR11*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))+(TI12*(CC(1,I,3,K)
  96. 1 +CC(1,IC,2,K))-TI11*(CC(1,I,5,K)+CC(1,IC,4,K))))
  97. CH(1,I-1,K,5) = WA4(I-2)
  98. 1 *((CC(1,I-1,1,K)+TR11*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))
  99. 1 +TR12*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))+(TI11*(CC(1,I,3,K)
  100. 1 +CC(1,IC,2,K))+TI12*(CC(1,I,5,K)+CC(1,IC,4,K))))
  101. 1 -WA4(I-1)
  102. 1 *((CC(1,I,1,K)+TR11*(CC(1,I,3,K)-CC(1,IC,2,K))
  103. 1 +TR12*(CC(1,I,5,K)-CC(1,IC,4,K)))-(TI11*(CC(1,I-1,3,K)
  104. 1 -CC(1,IC-1,2,K))+TI12*(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))
  105. CH(1,I,K,5) = WA4(I-2)
  106. 1 *((CC(1,I,1,K)+TR11*(CC(1,I,3,K)-CC(1,IC,2,K))
  107. 1 +TR12*(CC(1,I,5,K)-CC(1,IC,4,K)))-(TI11*(CC(1,I-1,3,K)
  108. 1 -CC(1,IC-1,2,K))+TI12*(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))
  109. 1 +WA4(I-1)
  110. 1 *((CC(1,I-1,1,K)+TR11*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))
  111. 1 +TR12*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))+(TI11*(CC(1,I,3,K)
  112. 1 +CC(1,IC,2,K))+TI12*(CC(1,I,5,K)+CC(1,IC,4,K))))
  113. 102 CONTINUE
  114. 103 CONTINUE
  115. RETURN
  116. END
  117.  
  118.  
  119.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales