share/fftpack5/fortran/rfftf1.f

   1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 C
   3 C   FFTPACK 5.0
   4 C
   5 C   Authors:  Paul N. Swarztrauber and Richard A. Valent
   6 C
   7 C   $Id$
   8 C
   9 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10
  11       SUBROUTINE RFFTF1 (N,IN,C,CH,WA,FAC)
  12       REAL       CH(*) ,C(IN,*)  ,WA(N)   ,FAC(15)
  13 C
  14       NF = FAC(2)
  15       NA = 1
  16       L2 = N
  17       IW = N
  18       DO 111 K1=1,NF
  19          KH = NF-K1
  20          IP = FAC(KH+3)
  21          L1 = L2/IP
  22          IDO = N/L2
  23          IDL1 = IDO*L1
  24          IW = IW-(IP-1)*IDO
  25          NA = 1-NA
  26          IF (IP .NE. 4) GO TO 102
  27          IX2 = IW+IDO
  28          IX3 = IX2+IDO
  29          IF (NA .NE. 0) GO TO 101
  30          CALL R1F4KF (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2),WA(IX3))
  31          GO TO 110
  32   101    CALL R1F4KF (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2),WA(IX3))
  33          GO TO 110
  34   102    IF (IP .NE. 2) GO TO 104
  35          IF (NA .NE. 0) GO TO 103
  36          CALL R1F2KF (IDO,L1,C,IN,CH,1,WA(IW))
  37          GO TO 110
  38   103    CALL R1F2KF (IDO,L1,CH,1,C,IN,WA(IW))
  39          GO TO 110
  40   104    IF (IP .NE. 3) GO TO 106
  41          IX2 = IW+IDO
  42          IF (NA .NE. 0) GO TO 105
  43          CALL R1F3KF (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2))
  44          GO TO 110
  45   105    CALL R1F3KF (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2))
  46          GO TO 110
  47   106    IF (IP .NE. 5) GO TO 108
  48          IX2 = IW+IDO
  49          IX3 = IX2+IDO
  50          IX4 = IX3+IDO
  51          IF (NA .NE. 0) GO TO 107
  52          CALL R1F5KF (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2),
  53      1                      WA(IX3),WA(IX4))
  54          GO TO 110
  55   107    CALL R1F5KF (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2),
  56      1                      WA(IX3),WA(IX4))
  57          GO TO 110
  58   108    IF (IDO .EQ. 1) NA = 1-NA
  59          IF (NA .NE. 0) GO TO 109
  60          CALL R1FGKF (IDO,IP,L1,IDL1,C,C,C,IN,CH,CH,1,WA(IW))
  61          NA = 1
  62          GO TO 110
  63   109    CALL R1FGKF (IDO,IP,L1,IDL1,CH,CH,CH,1,C,C,IN,WA(IW))
  64          NA = 0
  65   110    L2 = L1
  66   111 CONTINUE
  67       SN = 1./N
  68       TSN = 2./N
  69       TSNM = -TSN
  70       MODN = MOD(N,2)
  71       NL = N-2
  72       IF(MODN .NE. 0) NL = N-1
  73       IF (NA .NE. 0) GO TO 120
  74       C(1,1) = SN*CH(1)
  75       DO 118 J=2,NL,2
  76          C(1,J) = TSN*CH(J)
  77          C(1,J+1) = TSNM*CH(J+1)
  78   118 CONTINUE
  79       IF(MODN .NE. 0) RETURN
  80       C(1,N) = SN*CH(N)
  81       RETURN
  82   120 C(1,1) = SN*C(1,1)
  83       DO 122 J=2,NL,2
  84          C(1,J) = TSN*C(1,J)
  85          C(1,J+1) = TSNM*C(1,J+1)
  86   122 CONTINUE
  87       IF(MODN .NE. 0) RETURN
  88       C(1,N) = SN*C(1,N)
  89       RETURN
  90       END