source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/cmfgkf.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 6.3 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: cmfgkf.f,v 1.2 2004/06/15 21:08:32 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE CMFGKF (LOT,IDO,IP,L1,LID,NA,CC,CC1,IM1,IN1,           &
12     &                                      CH,CH1,IM2,IN2,WA)         
13      REAL       CH(2,IN2,L1,IDO,IP) ,CC(2,IN1,L1,IP,IDO),              &
14     &                CC1(2,IN1,LID,IP)    ,CH1(2,IN2,LID,IP)  ,        &
15     &                WA(IDO,IP-1,2)                                   
16!                                                                       
17! FFTPACK 5.0 auxiliary routine                                         
18!                                                                       
19      M1D = (LOT-1)*IM1+1
20      M2S = 1-IM2
21      IPP2 = IP+2
22      IPPH = (IP+1)/2
23      DO 110 KI=1,LID
24         M2 = M2S
25         DO 110 M1=1,M1D,IM1
26         M2 = M2+IM2
27         CH1(1,M2,KI,1) = CC1(1,M1,KI,1)
28         CH1(2,M2,KI,1) = CC1(2,M1,KI,1)
29  110 CONTINUE
30      DO 111 J=2,IPPH
31         JC = IPP2-J
32         DO 112 KI=1,LID
33         M2 = M2S
34         DO 112 M1=1,M1D,IM1
35         M2 = M2+IM2
36            CH1(1,M2,KI,J) =  CC1(1,M1,KI,J)+CC1(1,M1,KI,JC)
37            CH1(1,M2,KI,JC) = CC1(1,M1,KI,J)-CC1(1,M1,KI,JC)
38            CH1(2,M2,KI,J) =  CC1(2,M1,KI,J)+CC1(2,M1,KI,JC)
39            CH1(2,M2,KI,JC) = CC1(2,M1,KI,J)-CC1(2,M1,KI,JC)
40  112    CONTINUE
41  111 END DO
42      DO 118 J=2,IPPH
43         DO 117 KI=1,LID
44         M2 = M2S
45         DO 117 M1=1,M1D,IM1
46         M2 = M2+IM2
47            CC1(1,M1,KI,1) = CC1(1,M1,KI,1)+CH1(1,M2,KI,J)
48            CC1(2,M1,KI,1) = CC1(2,M1,KI,1)+CH1(2,M2,KI,J)
49  117    CONTINUE
50  118 END DO
51      DO 116 L=2,IPPH
52         LC = IPP2-L
53         DO 113 KI=1,LID
54         M2 = M2S
55         DO 113 M1=1,M1D,IM1
56         M2 = M2+IM2
57            CC1(1,M1,KI,L) = CH1(1,M2,KI,1)+WA(1,L-1,1)*CH1(1,M2,KI,2)
58            CC1(1,M1,KI,LC) = -WA(1,L-1,2)*CH1(1,M2,KI,IP)
59            CC1(2,M1,KI,L) = CH1(2,M2,KI,1)+WA(1,L-1,1)*CH1(2,M2,KI,2)
60            CC1(2,M1,KI,LC) = -WA(1,L-1,2)*CH1(2,M2,KI,IP)
61  113    CONTINUE
62         DO 115 J=3,IPPH
63            JC = IPP2-J
64            IDLJ = MOD((L-1)*(J-1),IP)
65            WAR = WA(1,IDLJ,1)
66            WAI = -WA(1,IDLJ,2)
67            DO 114 KI=1,LID
68               M2 = M2S
69               DO 114 M1=1,M1D,IM1
70               M2 = M2+IM2
71               CC1(1,M1,KI,L) = CC1(1,M1,KI,L)+WAR*CH1(1,M2,KI,J)
72               CC1(1,M1,KI,LC) = CC1(1,M1,KI,LC)+WAI*CH1(1,M2,KI,JC)
73               CC1(2,M1,KI,L) = CC1(2,M1,KI,L)+WAR*CH1(2,M2,KI,J)
74               CC1(2,M1,KI,LC) = CC1(2,M1,KI,LC)+WAI*CH1(2,M2,KI,JC)
75  114       CONTINUE
76  115    CONTINUE
77  116 END DO
78      IF (IDO .GT. 1) GO TO 136
79      SN = 1./REAL(IP*L1)
80      IF (NA .EQ. 1) GO TO 146
81      DO 149 KI=1,LID
82         M2 = M2S
83         DO 149 M1=1,M1D,IM1
84         M2 = M2+IM2
85         CC1(1,M1,KI,1) = SN*CC1(1,M1,KI,1)
86         CC1(2,M1,KI,1) = SN*CC1(2,M1,KI,1)
87  149 CONTINUE
88      DO 120 J=2,IPPH
89         JC = IPP2-J
90         DO 119 KI=1,LID
91         DO 119 M1=1,M1D,IM1
92            CHOLD1 = SN*(CC1(1,M1,KI,J)-CC1(2,M1,KI,JC))
93            CHOLD2 = SN*(CC1(1,M1,KI,J)+CC1(2,M1,KI,JC))
94            CC1(1,M1,KI,J) = CHOLD1
95            CC1(2,M1,KI,JC) = SN*(CC1(2,M1,KI,J)-CC1(1,M1,KI,JC))
96            CC1(2,M1,KI,J) = SN*(CC1(2,M1,KI,J)+CC1(1,M1,KI,JC))
97            CC1(1,M1,KI,JC) = CHOLD2
98  119    CONTINUE
99  120 END DO
100      RETURN
101  146 DO 147 KI=1,LID
102         M2 = M2S
103         DO 147 M1=1,M1D,IM1
104         M2 = M2+IM2
105         CH1(1,M2,KI,1) = SN*CC1(1,M1,KI,1)
106         CH1(2,M2,KI,1) = SN*CC1(2,M1,KI,1)
107  147 CONTINUE
108      DO 145 J=2,IPPH
109         JC = IPP2-J
110         DO 144 KI=1,LID
111         M2 = M2S
112         DO 144 M1=1,M1D,IM1
113         M2 = M2+IM2
114            CH1(1,M2,KI,J) = SN*(CC1(1,M1,KI,J)-CC1(2,M1,KI,JC))
115            CH1(2,M2,KI,J) = SN*(CC1(2,M1,KI,J)+CC1(1,M1,KI,JC))
116            CH1(1,M2,KI,JC) = SN*(CC1(1,M1,KI,J)+CC1(2,M1,KI,JC))
117            CH1(2,M2,KI,JC) = SN*(CC1(2,M1,KI,J)-CC1(1,M1,KI,JC))
118  144    CONTINUE
119  145 END DO
120      RETURN
121  136 DO 137 KI=1,LID
122         M2 = M2S
123         DO 137 M1=1,M1D,IM1
124         M2 = M2+IM2
125         CH1(1,M2,KI,1) = CC1(1,M1,KI,1)
126         CH1(2,M2,KI,1) = CC1(2,M1,KI,1)
127  137 CONTINUE
128      DO 135 J=2,IPPH
129         JC = IPP2-J
130         DO 134 KI=1,LID
131         M2 = M2S
132         DO 134 M1=1,M1D,IM1
133         M2 = M2+IM2
134            CH1(1,M2,KI,J) = CC1(1,M1,KI,J)-CC1(2,M1,KI,JC)
135            CH1(2,M2,KI,J) = CC1(2,M1,KI,J)+CC1(1,M1,KI,JC)
136            CH1(1,M2,KI,JC) = CC1(1,M1,KI,J)+CC1(2,M1,KI,JC)
137            CH1(2,M2,KI,JC) = CC1(2,M1,KI,J)-CC1(1,M1,KI,JC)
138  134    CONTINUE
139  135 END DO
140      DO 131 I=1,IDO
141         DO 130 K=1,L1
142         M2 = M2S
143         DO 130 M1=1,M1D,IM1
144         M2 = M2+IM2
145            CC(1,M1,K,1,I) = CH(1,M2,K,I,1)
146            CC(2,M1,K,1,I) = CH(2,M2,K,I,1)
147  130    CONTINUE
148  131 END DO
149      DO 123 J=2,IP
150         DO 122 K=1,L1
151         M2 = M2S
152         DO 122 M1=1,M1D,IM1
153         M2 = M2+IM2
154            CC(1,M1,K,J,1) = CH(1,M2,K,1,J)
155            CC(2,M1,K,J,1) = CH(2,M2,K,1,J)
156  122    CONTINUE
157  123 END DO
158      DO 126 J=2,IP
159         DO 125 I=2,IDO
160            DO 124 K=1,L1
161               M2 = M2S
162               DO 124 M1=1,M1D,IM1
163               M2 = M2+IM2
164               CC(1,M1,K,J,I) = WA(I,J-1,1)*CH(1,M2,K,I,J)              &
165     &                      +WA(I,J-1,2)*CH(2,M2,K,I,J)                 
166               CC(2,M1,K,J,I) = WA(I,J-1,1)*CH(2,M2,K,I,J)              &
167     &                      -WA(I,J-1,2)*CH(1,M2,K,I,J)                 
168  124       CONTINUE
169  125    CONTINUE
170  126 END DO
171      RETURN
172      END                                           
Note: See TracBrowser for help on using the repository browser.