Télécharger la plaquette Cast3M


fr en

Télécharger rfftf1.eso

Retour à la liste

Numérotation des lignes : 

rfftf1

  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