Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mradfg.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: 8.0 KB

Line
1	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2	!
3	! FFTPACK 5.0
4	!
5	! Authors: Paul N. Swarztrauber and Richard A. Valent
6	!
7	! $Id: mradfg.f,v 1.2 2004/06/15 21:29:20 rodney Exp $
8	!
9	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10
11	SUBROUTINE MRADFG (M,IDO,IP,L1,IDL1,CC,C1,C2,IM1,IN1, &
12	& CH,CH2,IM2,IN2,WA)
13	REAL CH(IN2,IDO,L1,IP) ,CC(IN1,IDO,IP,L1), &
14	& C1(IN1,IDO,L1,IP) ,C2(IN1,IDL1,IP), &
15	& CH2(IN2,IDL1,IP) ,WA(IDO)
16	!
17	M1D = (M-1)*IM1+1
18	M2S = 1-IM2
19	TPI=2.4.ATAN(1.0)
20	ARG = TPI/FLOAT(IP)
21	DCP = COS(ARG)
22	DSP = SIN(ARG)
23	IPPH = (IP+1)/2
24	IPP2 = IP+2
25	IDP2 = IDO+2
26	NBD = (IDO-1)/2
27	IF (IDO .EQ. 1) GO TO 119
28	DO 101 IK=1,IDL1
29	M2 = M2S
30	DO 1001 M1=1,M1D,IM1
31	M2 = M2+IM2
32	CH2(M2,IK,1) = C2(M1,IK,1)
33	1001 CONTINUE
34	101 END DO
35	DO 103 J=2,IP
36	DO 102 K=1,L1
37	M2 = M2S
38	DO 1002 M1=1,M1D,IM1
39	M2 = M2+IM2
40	CH(M2,1,K,J) = C1(M1,1,K,J)
41	1002 CONTINUE
42	102 CONTINUE
43	103 END DO
44	IF (NBD .GT. L1) GO TO 107
45	IS = -IDO
46	DO 106 J=2,IP
47	IS = IS+IDO
48	IDIJ = IS
49	DO 105 I=3,IDO,2
50	IDIJ = IDIJ+2
51	DO 104 K=1,L1
52	M2 = M2S
53	DO 1004 M1=1,M1D,IM1
54	M2 = M2+IM2
55	CH(M2,I-1,K,J) = WA(IDIJ-1)*C1(M1,I-1,K,J)+WA(IDIJ) &
56	& *C1(M1,I,K,J)
57	CH(M2,I,K,J) = WA(IDIJ-1)*C1(M1,I,K,J)-WA(IDIJ) &
58	& *C1(M1,I-1,K,J)
59	1004 CONTINUE
60	104 CONTINUE
61	105 CONTINUE
62	106 END DO
63	GO TO 111
64	107 IS = -IDO
65	DO 110 J=2,IP
66	IS = IS+IDO
67	DO 109 K=1,L1
68	IDIJ = IS
69	DO 108 I=3,IDO,2
70	IDIJ = IDIJ+2
71	M2 = M2S
72	DO 1008 M1=1,M1D,IM1
73	M2 = M2+IM2
74	CH(M2,I-1,K,J) = WA(IDIJ-1)*C1(M1,I-1,K,J)+WA(IDIJ) &
75	& *C1(M1,I,K,J)
76	CH(M2,I,K,J) = WA(IDIJ-1)*C1(M1,I,K,J)-WA(IDIJ) &
77	& *C1(M1,I-1,K,J)
78	1008 CONTINUE
79	108 CONTINUE
80	109 CONTINUE
81	110 END DO
82	111 IF (NBD .LT. L1) GO TO 115
83	DO 114 J=2,IPPH
84	JC = IPP2-J
85	DO 113 K=1,L1
86	DO 112 I=3,IDO,2
87	M2 = M2S
88	DO 1012 M1=1,M1D,IM1
89	M2 = M2+IM2
90	C1(M1,I-1,K,J) = CH(M2,I-1,K,J)+CH(M2,I-1,K,JC)
91	C1(M1,I-1,K,JC) = CH(M2,I,K,J)-CH(M2,I,K,JC)
92	C1(M1,I,K,J) = CH(M2,I,K,J)+CH(M2,I,K,JC)
93	C1(M1,I,K,JC) = CH(M2,I-1,K,JC)-CH(M2,I-1,K,J)
94	1012 CONTINUE
95	112 CONTINUE
96	113 CONTINUE
97	114 END DO
98	GO TO 121
99	115 DO 118 J=2,IPPH
100	JC = IPP2-J
101	DO 117 I=3,IDO,2
102	DO 116 K=1,L1
103	M2 = M2S
104	DO 1016 M1=1,M1D,IM1
105	M2 = M2+IM2
106	C1(M1,I-1,K,J) = CH(M2,I-1,K,J)+CH(M2,I-1,K,JC)
107	C1(M1,I-1,K,JC) = CH(M2,I,K,J)-CH(M2,I,K,JC)
108	C1(M1,I,K,J) = CH(M2,I,K,J)+CH(M2,I,K,JC)
109	C1(M1,I,K,JC) = CH(M2,I-1,K,JC)-CH(M2,I-1,K,J)
110	1016 CONTINUE
111	116 CONTINUE
112	117 CONTINUE
113	118 END DO
114	GO TO 121
115	119 DO 120 IK=1,IDL1
116	M2 = M2S
117	DO 1020 M1=1,M1D,IM1
118	M2 = M2+IM2
119	C2(M1,IK,1) = CH2(M2,IK,1)
120	1020 CONTINUE
121	120 END DO
122	121 DO 123 J=2,IPPH
123	JC = IPP2-J
124	DO 122 K=1,L1
125	M2 = M2S
126	DO 1022 M1=1,M1D,IM1
127	M2 = M2+IM2
128	C1(M1,1,K,J) = CH(M2,1,K,J)+CH(M2,1,K,JC)
129	C1(M1,1,K,JC) = CH(M2,1,K,JC)-CH(M2,1,K,J)
130	1022 CONTINUE
131	122 CONTINUE
132	123 END DO
133	!
134	AR1 = 1.
135	AI1 = 0.
136	DO 127 L=2,IPPH
137	LC = IPP2-L
138	AR1H = DCPAR1-DSPAI1
139	AI1 = DCPAI1+DSPAR1
140	AR1 = AR1H
141	DO 124 IK=1,IDL1
142	M2 = M2S
143	DO 1024 M1=1,M1D,IM1
144	M2 = M2+IM2
145	CH2(M2,IK,L) = C2(M1,IK,1)+AR1*C2(M1,IK,2)
146	CH2(M2,IK,LC) = AI1*C2(M1,IK,IP)
147	1024 CONTINUE
148	124 CONTINUE
149	DC2 = AR1
150	DS2 = AI1
151	AR2 = AR1
152	AI2 = AI1
153	DO 126 J=3,IPPH
154	JC = IPP2-J
155	AR2H = DC2AR2-DS2AI2
156	AI2 = DC2AI2+DS2AR2
157	AR2 = AR2H
158	DO 125 IK=1,IDL1
159	M2 = M2S
160	DO 1025 M1=1,M1D,IM1
161	M2 = M2+IM2
162	CH2(M2,IK,L) = CH2(M2,IK,L)+AR2*C2(M1,IK,J)
163	CH2(M2,IK,LC) = CH2(M2,IK,LC)+AI2*C2(M1,IK,JC)
164	1025 CONTINUE
165	125 CONTINUE
166	126 CONTINUE
167	127 END DO
168	DO 129 J=2,IPPH
169	DO 128 IK=1,IDL1
170	M2 = M2S
171	DO 1028 M1=1,M1D,IM1
172	M2 = M2+IM2
173	CH2(M2,IK,1) = CH2(M2,IK,1)+C2(M1,IK,J)
174	1028 CONTINUE
175	128 CONTINUE
176	129 END DO
177	!
178	IF (IDO .LT. L1) GO TO 132
179	DO 131 K=1,L1
180	DO 130 I=1,IDO
181	M2 = M2S
182	DO 1030 M1=1,M1D,IM1
183	M2 = M2+IM2
184	CC(M1,I,1,K) = CH(M2,I,K,1)
185	1030 CONTINUE
186	130 CONTINUE
187	131 END DO
188	GO TO 135
189	132 DO 134 I=1,IDO
190	DO 133 K=1,L1
191	M2 = M2S
192	DO 1033 M1=1,M1D,IM1
193	M2 = M2+IM2
194	CC(M1,I,1,K) = CH(M2,I,K,1)
195	1033 CONTINUE
196	133 CONTINUE
197	134 END DO
198	135 DO 137 J=2,IPPH
199	JC = IPP2-J
200	J2 = J+J
201	DO 136 K=1,L1
202	M2 = M2S
203	DO 1036 M1=1,M1D,IM1
204	M2 = M2+IM2
205	CC(M1,IDO,J2-2,K) = CH(M2,1,K,J)
206	CC(M1,1,J2-1,K) = CH(M2,1,K,JC)
207	1036 CONTINUE
208	136 CONTINUE
209	137 END DO
210	IF (IDO .EQ. 1) RETURN
211	IF (NBD .LT. L1) GO TO 141
212	DO 140 J=2,IPPH
213	JC = IPP2-J
214	J2 = J+J
215	DO 139 K=1,L1
216	DO 138 I=3,IDO,2
217	IC = IDP2-I
218	M2 = M2S
219	DO 1038 M1=1,M1D,IM1
220	M2 = M2+IM2
221	CC(M1,I-1,J2-1,K) = CH(M2,I-1,K,J)+CH(M2,I-1,K,JC)
222	CC(M1,IC-1,J2-2,K) = CH(M2,I-1,K,J)-CH(M2,I-1,K,JC)
223	CC(M1,I,J2-1,K) = CH(M2,I,K,J)+CH(M2,I,K,JC)
224	CC(M1,IC,J2-2,K) = CH(M2,I,K,JC)-CH(M2,I,K,J)
225	1038 CONTINUE
226	138 CONTINUE
227	139 CONTINUE
228	140 END DO
229	RETURN
230	141 DO 144 J=2,IPPH
231	JC = IPP2-J
232	J2 = J+J
233	DO 143 I=3,IDO,2
234	IC = IDP2-I
235	DO 142 K=1,L1
236	M2 = M2S
237	DO 1042 M1=1,M1D,IM1
238	M2 = M2+IM2
239	CC(M1,I-1,J2-1,K) = CH(M2,I-1,K,J)+CH(M2,I-1,K,JC)
240	CC(M1,IC-1,J2-2,K) = CH(M2,I-1,K,J)-CH(M2,I-1,K,JC)
241	CC(M1,I,J2-1,K) = CH(M2,I,K,J)+CH(M2,I,K,JC)
242	CC(M1,IC,J2-2,K) = CH(M2,I,K,JC)-CH(M2,I,K,J)
243	1042 CONTINUE
244	142 CONTINUE
245	143 CONTINUE
246	144 END DO
247	RETURN
248	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format