/[MITgcm]/MITgcm/pkg/flt/flt_exchg.F
ViewVC logotype

Contents of /MITgcm/pkg/flt/flt_exchg.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (show annotations) (download)
Tue Oct 9 00:04:53 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59k, checkpoint61f, checkpoint59j, checkpoint61e, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a
Changes since 1.2: +95 -92 lines
add missing cvs $Header:$ or $Name:$

1 C $Header: $
2 C $Name: $
3
4 C /u/gcmpack/MITgcm/pkg/flt/flt_exchg.F,v 1.1 2001/09/13 17:43:55 adcroft Exp
5 C checkpoint52h_pre
6
7 #include "FLT_CPPOPTIONS.h"
8
9 subroutine flt_exchg (
10 I myCurrentIter,
11 I myCurrentTime,
12 I myThid
13 & )
14
15 c ==================================================================
16 c SUBROUTINE flt_exchg
17 c ==================================================================
18 c
19 c o Exchange particles between tiles.
20 c
21 c started: Arne Biastoch
22 c
23 c changed: Antti Westerlund antti.westerlund@helsinki.fi 2004.06.10
24 c
25 c ==================================================================
26 c SUBROUTINE flt_exchg
27 c ==================================================================
28
29 c == global variables ==
30
31 #include "SIZE.h"
32 #include "EEPARAMS.h"
33 #include "EESUPPORT.h"
34 #include "EXCH.h"
35 #include "FLT.h"
36 #include "GRID.h"
37 #include "PARAMS.h"
38
39 c == routine arguments ==
40
41 INTEGER myCurrentIter, myThid
42 _RL myCurrentTime
43 INTEGER bi, bj, ic
44 character*(max_len_mbuf) msgbuf
45
46 c == local variables ==
47
48 integer ip
49 integer icountE, icountW, icountN, icountS
50 _RL xx, yy
51 INTEGER imax, imax2, m, iG, jG
52 _RL xlo, xhi, ylo, yhi
53 parameter(imax=9)
54 parameter(imax2=imax*max_npart_exch)
55
56 c buffer for sending/receiving variables (E/W are also used for S/N)
57 _RL fltbuf_sendE(imax2,nSx,nSy)
58 _RL fltbuf_sendW(imax2,nSx,nSy)
59 _RL fltbuf_recvE(imax2,nSx,nSy)
60 _RL fltbuf_recvW(imax2,nSx,nSy)
61
62 _RL npart_dist
63 c == end of interface ==
64
65 caw Check if there are eastern/western tiles
66 if(Nx .ne. sNx) then
67
68 C-- Choose floats that have to exchanged with eastern and western tiles
69 C and pack to arrays
70
71
72 DO bj=myByLo(myThid),myByHi(myThid)
73 DO bi=myBxLo(myThid),myBxHi(myThid)
74
75 c initialize buffers
76
77 do m=1,imax2
78 fltbuf_sendE(m,bi,bj) = 0.
79 fltbuf_sendW(m,bi,bj) = 0.
80 fltbuf_recvE(m,bi,bj) = 0.
81 fltbuf_recvW(m,bi,bj) = 0.
82 enddo
83
84 icountE=0
85 icountW=0
86
87 iG = myXGlobalLo + (bi-1)*sNx
88 xlo = xc(1, 1, bi,bj) - delX(iG)
89 xhi = xc(sNx,1,bi,bj) + delX(iG+sNx-1)
90 c
91 do ip=1,npart_tile(bi,bj)
92 c
93 if (xpart(ip,bi,bj) .ge. xhi) then
94 icountE=icountE+1
95 if (icountE .gt. max_npart_exch) stop
96 & ' max_npart_exch too low. stop in flt_exchg'
97
98 ic=(icountE-1)*imax
99 fltbuf_sendE(ic+1,bi,bj) = npart(ip,bi,bj)
100 fltbuf_sendE(ic+2,bi,bj) = tstart(ip,bi,bj)
101 fltbuf_sendE(ic+3,bi,bj) = xpart(ip,bi,bj)
102 fltbuf_sendE(ic+4,bi,bj) = ypart(ip,bi,bj)
103 fltbuf_sendE(ic+5,bi,bj) = kpart(ip,bi,bj)
104 fltbuf_sendE(ic+6,bi,bj) = kfloat(ip,bi,bj)
105 fltbuf_sendE(ic+7,bi,bj) = iup(ip,bi,bj)
106 fltbuf_sendE(ic+8,bi,bj) = itop(ip,bi,bj)
107 fltbuf_sendE(ic+9,bi,bj) = tend(ip,bi,bj)
108
109 npart(ip,bi,bj) = npart(npart_tile(bi,bj),bi,bj)
110 tstart(ip,bi,bj) = tstart(npart_tile(bi,bj),bi,bj)
111 xpart(ip,bi,bj) = xpart(npart_tile(bi,bj),bi,bj)
112 ypart(ip,bi,bj) = ypart(npart_tile(bi,bj),bi,bj)
113 kpart(ip,bi,bj) = kpart(npart_tile(bi,bj),bi,bj)
114 kfloat(ip,bi,bj) = kfloat(npart_tile(bi,bj),bi,bj)
115 iup(ip,bi,bj) = iup(npart_tile(bi,bj),bi,bj)
116 itop(ip,bi,bj) = itop(npart_tile(bi,bj),bi,bj)
117 tend(ip,bi,bj) = tend(npart_tile(bi,bj),bi,bj)
118
119 npart_tile(bi,bj) = npart_tile(bi,bj) - 1
120
121 endif
122
123 if (xpart(ip,bi,bj) .le. xlo) then
124 icountW=icountW+1
125 if (icountW .gt. max_npart_exch) stop
126 & ' max_npart_exch too low. stop in flt_exchg'
127
128 ic=(icountW-1)*imax
129 fltbuf_sendW(ic+1,bi,bj) = npart(ip,bi,bj)
130 fltbuf_sendW(ic+2,bi,bj) = tstart(ip,bi,bj)
131 fltbuf_sendW(ic+3,bi,bj) = xpart(ip,bi,bj)
132 fltbuf_sendW(ic+4,bi,bj) = ypart(ip,bi,bj)
133 fltbuf_sendW(ic+5,bi,bj) = kpart(ip,bi,bj)
134 fltbuf_sendW(ic+6,bi,bj) = kfloat(ip,bi,bj)
135 fltbuf_sendW(ic+7,bi,bj) = iup(ip,bi,bj)
136 fltbuf_sendW(ic+8,bi,bj) = itop(ip,bi,bj)
137 fltbuf_sendW(ic+9,bi,bj) = tend(ip,bi,bj)
138
139 npart(ip,bi,bj) = npart(npart_tile(bi,bj),bi,bj)
140 tstart(ip,bi,bj) = tstart(npart_tile(bi,bj),bi,bj)
141 xpart(ip,bi,bj) = xpart(npart_tile(bi,bj),bi,bj)
142 ypart(ip,bi,bj) = ypart(npart_tile(bi,bj),bi,bj)
143 kpart(ip,bi,bj) = kpart(npart_tile(bi,bj),bi,bj)
144 kfloat(ip,bi,bj) = kfloat(npart_tile(bi,bj),bi,bj)
145 iup(ip,bi,bj) = iup(npart_tile(bi,bj),bi,bj)
146 itop(ip,bi,bj) = itop(npart_tile(bi,bj),bi,bj)
147 tend(ip,bi,bj) = tend(npart_tile(bi,bj),bi,bj)
148
149 npart_tile(bi,bj) = npart_tile(bi,bj) - 1
150
151 endif
152
153 enddo
154 ENDDO
155 ENDDO
156
157 C-- "Put" east and west edges.
158 CALL EXCH_RL_SEND_PUT_VEC_X( fltbuf_sendE, fltbuf_sendW,
159 I imax2, myThid )
160 C-- Receive east/west arrays
161 CALL EXCH_RL_RECV_GET_VEC_X( fltbuf_recvE, fltbuf_recvW,
162 I imax2, myThid )
163
164 C-- Unpack arrays on new tiles
165
166 DO bj=myByLo(myThid),myByHi(myThid)
167 DO bi=myBxLo(myThid),myBxHi(myThid)
168
169 do ip=1,max_npart_exch
170 c
171 ic=(ip-1)*imax
172 if (fltbuf_recvE(ic+1,bi,bj) .eq. 0.) goto 100
173 npart_tile(bi,bj) = npart_tile(bi,bj) + 1
174 if (npart_tile(bi,bj) .gt. max_npart_tile)
175 & stop ' max_npart_tile too low. stop in flt_exchg'
176
177 npart(npart_tile(bi,bj),bi,bj) =
178 & fltbuf_recvE(ic+1,bi,bj)
179 tstart(npart_tile(bi,bj),bi,bj) =
180 & fltbuf_recvE(ic+2,bi,bj)
181 xpart(npart_tile(bi,bj),bi,bj) =
182 & fltbuf_recvE(ic+3,bi,bj)
183 ypart(npart_tile(bi,bj),bi,bj) =
184 & fltbuf_recvE(ic+4,bi,bj)
185 kpart(npart_tile(bi,bj),bi,bj) =
186 & fltbuf_recvE(ic+5,bi,bj)
187 kfloat(npart_tile(bi,bj),bi,bj) =
188 & fltbuf_recvE(ic+6,bi,bj)
189 iup(npart_tile(bi,bj),bi,bj) =
190 & fltbuf_recvE(ic+7,bi,bj)
191 itop(npart_tile(bi,bj),bi,bj) =
192 & fltbuf_recvE(ic+8,bi,bj)
193 tend(npart_tile(bi,bj),bi,bj) =
194 & fltbuf_recvE(ic+9,bi,bj)
195
196 enddo
197 100 continue
198
199 do ip=1,max_npart_exch
200 c
201 ic=(ip-1)*imax
202 if (fltbuf_recvW(ic+1,bi,bj) .eq. 0.) goto 200
203 npart_tile(bi,bj) = npart_tile(bi,bj) + 1
204 if (npart_tile(bi,bj) .gt. max_npart_tile)
205 & stop ' max_npart_tile too low. stop in flt_exchg'
206
207 npart(npart_tile(bi,bj),bi,bj) =
208 & fltbuf_recvW(ic+1,bi,bj)
209 tstart(npart_tile(bi,bj),bi,bj) =
210 & fltbuf_recvW(ic+2,bi,bj)
211 xpart(npart_tile(bi,bj),bi,bj) =
212 & fltbuf_recvW(ic+3,bi,bj)
213 ypart(npart_tile(bi,bj),bi,bj) =
214 & fltbuf_recvW(ic+4,bi,bj)
215 kpart(npart_tile(bi,bj),bi,bj) =
216 & fltbuf_recvW(ic+5,bi,bj)
217 kfloat(npart_tile(bi,bj),bi,bj) =
218 & fltbuf_recvW(ic+6,bi,bj)
219 iup(npart_tile(bi,bj),bi,bj) =
220 & fltbuf_recvW(ic+7,bi,bj)
221 itop(npart_tile(bi,bj),bi,bj) =
222 & fltbuf_recvW(ic+8,bi,bj)
223 itop(npart_tile(bi,bj),bi,bj) =
224 & fltbuf_recvW(ic+8,bi,bj)
225 tend(npart_tile(bi,bj),bi,bj) =
226 & fltbuf_recvW(ic+9,bi,bj)
227
228 enddo
229 200 continue
230
231 ENDDO
232 ENDDO
233
234 caw end tile check
235 endif
236
237 C-- Choose floats that have to exchanged with northern and southern tiles
238 C and pack to arrays
239
240 caw Check if there are northern/southern tiles
241 if(Ny .ne. sNy) then
242
243 DO bj=myByLo(myThid),myByHi(myThid)
244 DO bi=myBxLo(myThid),myBxHi(myThid)
245
246 c initialize buffers
247
248 do m=1,imax2
249 fltbuf_sendE(m,bi,bj) = 0.
250 fltbuf_sendW(m,bi,bj) = 0.
251 fltbuf_recvE(m,bi,bj) = 0.
252 fltbuf_recvW(m,bi,bj) = 0.
253 enddo
254
255 icountN=0
256 icountS=0
257
258 jG = myYGlobalLo + (bj-1)*sNy
259 ylo = yc(1, 1, bi,bj) - delY(jG)
260 yhi = yc(1,sNy,bi,bj) + delY(jG+sNy-1)
261
262 do ip=1,npart_tile(bi,bj)
263
264 if (ypart(ip,bi,bj) .ge. yhi) then
265 icountN=icountN+1
266 if (icountN .gt. max_npart_exch) stop
267 & ' max_npart_exch too low. stop in flt_exchg'
268
269 ic=(icountN-1)*imax
270 fltbuf_sendE(ic+1,bi,bj) = npart(ip,bi,bj)
271 fltbuf_sendE(ic+2,bi,bj) = tstart(ip,bi,bj)
272 fltbuf_sendE(ic+3,bi,bj) = xpart(ip,bi,bj)
273 fltbuf_sendE(ic+4,bi,bj) = ypart(ip,bi,bj)
274 fltbuf_sendE(ic+5,bi,bj) = kpart(ip,bi,bj)
275 fltbuf_sendE(ic+6,bi,bj) = kfloat(ip,bi,bj)
276 fltbuf_sendE(ic+7,bi,bj) = iup(ip,bi,bj)
277 fltbuf_sendE(ic+8,bi,bj) = itop(ip,bi,bj)
278 fltbuf_sendE(ic+9,bi,bj) = tend(ip,bi,bj)
279
280 npart(ip,bi,bj) = npart(npart_tile(bi,bj),bi,bj)
281 tstart(ip,bi,bj) = tstart(npart_tile(bi,bj),bi,bj)
282 xpart(ip,bi,bj) = xpart(npart_tile(bi,bj),bi,bj)
283 ypart(ip,bi,bj) = ypart(npart_tile(bi,bj),bi,bj)
284 kpart(ip,bi,bj) = kpart(npart_tile(bi,bj),bi,bj)
285 kfloat(ip,bi,bj) = kfloat(npart_tile(bi,bj),bi,bj)
286 iup(ip,bi,bj) = iup(npart_tile(bi,bj),bi,bj)
287 itop(ip,bi,bj) = itop(npart_tile(bi,bj),bi,bj)
288 tend(ip,bi,bj) = tend(npart_tile(bi,bj),bi,bj)
289
290 npart_tile(bi,bj) = npart_tile(bi,bj) - 1
291 endif
292
293 if (ypart(ip,bi,bj) .le. ylo) then
294 icountS=icountS+1
295 if (icountS .gt. max_npart_exch) stop
296 & ' max_npart_exch too low. stop in flt_exchg'
297
298 ic=(icountS-1)*imax
299 fltbuf_sendW(ic+1,bi,bj) = npart(ip,bi,bj)
300 fltbuf_sendW(ic+2,bi,bj) = tstart(ip,bi,bj)
301 fltbuf_sendW(ic+3,bi,bj) = xpart(ip,bi,bj)
302 fltbuf_sendW(ic+4,bi,bj) = ypart(ip,bi,bj)
303 fltbuf_sendW(ic+5,bi,bj) = kpart(ip,bi,bj)
304 fltbuf_sendW(ic+6,bi,bj) = kfloat(ip,bi,bj)
305 fltbuf_sendW(ic+7,bi,bj) = iup(ip,bi,bj)
306 fltbuf_sendW(ic+8,bi,bj) = itop(ip,bi,bj)
307 fltbuf_sendW(ic+9,bi,bj) = tend(ip,bi,bj)
308
309 npart(ip,bi,bj) = npart(npart_tile(bi,bj),bi,bj)
310 tstart(ip,bi,bj) = tstart(npart_tile(bi,bj),bi,bj)
311 xpart(ip,bi,bj) = xpart(npart_tile(bi,bj),bi,bj)
312 ypart(ip,bi,bj) = ypart(npart_tile(bi,bj),bi,bj)
313 kpart(ip,bi,bj) = kpart(npart_tile(bi,bj),bi,bj)
314 kfloat(ip,bi,bj) = kfloat(npart_tile(bi,bj),bi,bj)
315 iup(ip,bi,bj) = iup(npart_tile(bi,bj),bi,bj)
316 itop(ip,bi,bj) = itop(npart_tile(bi,bj),bi,bj)
317 tend(ip,bi,bj) = tend(npart_tile(bi,bj),bi,bj)
318
319 npart_tile(bi,bj) = npart_tile(bi,bj) - 1
320 endif
321
322 enddo
323
324 ENDDO
325 ENDDO
326
327 C "Put" north and south arrays.
328 CALL EXCH_RL_SEND_PUT_VEC_Y( fltbuf_sendE, fltbuf_sendW,
329 I imax2, myThid )
330
331 C Receive north and south arrays
332 CALL EXCH_RL_RECV_GET_VEC_Y( fltbuf_recvE, fltbuf_recvW,
333 I imax2, myThid )
334
335 C-- Unpack arrays on new tiles
336
337 DO bj=myByLo(myThid),myByHi(myThid)
338 DO bi=myBxLo(myThid),myBxHi(myThid)
339
340 do ip=1,max_npart_exch
341 c
342 ic=(ip-1)*imax
343 if (fltbuf_recvE(ic+1,bi,bj) .eq. 0.) goto 300
344 npart_tile(bi,bj) = npart_tile(bi,bj) + 1
345 if (npart_tile(bi,bj) .gt. max_npart_tile)
346 & stop ' max_npart_tile too low. stop in flt_exchg'
347
348 npart(npart_tile(bi,bj),bi,bj) =
349 & fltbuf_recvE(ic+1,bi,bj)
350 tstart(npart_tile(bi,bj),bi,bj) =
351 & fltbuf_recvE(ic+2,bi,bj)
352 xpart(npart_tile(bi,bj),bi,bj) =
353 & fltbuf_recvE(ic+3,bi,bj)
354 ypart(npart_tile(bi,bj),bi,bj) =
355 & fltbuf_recvE(ic+4,bi,bj)
356 kpart(npart_tile(bi,bj),bi,bj) =
357 & fltbuf_recvE(ic+5,bi,bj)
358 kfloat(npart_tile(bi,bj),bi,bj) =
359 & fltbuf_recvE(ic+6,bi,bj)
360 iup(npart_tile(bi,bj),bi,bj) =
361 & fltbuf_recvE(ic+7,bi,bj)
362 itop(npart_tile(bi,bj),bi,bj) =
363 & fltbuf_recvE(ic+8,bi,bj)
364 tend(npart_tile(bi,bj),bi,bj) =
365 & fltbuf_recvE(ic+9,bi,bj)
366
367 enddo
368 300 continue
369
370 do ip=1,max_npart_exch
371 c
372 ic=(ip-1)*imax
373 if (fltbuf_recvW(ic+1,bi,bj) .eq. 0.) goto 400
374 npart_tile(bi,bj) = npart_tile(bi,bj) + 1
375 if (npart_tile(bi,bj) .gt. max_npart_tile)
376 & stop ' max_npart_tile too low. stop in flt_exchg'
377
378 npart(npart_tile(bi,bj),bi,bj) =
379 & fltbuf_recvW(ic+1,bi,bj)
380 tstart(npart_tile(bi,bj),bi,bj) =
381 & fltbuf_recvW(ic+2,bi,bj)
382 xpart(npart_tile(bi,bj),bi,bj) =
383 & fltbuf_recvW(ic+3,bi,bj)
384 ypart(npart_tile(bi,bj),bi,bj) =
385 & fltbuf_recvW(ic+4,bi,bj)
386 kpart(npart_tile(bi,bj),bi,bj) =
387 & fltbuf_recvW(ic+5,bi,bj)
388 kfloat(npart_tile(bi,bj),bi,bj) =
389 & fltbuf_recvW(ic+6,bi,bj)
390 iup(npart_tile(bi,bj),bi,bj) =
391 & fltbuf_recvW(ic+7,bi,bj)
392 itop(npart_tile(bi,bj),bi,bj) =
393 & fltbuf_recvW(ic+8,bi,bj)
394 tend(npart_tile(bi,bj),bi,bj) =
395 & fltbuf_recvW(ic+9,bi,bj)
396
397 enddo
398 400 continue
399
400 ENDDO
401 ENDDO
402
403 caw end tile check
404 endif
405
406 return
407 end

  ViewVC Help
Powered by ViewVC 1.1.22