RFTI1M.inc

1 C***********************************************************************
2       SUBROUTINE RFTI1M (N, WA,IFAC)
3       DIMENSION       WA(N)      ,IFAC(*)    ,NTRYH(4)
4       REAL*8 ARG, ARGLD, ARGH, TPI
5       DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4) /4,2,3,5/
6       DATA TPI /6.283185307179590/
7           NL = N
8           NF = 0
9           J = 0
10   101     J = J+1
11       IF (J .LE. 4) THEN
12           NTRY = NTRYH(J)
13       ELSE
14           NTRY = NTRY+2
15       ENDIF
16   104     NQ = NL/NTRY
17           NR = NL-NTRY*NQ
18       IF (NR .NE. 0) GO TO 101
19           NF = NF+1
20           IFAC(NF+2) = NTRY
21           NL = NQ
22       IF (NTRY .NE. 2) GO TO 107
23       IF (NF   .EQ. 1) GO TO 107
24 *VOPTION NOFVAL
25         DO 106 I=2,NF
26           IB = NF-I+2
27           IFAC(IB+2) = IFAC(IB+1)
28   106   CONTINUE
29           IFAC(3) = 2
30   107 IF (NL .NE. 1) GO TO 104
31           IFAC(1) = N
32           IFAC(2) = NF
33           ARGH = TPI/N
34           IS = 0
35           NFM1 = NF-1
36           L1 = 1
37       IF (NFM1 .EQ. 0) RETURN
38       DO 110 K1=1,NFM1
39           IP = IFAC(K1+2)
40           LD = 0
41           L2 = L1*IP
42           IDO = N/L2
43           IPM = IP-1
44         DO 109 J=1,IPM
45             LD = LD+L1
46             ARGLD = LD*ARGH
47             IDOX = (IDO-1)/2
48 *VOPTION NOFVAL
49           DO 108 IFI=1,IDOX
50                ARG = IFI*ARGLD
51                WA(2*IFI+IS-1) = COS(ARG)
52                WA(2*IFI+IS  ) = SIN(ARG)
53   108     CONTINUE
54             IS = IS+IDO
55   109   CONTINUE
56           L1 = L2
57   110 CONTINUE
58       RETURN
59       END SUBROUTINE RFTI1M
60