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