1 |
C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_swapffields.F,v 1.5 2007/04/16 23:27:21 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "EXF_OPTIONS.h" |
5 |
|
6 |
|
7 |
subroutine exf_SwapFFields( |
8 |
U ffld0, |
9 |
U ffld1, |
10 |
I mythid |
11 |
& ) |
12 |
|
13 |
c ================================================================== |
14 |
c SUBROUTINE exf_SwapFFields |
15 |
c ================================================================== |
16 |
c |
17 |
c o Copy a forcing field ffld1 to ffld0 and set ffld0 to zero. |
18 |
c |
19 |
c started: Christian Eckert eckert@mit.edu 30-Jun-1999 |
20 |
c |
21 |
c changed: Christian Eckert eckert@mit.edu 14-Jan-2000 |
22 |
c |
23 |
c - Restructured the code in order to create a package |
24 |
c for the MITgcmUV. |
25 |
c |
26 |
c Christian Eckert eckert@mit.edu 12-Feb-2000 |
27 |
c |
28 |
c - Changed Routine names (package prefix: exf_) |
29 |
c |
30 |
c ================================================================== |
31 |
c SUBROUTINE exf_SwapFFields |
32 |
c ================================================================== |
33 |
|
34 |
implicit none |
35 |
|
36 |
c == global variables == |
37 |
|
38 |
#include "EEPARAMS.h" |
39 |
#include "SIZE.h" |
40 |
|
41 |
c == routine arguments == |
42 |
|
43 |
integer mythid |
44 |
_RL ffld0(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
45 |
_RL ffld1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
46 |
|
47 |
c == local variables == |
48 |
|
49 |
integer bi |
50 |
integer bj |
51 |
integer i |
52 |
integer j |
53 |
integer itlo,ithi |
54 |
integer jtlo,jthi |
55 |
|
56 |
c == end of interface == |
57 |
|
58 |
jtlo = mybylo(mythid) |
59 |
jthi = mybyhi(mythid) |
60 |
itlo = mybxlo(mythid) |
61 |
ithi = mybxhi(mythid) |
62 |
|
63 |
do bj = jtlo,jthi |
64 |
do bi = itlo,ithi |
65 |
do j = 1,sny |
66 |
do i = 1,snx |
67 |
ffld0(i,j,bi,bj) = ffld1(i,j,bi,bj) |
68 |
ffld1(i,j,bi,bj) = 0. _d 0 |
69 |
enddo |
70 |
enddo |
71 |
enddo |
72 |
enddo |
73 |
|
74 |
end |
75 |
|
76 |
subroutine exf_SwapFFields_3d( |
77 |
U ffld0, |
78 |
U ffld1, |
79 |
I mythid |
80 |
& ) |
81 |
|
82 |
c ================================================================== |
83 |
c SUBROUTINE exf_SwapFFields_3d |
84 |
c ================================================================== |
85 |
c |
86 |
c o Copy a forcing field ffld1 to ffld0 and set ffld0 to zero. |
87 |
c |
88 |
c ================================================================== |
89 |
c SUBROUTINE exf_SwapFFields |
90 |
c ================================================================== |
91 |
|
92 |
implicit none |
93 |
|
94 |
c == global variables == |
95 |
|
96 |
#include "EEPARAMS.h" |
97 |
#include "SIZE.h" |
98 |
|
99 |
c == routine arguments == |
100 |
|
101 |
integer mythid |
102 |
_RL ffld0(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
103 |
_RL ffld1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
104 |
|
105 |
c == local variables == |
106 |
|
107 |
integer bi |
108 |
integer bj |
109 |
integer i |
110 |
integer j |
111 |
integer k |
112 |
integer itlo,ithi |
113 |
integer jtlo,jthi |
114 |
|
115 |
c == end of interface == |
116 |
|
117 |
jtlo = mybylo(mythid) |
118 |
jthi = mybyhi(mythid) |
119 |
itlo = mybxlo(mythid) |
120 |
ithi = mybxhi(mythid) |
121 |
|
122 |
do bj = jtlo,jthi |
123 |
do bi = itlo,ithi |
124 |
do k = 1,nr |
125 |
do j = 1,sny |
126 |
do i = 1,snx |
127 |
ffld0(i,j,k,bi,bj) = ffld1(i,j,k,bi,bj) |
128 |
ffld1(i,j,k,bi,bj) = 0. _d 0 |
129 |
enddo |
130 |
enddo |
131 |
enddo |
132 |
enddo |
133 |
enddo |
134 |
|
135 |
end |
136 |
|
137 |
subroutine exf_swapffields_xz( |
138 |
U ffld0, |
139 |
U ffld1, |
140 |
I mythid |
141 |
& ) |
142 |
|
143 |
c ================================================================== |
144 |
c SUBROUTINE exf_swapffields_xz |
145 |
c ================================================================== |
146 |
c |
147 |
c o Copy a forcing field ffld1 to ffld0 and set ffld0 to zero. |
148 |
c |
149 |
c started: heimbach@mit.edu 01-May-2001 |
150 |
c |
151 |
c ================================================================== |
152 |
c SUBROUTINE exf_swapffields_xz |
153 |
c ================================================================== |
154 |
|
155 |
implicit none |
156 |
|
157 |
c == global variables == |
158 |
|
159 |
#include "EEPARAMS.h" |
160 |
#include "SIZE.h" |
161 |
|
162 |
c == routine arguments == |
163 |
|
164 |
integer mythid |
165 |
_RL ffld0(1-olx:snx+olx,Nr,nsx,nsy) |
166 |
_RL ffld1(1-olx:snx+olx,Nr,nsx,nsy) |
167 |
|
168 |
c == local variables == |
169 |
|
170 |
integer bi, bj |
171 |
integer i, k |
172 |
integer itlo,ithi |
173 |
integer jtlo,jthi |
174 |
|
175 |
c == end of interface == |
176 |
|
177 |
jtlo = mybylo(mythid) |
178 |
jthi = mybyhi(mythid) |
179 |
itlo = mybxlo(mythid) |
180 |
ithi = mybxhi(mythid) |
181 |
|
182 |
do bj = jtlo,jthi |
183 |
do bi = itlo,ithi |
184 |
do k = 1,Nr |
185 |
do i = 1,snx |
186 |
ffld0(i,k,bi,bj) = ffld1(i,k,bi,bj) |
187 |
ffld1(i,k,bi,bj) = 0. _d 0 |
188 |
enddo |
189 |
enddo |
190 |
enddo |
191 |
enddo |
192 |
|
193 |
end |
194 |
|
195 |
subroutine exf_swapffields_yz( |
196 |
U ffld0, |
197 |
U ffld1, |
198 |
I mythid |
199 |
& ) |
200 |
|
201 |
c ================================================================== |
202 |
c SUBROUTINE exf_swapffields_yz |
203 |
c ================================================================== |
204 |
c |
205 |
c o Copy a forcing field ffld1 to ffld0 and set ffld0 to zero. |
206 |
c |
207 |
c started: heimbach@mit.edu 01-May-2001 |
208 |
c |
209 |
c ================================================================== |
210 |
c SUBROUTINE exf_swapffields_yz |
211 |
c ================================================================== |
212 |
|
213 |
implicit none |
214 |
|
215 |
c == global variables == |
216 |
|
217 |
#include "EEPARAMS.h" |
218 |
#include "SIZE.h" |
219 |
|
220 |
c == routine arguments == |
221 |
|
222 |
integer mythid |
223 |
_RL ffld0(1-oly:sny+oly,Nr,nsx,nsy) |
224 |
_RL ffld1(1-oly:sny+oly,Nr,nsx,nsy) |
225 |
|
226 |
c == local variables == |
227 |
|
228 |
integer bi, bj |
229 |
integer j, k |
230 |
integer itlo,ithi |
231 |
integer jtlo,jthi |
232 |
|
233 |
c == end of interface == |
234 |
|
235 |
jtlo = mybylo(mythid) |
236 |
jthi = mybyhi(mythid) |
237 |
itlo = mybxlo(mythid) |
238 |
ithi = mybxhi(mythid) |
239 |
|
240 |
do bj = jtlo,jthi |
241 |
do bi = itlo,ithi |
242 |
do k = 1,Nr |
243 |
do j = 1,sny |
244 |
ffld0(j,k,bi,bj) = ffld1(j,k,bi,bj) |
245 |
ffld1(j,k,bi,bj) = 0. _d 0 |
246 |
enddo |
247 |
enddo |
248 |
enddo |
249 |
enddo |
250 |
|
251 |
end |
252 |
|
253 |
subroutine exf_swapffields_x( |
254 |
U ffld0, |
255 |
U ffld1, |
256 |
I mythid |
257 |
& ) |
258 |
|
259 |
c ================================================================== |
260 |
c SUBROUTINE exf_swapffields_x |
261 |
c ================================================================== |
262 |
c |
263 |
c o Copy a forcing field ffld1 to ffld0 and set ffld0 to zero. |
264 |
c same as exf_swapffields_xz but for NR=1 |
265 |
c |
266 |
c ================================================================== |
267 |
c SUBROUTINE exf_swapffields_x |
268 |
c ================================================================== |
269 |
|
270 |
implicit none |
271 |
|
272 |
c == global variables == |
273 |
|
274 |
#include "EEPARAMS.h" |
275 |
#include "SIZE.h" |
276 |
|
277 |
c == routine arguments == |
278 |
|
279 |
integer mythid |
280 |
_RL ffld0(1-olx:snx+olx,nsx,nsy) |
281 |
_RL ffld1(1-olx:snx+olx,nsx,nsy) |
282 |
|
283 |
c == local variables == |
284 |
|
285 |
integer bi, bj, i, itlo,ithi, jtlo,jthi |
286 |
|
287 |
c == end of interface == |
288 |
|
289 |
jtlo = mybylo(mythid) |
290 |
jthi = mybyhi(mythid) |
291 |
itlo = mybxlo(mythid) |
292 |
ithi = mybxhi(mythid) |
293 |
|
294 |
do bj = jtlo,jthi |
295 |
do bi = itlo,ithi |
296 |
do i = 1,snx |
297 |
ffld0(i,bi,bj) = ffld1(i,bi,bj) |
298 |
ffld1(i,bi,bj) = 0. _d 0 |
299 |
enddo |
300 |
enddo |
301 |
enddo |
302 |
|
303 |
end |
304 |
|
305 |
subroutine exf_swapffields_y( |
306 |
U ffld0, |
307 |
U ffld1, |
308 |
I mythid |
309 |
& ) |
310 |
|
311 |
c ================================================================== |
312 |
c SUBROUTINE exf_swapffields_y |
313 |
c ================================================================== |
314 |
c |
315 |
c o Copy a forcing field ffld1 to ffld0 and set ffld0 to zero. |
316 |
c same as exf_swapffields_yz but for NR=1 |
317 |
c |
318 |
c ================================================================== |
319 |
c SUBROUTINE exf_swapffields_y |
320 |
c ================================================================== |
321 |
|
322 |
implicit none |
323 |
|
324 |
c == global variables == |
325 |
|
326 |
#include "EEPARAMS.h" |
327 |
#include "SIZE.h" |
328 |
|
329 |
c == routine arguments == |
330 |
|
331 |
integer mythid |
332 |
_RL ffld0(1-oly:sny+oly,nsx,nsy) |
333 |
_RL ffld1(1-oly:sny+oly,nsx,nsy) |
334 |
|
335 |
c == local variables == |
336 |
|
337 |
integer bi, bj, j, itlo,ithi, jtlo,jthi |
338 |
|
339 |
c == end of interface == |
340 |
|
341 |
jtlo = mybylo(mythid) |
342 |
jthi = mybyhi(mythid) |
343 |
itlo = mybxlo(mythid) |
344 |
ithi = mybxhi(mythid) |
345 |
|
346 |
do bj = jtlo,jthi |
347 |
do bi = itlo,ithi |
348 |
do j = 1,sny |
349 |
ffld0(j,bi,bj) = ffld1(j,bi,bj) |
350 |
ffld1(j,bi,bj) = 0. _d 0 |
351 |
enddo |
352 |
enddo |
353 |
enddo |
354 |
|
355 |
end |