Télécharger rfftf1.eso

Retour à la liste

Numérotation des lignes :

  1. C RFFTF1 SOURCE BP208322 18/10/08 21:15:20 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 RFFTF1 (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 = 1
  17. L2 = N
  18. IW = N
  19. DO 111 K1=1,NF
  20.  
  21. KH = NF-K1
  22. IP = INT(FAC(KH+3))
  23. L1 = L2/IP
  24. IDO = N/L2
  25. IDL1 = IDO*L1
  26. IW = IW-(IP-1)*IDO
  27. NA = 1-NA
  28.  
  29. c CAS IP=4
  30. IF (IP .NE. 4) GO TO 102
  31. IX2 = IW+IDO
  32. IX3 = IX2+IDO
  33. IF (NA .NE. 0) GO TO 101
  34. CALL R1F4KF (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2),WA(IX3))
  35. GO TO 110
  36. 101 CALL R1F4KF (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2),WA(IX3))
  37. GO TO 110
  38.  
  39. c CAS IP=2
  40. 102 IF (IP .NE. 2) GO TO 104
  41. IF (NA .NE. 0) GO TO 103
  42. CALL R1F2KF (IDO,L1,C,IN,CH,1,WA(IW))
  43. GO TO 110
  44. 103 CALL R1F2KF (IDO,L1,CH,1,C,IN,WA(IW))
  45. GO TO 110
  46.  
  47. c CAS IP=3
  48. 104 IF (IP .NE. 3) GO TO 106
  49. IX2 = IW+IDO
  50. IF (NA .NE. 0) GO TO 105
  51. CALL R1F3KF (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2))
  52. GO TO 110
  53. 105 CALL R1F3KF (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2))
  54. GO TO 110
  55.  
  56. c CAS IP=5
  57. 106 IF (IP .NE. 5) GO TO 108
  58. IX2 = IW+IDO
  59. IX3 = IX2+IDO
  60. IX4 = IX3+IDO
  61. IF (NA .NE. 0) GO TO 107
  62. CALL R1F5KF (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2),
  63. 1 WA(IX3),WA(IX4))
  64. GO TO 110
  65. 107 CALL R1F5KF (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2),
  66. 1 WA(IX3),WA(IX4))
  67. GO TO 110
  68.  
  69. c AUTRES CAS POUR IP
  70. 108 IF (IDO .EQ. 1) NA = 1-NA
  71. IF (NA .NE. 0) GO TO 109
  72. CALL R1FGKF (IDO,IP,L1,IDL1,C,C,C,IN,CH,CH,1,WA(IW))
  73. NA = 1
  74. GO TO 110
  75. 109 CALL R1FGKF (IDO,IP,L1,IDL1,CH,CH,CH,1,C,C,IN,WA(IW))
  76. NA = 0
  77.  
  78. 110 L2 = L1
  79. 111 CONTINUE
  80.  
  81. SN = 1./N
  82. TSN = 2./N
  83. TSNM = -TSN
  84. MODN = MOD(N,2)
  85. NL = N-2
  86. IF(MODN .NE. 0) NL = N-1
  87. IF (NA .NE. 0) GO TO 120
  88. C(1,1) = SN*CH(1)
  89. DO 118 J=2,NL,2
  90. C(1,J) = TSN*CH(J)
  91. C(1,J+1) = TSNM*CH(J+1)
  92. 118 CONTINUE
  93. IF(MODN .NE. 0) RETURN
  94. C(1,N) = SN*CH(N)
  95. RETURN
  96. 120 C(1,1) = SN*C(1,1)
  97. DO 122 J=2,NL,2
  98. C(1,J) = TSN*C(1,J)
  99. C(1,J+1) = TSNM*C(1,J+1)
  100. 122 CONTINUE
  101. IF(MODN .NE. 0) RETURN
  102. C(1,N) = SN*C(1,N)
  103. RETURN
  104. END
  105.  
  106.  
  107.  

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