c1fm1f.f 1.52 KB
Newer Older
rtoy's avatar
rtoy committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C   FFTPACK 5.0 
C
C   Authors:  Paul N. Swarztrauber and Richard A. Valent
C
C   $Id$
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      SUBROUTINE C1FM1F (N,INC,C,CH,WA,FNF,FAC)
      COMPLEX       C(*)
      REAL       CH(*),     WA(*),      FAC(*)
C
C FFTPACK 5.0 auxiliary routine
C
      INC2 = INC+INC
      NF = FNF
      NA = 0
      L1 = 1
      IW = 1
      DO 125 K1=1,NF
         IP = FAC(K1)
         L2 = IP*L1
         IDO = N/L2
         LID = L1*IDO
         NBR = 1+NA+2*MIN(IP-2,4)
c         write(*,*) wa(iw),wa(iw+1)
         GO TO (52,62,53,63,54,64,55,65,56,66),NBR
   52    CALL C1F2KF (IDO,L1,NA,C,INC2,CH,2,WA(IW))
         GO TO 120
   62    CALL C1F2KF (IDO,L1,NA,CH,2,C,INC2,WA(IW))
         GO TO 120
   53    CALL C1F3KF (IDO,L1,NA,C,INC2,CH,2,WA(IW))
         GO TO 120
   63    CALL C1F3KF (IDO,L1,NA,CH,2,C,INC2,WA(IW))
         GO TO 120
   54    CALL C1F4KF (IDO,L1,NA,C,INC2,CH,2,WA(IW))
         GO TO 120
   64    CALL C1F4KF (IDO,L1,NA,CH,2,C,INC2,WA(IW))
         GO TO 120
   55    CALL C1F5KF (IDO,L1,NA,C,INC2,CH,2,WA(IW))
         GO TO 120
   65    CALL C1F5KF (IDO,L1,NA,CH,2,C,INC2,WA(IW))
         GO TO 120
   56    CALL C1FGKF (IDO,IP,L1,LID,NA,C,C,INC2,CH,CH,
Raymond Toy's avatar
Raymond Toy committed
47
     1     2,WA(IW))
rtoy's avatar
rtoy committed
48
49
50
51
52
53
54
55
56
         GO TO 120
   66    CALL C1FGKF (IDO,IP,L1,LID,NA,CH,CH,2,C,C,
     1     INC2,WA(IW))
  120    L1 = L2
         IW = IW+(IP-1)*(IDO+IDO)
         IF(IP .LE. 5) NA = 1-NA
  125 CONTINUE
      RETURN
      END