Context Navigation

cmfgkf.F

Last change on this file was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 6.5 KB

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

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

Download in other formats:

Original Format