Télécharger r1fgkb.eso

Retour à la liste

Numérotation des lignes :

  1. C R1FGKB SOURCE BP208322 18/10/08 21:15:15 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 R1FGKB (IDO,IP,L1,IDL1,CC,C1,C2,IN1,
  11. 1 CH,CH2,IN2,WA)
  12. IMPLICIT INTEGER(I-N)
  13. IMPLICIT REAL*8(A-H,O-Z)
  14. REAL*8 CH(IN2,IDO,L1,IP) ,CC(IN1,IDO,IP,L1) ,
  15. 1 C1(IN1,IDO,L1,IP) ,C2(IN1,IDL1,IP),
  16. 2 CH2(IN2,IDL1,IP) ,WA(IDO)
  17. C
  18. TPI=8.D0*ATAN(1.0d0)
  19. ARG = TPI/REAL(IP)
  20. DCP = COS(ARG)
  21. DSP = SIN(ARG)
  22. IDP2 = IDO+2
  23. NBD = (IDO-1)/2
  24. IPP2 = IP+2
  25. IPPH = (IP+1)/2
  26. IF (IDO .LT. L1) GO TO 103
  27. DO 102 K=1,L1
  28. DO 101 I=1,IDO
  29. CH(1,I,K,1) = CC(1,I,1,K)
  30. 101 CONTINUE
  31. 102 CONTINUE
  32. GO TO 106
  33. 103 DO 105 I=1,IDO
  34. DO 104 K=1,L1
  35. CH(1,I,K,1) = CC(1,I,1,K)
  36. 104 CONTINUE
  37. 105 CONTINUE
  38. 106 DO 108 J=2,IPPH
  39. JC = IPP2-J
  40. J2 = J+J
  41. DO 107 K=1,L1
  42. CH(1,1,K,J) = CC(1,IDO,J2-2,K)+CC(1,IDO,J2-2,K)
  43. CH(1,1,K,JC) = CC(1,1,J2-1,K)+CC(1,1,J2-1,K)
  44. 1007 CONTINUE
  45. 107 CONTINUE
  46. 108 CONTINUE
  47. IF (IDO .EQ. 1) GO TO 116
  48. IF (NBD .LT. L1) GO TO 112
  49. DO 111 J=2,IPPH
  50. JC = IPP2-J
  51. DO 110 K=1,L1
  52. DO 109 I=3,IDO,2
  53. IC = IDP2-I
  54. CH(1,I-1,K,J) = CC(1,I-1,2*J-1,K)+CC(1,IC-1,2*J-2,K)
  55. CH(1,I-1,K,JC) = CC(1,I-1,2*J-1,K)-CC(1,IC-1,2*J-2,K)
  56. CH(1,I,K,J) = CC(1,I,2*J-1,K)-CC(1,IC,2*J-2,K)
  57. CH(1,I,K,JC) = CC(1,I,2*J-1,K)+CC(1,IC,2*J-2,K)
  58. 109 CONTINUE
  59. 110 CONTINUE
  60. 111 CONTINUE
  61. GO TO 116
  62. 112 DO 115 J=2,IPPH
  63. JC = IPP2-J
  64. DO 114 I=3,IDO,2
  65. IC = IDP2-I
  66. DO 113 K=1,L1
  67. CH(1,I-1,K,J) = CC(1,I-1,2*J-1,K)+CC(1,IC-1,2*J-2,K)
  68. CH(1,I-1,K,JC) = CC(1,I-1,2*J-1,K)-CC(1,IC-1,2*J-2,K)
  69. CH(1,I,K,J) = CC(1,I,2*J-1,K)-CC(1,IC,2*J-2,K)
  70. CH(1,I,K,JC) = CC(1,I,2*J-1,K)+CC(1,IC,2*J-2,K)
  71. 113 CONTINUE
  72. 114 CONTINUE
  73. 115 CONTINUE
  74. 116 AR1 = 1.
  75. AI1 = 0.
  76. DO 120 L=2,IPPH
  77. LC = IPP2-L
  78. AR1H = DCP*AR1-DSP*AI1
  79. AI1 = DCP*AI1+DSP*AR1
  80. AR1 = AR1H
  81. DO 117 IK=1,IDL1
  82. C2(1,IK,L) = CH2(1,IK,1)+AR1*CH2(1,IK,2)
  83. C2(1,IK,LC) = AI1*CH2(1,IK,IP)
  84. 117 CONTINUE
  85. DC2 = AR1
  86. DS2 = AI1
  87. AR2 = AR1
  88. AI2 = AI1
  89. DO 119 J=3,IPPH
  90. JC = IPP2-J
  91. AR2H = DC2*AR2-DS2*AI2
  92. AI2 = DC2*AI2+DS2*AR2
  93. AR2 = AR2H
  94. DO 118 IK=1,IDL1
  95. C2(1,IK,L) = C2(1,IK,L)+AR2*CH2(1,IK,J)
  96. C2(1,IK,LC) = C2(1,IK,LC)+AI2*CH2(1,IK,JC)
  97. 118 CONTINUE
  98. 119 CONTINUE
  99. 120 CONTINUE
  100. DO 122 J=2,IPPH
  101. DO 121 IK=1,IDL1
  102. CH2(1,IK,1) = CH2(1,IK,1)+CH2(1,IK,J)
  103. 121 CONTINUE
  104. 122 CONTINUE
  105. DO 124 J=2,IPPH
  106. JC = IPP2-J
  107. DO 123 K=1,L1
  108. CH(1,1,K,J) = C1(1,1,K,J)-C1(1,1,K,JC)
  109. CH(1,1,K,JC) = C1(1,1,K,J)+C1(1,1,K,JC)
  110. 123 CONTINUE
  111. 124 CONTINUE
  112. IF (IDO .EQ. 1) GO TO 132
  113. IF (NBD .LT. L1) GO TO 128
  114. DO 127 J=2,IPPH
  115. JC = IPP2-J
  116. DO 126 K=1,L1
  117. DO 125 I=3,IDO,2
  118. CH(1,I-1,K,J) = C1(1,I-1,K,J)-C1(1,I,K,JC)
  119. CH(1,I-1,K,JC) = C1(1,I-1,K,J)+C1(1,I,K,JC)
  120. CH(1,I,K,J) = C1(1,I,K,J)+C1(1,I-1,K,JC)
  121. CH(1,I,K,JC) = C1(1,I,K,J)-C1(1,I-1,K,JC)
  122. 125 CONTINUE
  123. 126 CONTINUE
  124. 127 CONTINUE
  125. GO TO 132
  126. 128 DO 131 J=2,IPPH
  127. JC = IPP2-J
  128. DO 130 I=3,IDO,2
  129. DO 129 K=1,L1
  130. CH(1,I-1,K,J) = C1(1,I-1,K,J)-C1(1,I,K,JC)
  131. CH(1,I-1,K,JC) = C1(1,I-1,K,J)+C1(1,I,K,JC)
  132. CH(1,I,K,J) = C1(1,I,K,J)+C1(1,I-1,K,JC)
  133. CH(1,I,K,JC) = C1(1,I,K,J)-C1(1,I-1,K,JC)
  134. 129 CONTINUE
  135. 130 CONTINUE
  136. 131 CONTINUE
  137. 132 CONTINUE
  138. IF (IDO .EQ. 1) RETURN
  139. DO 133 IK=1,IDL1
  140. C2(1,IK,1) = CH2(1,IK,1)
  141. 133 CONTINUE
  142. DO 135 J=2,IP
  143. DO 134 K=1,L1
  144. C1(1,1,K,J) = CH(1,1,K,J)
  145. 134 CONTINUE
  146. 135 CONTINUE
  147. IF (NBD .GT. L1) GO TO 139
  148. IS = -IDO
  149. DO 138 J=2,IP
  150. IS = IS+IDO
  151. IDIJ = IS
  152. DO 137 I=3,IDO,2
  153. IDIJ = IDIJ+2
  154. DO 136 K=1,L1
  155. C1(1,I-1,K,J) = WA(IDIJ-1)*CH(1,I-1,K,J)-WA(IDIJ)*
  156. 1 CH(1,I,K,J)
  157. C1(1,I,K,J) = WA(IDIJ-1)*CH(1,I,K,J)+WA(IDIJ)*
  158. 1 CH(1,I-1,K,J)
  159. 136 CONTINUE
  160. 137 CONTINUE
  161. 138 CONTINUE
  162. GO TO 143
  163. 139 IS = -IDO
  164. DO 142 J=2,IP
  165. IS = IS+IDO
  166. DO 141 K=1,L1
  167. IDIJ = IS
  168. DO 140 I=3,IDO,2
  169. IDIJ = IDIJ+2
  170. C1(1,I-1,K,J) = WA(IDIJ-1)*CH(1,I-1,K,J)-WA(IDIJ)*
  171. 1 CH(1,I,K,J)
  172. C1(1,I,K,J) = WA(IDIJ-1)*CH(1,I,K,J)+WA(IDIJ)*
  173. 1 CH(1,I-1,K,J)
  174. 140 CONTINUE
  175. 141 CONTINUE
  176. 142 CONTINUE
  177. 143 RETURN
  178. END
  179.  
  180.  
  181.  

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