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

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

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

Revision 1.1 - (show annotations) (download)
Thu Sep 13 17:43:55 2001 UTC (22 years, 8 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint51k_post, checkpoint47e_post, checkpoint57m_post, checkpoint52l_pre, checkpoint44e_post, hrcube4, hrcube5, checkpoint46l_post, checkpoint57g_pre, checkpoint46g_pre, checkpoint47c_post, release1_p13_pre, checkpoint50c_post, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint46f_post, checkpoint52d_pre, checkpoint57g_post, checkpoint48e_post, checkpoint56b_post, checkpoint50c_pre, checkpoint57y_post, checkpoint44f_post, checkpoint46b_post, checkpoint52j_pre, checkpoint43a-release1mods, checkpoint51o_pre, checkpoint54d_post, checkpoint54e_post, ecco_c50_e32, ecco_c50_e33, ecco_c50_e30, ecco_c50_e31, release1_p13, checkpoint51l_post, checkpoint48i_post, checkpoint57r_post, checkpoint46l_pre, checkpoint57d_post, checkpoint57i_post, checkpoint52l_post, checkpoint52k_post, chkpt44d_post, checkpoint59, checkpoint58, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint51, checkpoint50, checkpoint53, checkpoint52, release1_p8, release1_p9, checkpoint50d_post, release1_p1, release1_p2, release1_p3, release1_p4, release1_p5, release1_p6, release1_p7, checkpoint58f_post, checkpoint52f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint50b_pre, checkpoint44e_pre, checkpoint57z_post, checkpoint54f_post, checkpoint51f_post, release1_b1, ecco_c51_e34d, ecco_c51_e34e, ecco_c51_e34f, ecco_c51_e34g, ecco_c51_e34a, ecco_c51_e34b, ecco_c51_e34c, checkpoint58y_post, checkpoint48b_post, checkpoint43, checkpoint51d_post, checkpoint48c_pre, checkpoint47d_pre, checkpoint51t_post, checkpoint58t_post, checkpoint51n_post, release1_chkpt44d_post, checkpoint55i_post, checkpoint58m_post, checkpoint57l_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint51s_post, checkpoint47a_post, checkpoint57t_post, checkpoint55c_post, checkpoint48d_pre, checkpoint51j_post, checkpoint47i_post, checkpoint52e_pre, checkpoint57v_post, checkpoint57f_post, checkpoint52e_post, checkpoint51n_pre, checkpoint47d_post, icebear5, icebear4, icebear3, icebear2, checkpoint53d_post, checkpoint46d_pre, checkpoint57a_post, checkpoint48d_post, release1-branch_tutorials, checkpoint57h_pre, checkpoint48f_post, checkpoint45d_post, checkpoint52b_pre, checkpoint54b_post, checkpoint46j_pre, checkpoint58w_post, checkpoint57h_post, checkpoint51l_pre, checkpoint52m_post, checkpoint57y_pre, chkpt44a_post, checkpoint55g_post, checkpoint44h_pre, checkpoint48h_post, checkpoint51q_post, ecco_c50_e29, checkpoint51b_pre, checkpoint46a_post, checkpoint47g_post, checkpoint52b_post, checkpoint52c_post, checkpoint46j_post, checkpoint51h_pre, checkpoint46k_post, ecco_c50_e28, chkpt44c_pre, checkpoint58o_post, checkpoint48a_post, checkpoint45a_post, checkpoint57c_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint58p_post, checkpoint58q_post, checkpoint52f_pre, checkpoint55d_post, ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, release1_p12, checkpoint58e_post, release1_p10, release1_p11, release1_p16, release1_p17, release1_p14, release1_p15, checkpoint47j_post, checkpoint54a_pre, ecco_c50_e33a, checkpoint53c_post, checkpoint55d_pre, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, branch-exfmods-tag, checkpoint44g_post, branchpoint-genmake2, checkpoint54a_post, checkpoint46e_pre, checkpoint55h_post, checkpoint58n_post, checkpoint51r_post, checkpoint48c_post, checkpoint45b_post, checkpoint46b_pre, checkpoint51i_post, checkpoint57e_post, release1-branch-end, release1_final_v1, checkpoint55b_post, checkpoint51b_post, checkpoint51c_post, checkpoint46c_pre, checkpoint53a_post, checkpoint46, checkpoint47b_post, checkpoint44b_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59h, ecco_c51_e34, checkpoint46h_pre, checkpoint52d_post, checkpoint53g_post, checkpoint46m_post, checkpoint57p_post, checkpint57u_post, checkpoint46a_pre, checkpoint50g_post, checkpoint45c_post, checkpoint57q_post, ecco_ice2, ecco_ice1, checkpoint44h_post, eckpoint57e_pre, checkpoint46g_post, release1_p12_pre, checkpoint58k_post, checkpoint52a_pre, ecco_c44_e22, checkpoint58v_post, checkpoint50h_post, checkpoint52i_post, checkpoint50e_pre, checkpoint50i_post, ecco_c44_e25, checkpoint51i_pre, checkpoint52h_pre, checkpoint56a_post, checkpoint58l_post, checkpoint53f_post, checkpoint57h_done, checkpoint52j_post, checkpoint47f_post, checkpoint50e_post, chkpt44a_pre, checkpoint46i_post, ecco_c44_e23, ecco_c44_e20, ecco_c44_e21, ecco_c44_e26, ecco_c44_e27, ecco_c44_e24, checkpoint57j_post, checkpoint57f_pre, checkpoint46c_post, checkpoint58g_post, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, branch-netcdf, checkpoint50d_pre, checkpoint58x_post, checkpoint52n_post, checkpoint53b_pre, checkpoint46e_post, release1_beta1, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint51e_post, checkpoint44b_pre, checkpoint42, checkpoint57a_pre, checkpoint40, checkpoint41, checkpoint55a_post, checkpoint47, checkpoint44, checkpoint45, checkpoint48, checkpoint49, checkpoint57o_post, checkpoint46h_post, checkpoint51o_post, checkpoint57k_post, checkpoint51f_pre, chkpt44c_post, checkpoint48g_post, checkpoint53b_post, checkpoint47h_post, checkpoint52a_post, checkpoint57w_post, checkpoint44f_pre, checkpoint58i_post, checkpoint51g_post, ecco_c52_e35, checkpoint57x_post, checkpoint46d_post, checkpoint50b_post, checkpoint58c_post, checkpoint58u_post, release1-branch_branchpoint, checkpoint51m_post, checkpoint53d_pre, checkpoint58s_post, checkpoint55e_post, checkpoint54c_post, checkpoint51a_post, checkpoint51p_post, checkpoint51u_post
Branch point for: c24_e25_ice, branch-exfmods-curt, release1_final, release1-branch, branch-genmake2, release1, branch-nonh, tg2-branch, ecco-branch, release1_50yr, netcdf-sm0, icebear, checkpoint51n_branch, release1_coupled 
Added package "flt".
 o pkg/flt
 o verification/flt_example
 o visualization of trajectories supplied
 o works but output not available to testscript
1 C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/exch_recv_get_x.F,v 1.4 1999/05/03 21:40:00 adcroft Exp $
2 #include "CPP_OPTIONS.h"
3 #include "CPP_EEOPTIONS.h"
4
5 SUBROUTINE EXCH_RL_RECV_GET_VEC_X( arrayE, arrayW,
6 I myd1, myThid )
7 C /==========================================================\
8 C | SUBROUTINE RECV_RL_GET_X |
9 C | o "Send" or "put" X edges for RL array. |
10 C |==========================================================|
11 C | Routine that invokes actual message passing send or |
12 C | direct "put" of data to update X faces of an XY[R] array.|
13 C \==========================================================/
14 IMPLICIT NONE
15
16 C == Global variables ==
17 #include "SIZE.h"
18 #include "EEPARAMS.h"
19 #include "EESUPPORT.h"
20 #include "FLT.h"
21 #include "EXCH.h"
22
23 C == Routine arguments ==
24 C arrayE - Arrays to exchange be exchanged.
25 C arrayW
26 C myd1 - sizes.
27 C myd2
28 C theSimulationMode - Forward or reverse mode exchange ( provides
29 C support for adjoint integration of code. )
30 C myThid - Thread number of this instance of S/R EXCH...
31 C eBl - Edge buffer level
32 INTEGER myd1
33 INTEGER myd2
34 _RL arrayE(myd1, nSx, nSy), arrayW(myd1, nSx, nSy)
35 INTEGER theSimulationMode
36 INTEGER myThid
37 CEndOfInterface
38
39 C == Local variables ==
40 C I, J - Loop counters and extents
41 C bi, bj
42 C biW, bjW - West tile indices
43 C biE, bjE - East tile indices
44 C theProc, theTag, theType, - Variables used in message building
45 C theSize
46 C westCommMode - Working variables holding type
47 C eastCommMode of communication a particular
48 C tile face uses.
49 INTEGER I, J
50 INTEGER bi, bj, biW, bjW, biE, bjE
51 INTEGER westCommMode
52 INTEGER eastCommMode
53 INTEGER spinCount
54 #ifdef ALLOW_USE_MPI
55 INTEGER theProc, theTag, theType, theSize
56 INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
57 #endif
58
59
60 C-- Under a "put" scenario we
61 C-- i. set completetion signal for buffer we put into.
62 C-- ii. wait for completetion signal indicating data has been put in
63 C-- our buffer.
64 C-- Under a messaging mode we "receive" the message.
65 C-- Under a "get" scenario we
66 C-- i. Check that the data is ready.
67 C-- ii. Read the data.
68 C-- iii. Set data read flag + memory sync.
69
70
71 DO bj=myByLo(myThid),myByHi(myThid)
72 DO bi=myBxLo(myThid),myBxHi(myThid)
73 westCommMode = _tileCommModeW(bi,bj)
74 eastCommMode = _tileCommModeE(bi,bj)
75 biE = _tileBiE(bi,bj)
76 bjE = _tileBjE(bi,bj)
77 biW = _tileBiW(bi,bj)
78 bjW = _tileBjW(bi,bj)
79 IF ( westCommMode .EQ. COMM_MSG ) THEN
80 #ifdef ALLOW_USE_MPI
81 #ifndef ALWAYS_USE_MPI
82 IF ( usingMPI ) THEN
83 #endif
84 theProc = tilePidW(bi,bj)
85 theTag = _tileTagRecvW(bi,bj)
86 theType = MPI_DOUBLE_PRECISION
87 theSize = myd1
88 CALL MPI_Recv( arrayW(1,bi,bj), theSize, theType,
89 & theProc, theTag, MPI_COMM_MODEL,
90 & mpiStatus, mpiRc )
91 c if (theProc .eq. 0 .or. theProc .eq. 2) then
92 c if (arrayW(1,bi,bj) .ne. 0.) then
93 c write(errormessageunit,*) 'qq2y: ',myprocid,
94 c & theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
95 c else
96 c write(errormessageunit,*) 'qq2n: ',myprocid,
97 c & theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
98 c endif
99 c endif
100 #ifndef ALWAYS_USE_MPI
101 ENDIF
102 #endif
103 #endif /* ALLOW_USE_MPI */
104 ENDIF
105 IF ( eastCommMode .EQ. COMM_MSG ) THEN
106 #ifdef ALLOW_USE_MPI
107 #ifndef ALWAYS_USE_MPI
108 IF ( usingMPI ) THEN
109 #endif
110 theProc = tilePidE(bi,bj)
111 theTag = _tileTagRecvE(bi,bj)
112 theType = MPI_DOUBLE_PRECISION
113 theSize = myd1
114 CALL MPI_Recv( arrayE(1,bi,bj), theSize, theType,
115 & theProc, theTag, MPI_COMM_MODEL,
116 & mpiStatus, mpiRc )
117 #ifndef ALWAYS_USE_MPI
118 ENDIF
119 #endif
120 #endif /* ALLOW_USE_MPI */
121 ENDIF
122 ENDDO
123 ENDDO
124
125 C-- Wait for buffers I am going read to be ready.
126 IF ( exchUsesBarrier ) THEN
127 C o On some machines ( T90 ) use system barrier rather than spinning.
128 CALL BARRIER( myThid )
129 ELSE
130 C o Spin waiting for completetion flag. This avoids a global-lock
131 C i.e. we only lock waiting for data that we need.
132 DO bj=myByLo(myThid),myByHi(myThid)
133 DO bi=myBxLo(myThid),myBxHi(myThid)
134 spinCount = 0
135 westCommMode = _tileCommModeW(bi,bj)
136 eastCommMode = _tileCommModeE(bi,bj)
137 10 CONTINUE
138 CALL FOOL_THE_COMPILER
139 spinCount = spinCount+1
140 C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
141 C WRITE(0,*) ' eBl = ', ebl
142 C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
143 C ENDIF
144 IF ( westRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
145 IF ( eastRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
146 C Clear outstanding requests
147 westRecvAck(1,bi,bj) = 0.
148 eastRecvAck(1,bi,bj) = 0.
149
150 c IF ( exchVReqsX(1,bi,bj) .GT. 0 ) THEN
151 IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
152 #ifdef ALLOW_USE_MPI
153 #ifndef ALWAYS_USE_MPI
154 IF ( usingMPI ) THEN
155 #endif
156 c CALL MPI_Waitall( exchVReqsX(1,bi,bj), exchReqVIdX(1,1,bi,bj),
157 CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
158 & mpiStatus, mpiRC )
159 #ifndef ALWAYS_USE_MPI
160 ENDIF
161 #endif
162 #endif /* ALLOW_USE_MPI */
163 ENDIF
164 C Clear outstanding requests counter
165 c exchVReqsX(1,bi,bj) = 0
166 exchNReqsX(1,bi,bj) = 0
167 C Update statistics
168 ENDDO
169 ENDDO
170 ENDIF
171
172 C-- Read from the buffers
173 DO bj=myByLo(myThid),myByHi(myThid)
174 DO bi=myBxLo(myThid),myBxHi(myThid)
175
176 biE = _tileBiE(bi,bj)
177 bjE = _tileBjE(bi,bj)
178 biW = _tileBiW(bi,bj)
179 bjW = _tileBjW(bi,bj)
180 westCommMode = _tileCommModeW(bi,bj)
181 eastCommMode = _tileCommModeE(bi,bj)
182 IF ( eastCommMode .EQ. COMM_GET ) THEN
183 DO I=1,myd1
184 arrayE(I,bi,bj) = arrayW(I,biE,bjE)
185 ENDDO
186 ENDIF
187 IF ( westCommMode .EQ. COMM_GET ) THEN
188 DO I=1,myd1
189 arrayW(I,bi,bj) = arrayE(I,biW,bjW)
190 ENDDO
191 ENDIF
192
193 ENDDO
194 ENDDO
195
196 RETURN
197 END
198
199
200 SUBROUTINE EXCH_RL_RECV_GET_VEC_Y( arrayN, arrayS,
201 I myd1, myThid )
202 C /==========================================================\
203 C | SUBROUTINE RECV_RL_GET_Y |
204 C | o "Send" or "put" Y edges for RL array. |
205 C |==========================================================|
206 C | Routine that invokes actual message passing send or |
207 C | direct "put" of data to update Y faces of an XY[R] array.|
208 C \==========================================================/
209 IMPLICIT NONE
210
211 C == Global variables ==
212 #include "SIZE.h"
213 #include "EEPARAMS.h"
214 #include "EESUPPORT.h"
215 #include "FLT.h"
216 #include "EXCH.h"
217
218 C == Routine arguments ==
219 C arrayN - Arrays to exchange be exchanged.
220 C arrayS
221 C myd1 - sizes.
222 C myd2
223 C theSimulationMode - Forward or reverse mode exchange ( provides
224 C support for adjoint integration of code. )
225 C myThid - Thread number of this instance of S/R EXCH...
226 INTEGER myd1
227 INTEGER myd2
228 _RL arrayN(myd1, nSx, nSy), arrayS(myd1, nSx, nSy)
229 INTEGER theSimulationMode
230 INTEGER myThid
231 CEndOfInterface
232
233 C == Local variables ==
234 C I, J - Loop counters and extents
235 C bi, bj
236 C biS, bjS - South tile indices
237 C biE, bjE - North tile indices
238 C theProc, theTag, theType, - Variables used in message building
239 C theSize
240 C southCommMode - Working variables holding type
241 C northCommMode of communication a particular
242 C tile face uses.
243 INTEGER I, J
244 INTEGER bi, bj, biS, bjS, biN, bjN
245 INTEGER southCommMode
246 INTEGER northCommMode
247 INTEGER spinCount
248 #ifdef ALLOW_USE_MPI
249 INTEGER theProc, theTag, theType, theSize
250 INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
251 #endif
252
253
254 C-- Under a "put" scenario we
255 C-- i. set completetion signal for buffer we put into.
256 C-- ii. wait for completetion signal indicating data has been put in
257 C-- our buffer.
258 C-- Under a messaging mode we "receive" the message.
259 C-- Under a "get" scenario we
260 C-- i. Check that the data is ready.
261 C-- ii. Read the data.
262 C-- iii. Set data read flag + memory sync.
263
264
265 DO bj=myByLo(myThid),myByHi(myThid)
266 DO bi=myBxLo(myThid),myBxHi(myThid)
267 southCommMode = _tileCommModeS(bi,bj)
268 northCommMode = _tileCommModeN(bi,bj)
269 biN = _tileBiN(bi,bj)
270 bjN = _tileBjN(bi,bj)
271 biS = _tileBiS(bi,bj)
272 bjS = _tileBjS(bi,bj)
273 IF ( southCommMode .EQ. COMM_MSG ) THEN
274 #ifdef ALLOW_USE_MPI
275 #ifndef ALWAYS_USE_MPI
276 IF ( usingMPI ) THEN
277 #endif
278 theProc = tilePidS(bi,bj)
279 theTag = _tileTagRecvS(bi,bj)
280 theType = MPI_DOUBLE_PRECISION
281 theSize = myd1
282 CALL MPI_Recv( arrayS(1,bi,bj), theSize, theType,
283 & theProc, theTag, MPI_COMM_MODEL,
284 & mpiStatus, mpiRc )
285 #ifndef ALWAYS_USE_MPI
286 ENDIF
287 #endif
288 #endif /* ALLOW_USE_MPI */
289 ENDIF
290 IF ( northCommMode .EQ. COMM_MSG ) THEN
291 #ifdef ALLOW_USE_MPI
292 #ifndef ALWAYS_USE_MPI
293 IF ( usingMPI ) THEN
294 #endif
295 theProc = tilePidN(bi,bj)
296 theTag = _tileTagRecvN(bi,bj)
297 theType = MPI_DOUBLE_PRECISION
298 theSize = myd1
299 CALL MPI_Recv( arrayN(1,bi,bj), theSize, theType,
300 & theProc, theTag, MPI_COMM_MODEL,
301 & mpiStatus, mpiRc )
302 #ifndef ALWAYS_USE_MPI
303 ENDIF
304 #endif
305 #endif /* ALLOW_USE_MPI */
306 ENDIF
307 ENDDO
308 ENDDO
309
310 C-- Wait for buffers I am going read to be ready.
311 IF ( exchUsesBarrier ) THEN
312 C o On some machines ( T90 ) use system barrier rather than spinning.
313 CALL BARRIER( myThid )
314 ELSE
315 C o Spin waiting for completetion flag. This avoids a global-lock
316 C i.e. we only lock waiting for data that we need.
317 DO bj=myByLo(myThid),myByHi(myThid)
318 DO bi=myBxLo(myThid),myBxHi(myThid)
319 spinCount = 0
320 southCommMode = _tileCommModeS(bi,bj)
321 northCommMode = _tileCommModeN(bi,bj)
322 10 CONTINUE
323 CALL FOOL_THE_COMPILER
324 spinCount = spinCount+1
325 C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
326 C WRITE(0,*) ' eBl = ', ebl
327 C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
328 C ENDIF
329 IF ( southRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
330 IF ( northRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10
331 C Clear outstanding requests
332 southRecvAck(1,bi,bj) = 0.
333 northRecvAck(1,bi,bj) = 0.
334
335 c IF ( exchVReqsY(1,bi,bj) .GT. 0 ) THEN
336 IF ( exchNReqsY(1,bi,bj) .GT. 0 ) THEN
337 #ifdef ALLOW_USE_MPI
338 #ifndef ALWAYS_USE_MPI
339 IF ( usingMPI ) THEN
340 #endif
341 c CALL MPI_Waitall( exchVReqsY(1,bi,bj), exchReqVIdY(1,1,bi,bj),
342 CALL MPI_Waitall( exchNReqsY(1,bi,bj), exchReqIdY(1,1,bi,bj),
343 & mpiStatus, mpiRC )
344 #ifndef ALWAYS_USE_MPI
345 ENDIF
346 #endif
347 #endif /* ALLOW_USE_MPI */
348 ENDIF
349 C Clear outstanding requests counter
350 c exchVReqsY(1,bi,bj) = 0
351 exchNReqsY(1,bi,bj) = 0
352 C Update statistics
353 ENDDO
354 ENDDO
355 ENDIF
356
357 C-- Read from the buffers
358 DO bj=myByLo(myThid),myByHi(myThid)
359 DO bi=myBxLo(myThid),myBxHi(myThid)
360
361 biN = _tileBiN(bi,bj)
362 bjN = _tileBjN(bi,bj)
363 biS = _tileBiS(bi,bj)
364 bjS = _tileBjS(bi,bj)
365 southCommMode = _tileCommModeS(bi,bj)
366 northCommMode = _tileCommModeN(bi,bj)
367 IF ( southCommMode .EQ. COMM_GET ) THEN
368 DO I=1,myd1
369 arrayN(I,bi,bj) = arrayS(I,biN,bjN)
370 ENDDO
371 ENDIF
372 IF ( southCommMode .EQ. COMM_GET ) THEN
373 DO I=1,myd1
374 arrayS(I,bi,bj) = arrayN(I,biS,bjS)
375 ENDDO
376 ENDIF
377
378 ENDDO
379 ENDDO
380
381 RETURN
382 END
383
  ViewVC Help
Powered by ViewVC 1.1.22