share/fftpack5/fortran/rffti1.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 RFFTI1 (N,WA,FAC)
  12       REAL       WA(N)      ,FAC(15)
  13       INTEGER    NTRYH(4)
  14       DOUBLE PRECISION TPI,ARGH,ARGLD,ARG
  15       DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
  16 C
  17       NL = N
  18       NF = 0
  19       J = 0
  20   101 J = J+1
  21       IF (J-4) 102,102,103
  22   102 NTRY = NTRYH(J)
  23       GO TO 104
  24   103 NTRY = NTRY+2
  25   104 NQ = NL/NTRY
  26       NR = NL-NTRY*NQ
  27       IF (NR) 101,105,101
  28   105 NF = NF+1
  29       FAC(NF+2) = NTRY
  30       NL = NQ
  31       IF (NTRY .NE. 2) GO TO 107
  32       IF (NF .EQ. 1) GO TO 107
  33       DO 106 I=2,NF
  34          IB = NF-I+2
  35          FAC(IB+2) = FAC(IB+1)
  36   106 CONTINUE
  37       FAC(3) = 2
  38   107 IF (NL .NE. 1) GO TO 104
  39       FAC(1) = N
  40       FAC(2) = NF
  41       TPI = 8.D0*DATAN(1.D0)
  42       ARGH = TPI/FLOAT(N)
  43       IS = 0
  44       NFM1 = NF-1
  45       L1 = 1
  46       IF (NFM1 .EQ. 0) RETURN
  47       DO 110 K1=1,NFM1
  48          IP = FAC(K1+2)
  49          LD = 0
  50          L2 = L1*IP
  51          IDO = N/L2
  52          IPM = IP-1
  53          DO 109 J=1,IPM
  54             LD = LD+L1
  55             I = IS
  56             ARGLD = FLOAT(LD)*ARGH
  57             FI = 0.
  58             DO 108 II=3,IDO,2
  59                I = I+2
  60                FI = FI+1.
  61                ARG = FI*ARGLD
  62                WA(I-1) = DCOS(ARG)
  63                WA(I) = DSIN(ARG)
  64   108       CONTINUE
  65             IS = IS+IDO
  66   109    CONTINUE
  67          L1 = L2
  68   110 CONTINUE
  69       RETURN
  70       END