Télécharger rfftb1.eso

Retour à la liste

Numérotation des lignes :

  1. C RFFTB1 SOURCE BP208322 18/10/08 21:15:19 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 RFFTB1 (N,IN,C,CH,WA,FAC)
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13. REAL*8 CH(*), C(IN,*), WA(N) ,FAC(15)
  14. C
  15. NF = INT(FAC(2))
  16. NA = 0
  17. DO 10 K1=1,NF
  18. IP = INT(FAC(K1+2))
  19. NA = 1-NA
  20. IF(IP .LE. 5) GO TO 10
  21. IF(K1 .EQ. NF) GO TO 10
  22. NA = 1-NA
  23. 10 CONTINUE
  24. HALF = .5D0
  25. HALFM = -.5D0
  26. MODN = MOD(N,2)
  27. NL = N-2
  28. IF(MODN .NE. 0) NL = N-1
  29. IF (NA .EQ. 0) GO TO 120
  30. CH(1) = C(1,1)
  31. CH(N) = C(1,N)
  32. DO 118 J=2,NL,2
  33. CH(J) = HALF*C(1,J)
  34. CH(J+1) = HALFM*C(1,J+1)
  35. 118 CONTINUE
  36. GO TO 124
  37. 120 DO 122 J=2,NL,2
  38. C(1,J) = HALF*C(1,J)
  39. C(1,J+1) = HALFM*C(1,J+1)
  40. 122 CONTINUE
  41. 124 L1 = 1
  42. IW = 1
  43. DO 116 K1=1,NF
  44. IP = INT(FAC(K1+2))
  45. L2 = IP*L1
  46. IDO = N/L2
  47. IDL1 = IDO*L1
  48. IF (IP .NE. 4) GO TO 103
  49. IX2 = IW+IDO
  50. IX3 = IX2+IDO
  51. IF (NA .NE. 0) GO TO 101
  52. CALL R1F4KB (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2),WA(IX3))
  53. GO TO 102
  54. 101 CALL R1F4KB (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2),WA(IX3))
  55. 102 NA = 1-NA
  56. GO TO 115
  57. 103 IF (IP .NE. 2) GO TO 106
  58. IF (NA .NE. 0) GO TO 104
  59. CALL R1F2KB (IDO,L1,C,IN,CH,1,WA(IW))
  60. GO TO 105
  61. 104 CALL R1F2KB (IDO,L1,CH,1,C,IN,WA(IW))
  62. 105 NA = 1-NA
  63. GO TO 115
  64. 106 IF (IP .NE. 3) GO TO 109
  65. IX2 = IW+IDO
  66. IF (NA .NE. 0) GO TO 107
  67. CALL R1F3KB (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2))
  68. GO TO 108
  69. 107 CALL R1F3KB (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2))
  70. 108 NA = 1-NA
  71. GO TO 115
  72. 109 IF (IP .NE. 5) GO TO 112
  73. IX2 = IW+IDO
  74. IX3 = IX2+IDO
  75. IX4 = IX3+IDO
  76. IF (NA .NE. 0) GO TO 110
  77. CALL R1F5KB (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2),
  78. 1 WA(IX3),WA(IX4))
  79. GO TO 111
  80. 110 CALL R1F5KB (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2),
  81. 1 WA(IX3),WA(IX4))
  82. 111 NA = 1-NA
  83. GO TO 115
  84. 112 IF (NA .NE. 0) GO TO 113
  85. CALL R1FGKB (IDO,IP,L1,IDL1,C,C,C,IN,CH,CH,1,WA(IW))
  86. GO TO 114
  87. 113 CALL R1FGKB (IDO,IP,L1,IDL1,CH,CH,CH,1,C,C,IN,WA(IW))
  88. 114 IF (IDO .EQ. 1) NA = 1-NA
  89. 115 L1 = L2
  90. IW = IW+(IP-1)*IDO
  91. 116 CONTINUE
  92. RETURN
  93. END
  94.  
  95.  
  96.  

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