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

Annotation 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 - (hide 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 adcroft 1.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