wrfv2_fire/external/fftpack/fftpack5/rffti1.F

   1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 !
   3 !   FFTPACK 5.0
   4 !
   5 !   Authors:  Paul N. Swarztrauber and Richard A. Valent
   6 !
   7 !   $Id: rffti1.f,v 1.2 2004/06/15 21:29:20 rodney Exp $
   8 !
   9 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  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 !
  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 END DO
  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 END DO
  69       RETURN
  70       END