| blob | 9115da458c486b3e781eb8c8ff7a12e082b79e22 |
1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2 !
3 ! FFTPACK 5.0
4 !
5 ! Authors: Paul N. Swarztrauber and Richard A. Valent
6 !
7 ! $Id: c1fgkf.f,v 1.2 2004/06/15 21:08:32 rodney Exp $
8 !
9 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
11 SUBROUTINE C1FGKF (IDO,IP,L1,LID,NA,CC,CC1,IN1, &
12 & CH,CH1,IN2,WA)
13 REAL CH(IN2,L1,IDO,IP) ,CC(IN1,L1,IP,IDO), &
14 & CC1(IN1,LID,IP) ,CH1(IN2,LID,IP) , &
15 & WA(IDO,IP-1,2)
16 !
17 ! FFTPACK 5.0 auxiliary routine
18 !
19 IPP2 = IP+2
20 IPPH = (IP+1)/2
21 DO 110 KI=1,LID
22 CH1(1,KI,1) = CC1(1,KI,1)
23 CH1(2,KI,1) = CC1(2,KI,1)
24 110 END DO
25 DO 111 J=2,IPPH
26 JC = IPP2-J
27 DO 112 KI=1,LID
28 CH1(1,KI,J) = CC1(1,KI,J)+CC1(1,KI,JC)
29 CH1(1,KI,JC) = CC1(1,KI,J)-CC1(1,KI,JC)
30 CH1(2,KI,J) = CC1(2,KI,J)+CC1(2,KI,JC)
31 CH1(2,KI,JC) = CC1(2,KI,J)-CC1(2,KI,JC)
32 112 CONTINUE
33 111 END DO
34 DO 118 J=2,IPPH
35 DO 117 KI=1,LID
36 CC1(1,KI,1) = CC1(1,KI,1)+CH1(1,KI,J)
37 CC1(2,KI,1) = CC1(2,KI,1)+CH1(2,KI,J)
38 117 CONTINUE
39 118 END DO
40 DO 116 L=2,IPPH
41 LC = IPP2-L
42 DO 113 KI=1,LID
43 CC1(1,KI,L) = CH1(1,KI,1)+WA(1,L-1,1)*CH1(1,KI,2)
44 CC1(1,KI,LC) = -WA(1,L-1,2)*CH1(1,KI,IP)
45 CC1(2,KI,L) = CH1(2,KI,1)+WA(1,L-1,1)*CH1(2,KI,2)
46 CC1(2,KI,LC) = -WA(1,L-1,2)*CH1(2,KI,IP)
47 113 CONTINUE
48 DO 115 J=3,IPPH
49 JC = IPP2-J
50 IDLJ = MOD((L-1)*(J-1),IP)
51 WAR = WA(1,IDLJ,1)
52 WAI = -WA(1,IDLJ,2)
53 DO 114 KI=1,LID
54 CC1(1,KI,L) = CC1(1,KI,L)+WAR*CH1(1,KI,J)
55 CC1(1,KI,LC) = CC1(1,KI,LC)+WAI*CH1(1,KI,JC)
56 CC1(2,KI,L) = CC1(2,KI,L)+WAR*CH1(2,KI,J)
57 CC1(2,KI,LC) = CC1(2,KI,LC)+WAI*CH1(2,KI,JC)
58 114 CONTINUE
59 115 CONTINUE
60 116 END DO
61 IF (IDO .GT. 1) GO TO 136
62 SN = 1./REAL(IP*L1)
63 IF (NA .EQ. 1) GO TO 146
64 DO 149 KI=1,LID
65 CC1(1,KI,1) = SN*CC1(1,KI,1)
66 CC1(2,KI,1) = SN*CC1(2,KI,1)
67 149 END DO
68 DO 120 J=2,IPPH
69 JC = IPP2-J
70 DO 119 KI=1,LID
71 CHOLD1 = SN*(CC1(1,KI,J)-CC1(2,KI,JC))
72 CHOLD2 = SN*(CC1(1,KI,J)+CC1(2,KI,JC))
73 CC1(1,KI,J) = CHOLD1
74 CC1(2,KI,JC) = SN*(CC1(2,KI,J)-CC1(1,KI,JC))
75 CC1(2,KI,J) = SN*(CC1(2,KI,J)+CC1(1,KI,JC))
76 CC1(1,KI,JC) = CHOLD2
77 119 CONTINUE
78 120 END DO
79 RETURN
80 146 DO 147 KI=1,LID
81 CH1(1,KI,1) = SN*CC1(1,KI,1)
82 CH1(2,KI,1) = SN*CC1(2,KI,1)
83 147 END DO
84 DO 145 J=2,IPPH
85 JC = IPP2-J
86 DO 144 KI=1,LID
87 CH1(1,KI,J) = SN*(CC1(1,KI,J)-CC1(2,KI,JC))
88 CH1(2,KI,J) = SN*(CC1(2,KI,J)+CC1(1,KI,JC))
89 CH1(1,KI,JC) = SN*(CC1(1,KI,J)+CC1(2,KI,JC))
90 CH1(2,KI,JC) = SN*(CC1(2,KI,J)-CC1(1,KI,JC))
91 144 CONTINUE
92 145 END DO
93 RETURN
94 136 DO 137 KI=1,LID
95 CH1(1,KI,1) = CC1(1,KI,1)
96 CH1(2,KI,1) = CC1(2,KI,1)
97 137 END DO
98 DO 135 J=2,IPPH
99 JC = IPP2-J
100 DO 134 KI=1,LID
101 CH1(1,KI,J) = CC1(1,KI,J)-CC1(2,KI,JC)
102 CH1(2,KI,J) = CC1(2,KI,J)+CC1(1,KI,JC)
103 CH1(1,KI,JC) = CC1(1,KI,J)+CC1(2,KI,JC)
104 CH1(2,KI,JC) = CC1(2,KI,J)-CC1(1,KI,JC)
105 134 CONTINUE
106 135 END DO
107 DO 131 I=1,IDO
108 DO 130 K=1,L1
109 CC(1,K,1,I) = CH(1,K,I,1)
110 CC(2,K,1,I) = CH(2,K,I,1)
111 130 CONTINUE
112 131 END DO
113 DO 123 J=2,IP
114 DO 122 K=1,L1
115 CC(1,K,J,1) = CH(1,K,1,J)
116 CC(2,K,J,1) = CH(2,K,1,J)
117 122 CONTINUE
118 123 END DO
119 DO 126 J=2,IP
120 DO 125 I=2,IDO
121 DO 124 K=1,L1
122 CC(1,K,J,I) = WA(I,J-1,1)*CH(1,K,I,J) &
123 & +WA(I,J-1,2)*CH(2,K,I,J)
124 CC(2,K,J,I) = WA(I,J-1,1)*CH(2,K,I,J) &
125 & -WA(I,J-1,2)*CH(1,K,I,J)
126 124 CONTINUE
127 125 CONTINUE
128 126 END DO
129 RETURN
130 END