/[MITgcm]/MITgcm/eesupp/src/exch_rx_send_put_x.template
ViewVC logotype

Annotation of /MITgcm/eesupp/src/exch_rx_send_put_x.template

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


Revision 1.14 - (hide annotations) (download)
Mon May 17 02:28:06 2010 UTC (14 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62g, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint63g, checkpoint63, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c
Changes since 1.13: +223 -286 lines
 - Separate buffer filling and MPI sending: allow EXCH-1 to work for local
   array (non-shared) when using MPI+MTH. Also reduces number of BARRIER
   (even without using MPI).
 - Message mode: move RecvAck setting (indicator of buffer being ready)
   from send_put to recv_get S/R (was useless before, but not sure if
   it's much more useful now);
 - switch the order of sync: MPI-proc 1rst and then threads;
 - take out spin-waiting code (#undef EXCH_USE_SPINNING), use BARRIER instead.

1 jmc 1.14 C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_send_put_x.template,v 1.13 2009/01/09 22:51:12 jmc Exp $
2 cnh 1.2 C $Name: $
3 adcroft 1.1 #include "CPP_EEOPTIONS.h"
4    
5 cnh 1.2 CBOP
6    
7     C !ROUTINE: EXCH_RX_SEND_PUT_X
8    
9     C !INTERFACE:
10 adcroft 1.1 SUBROUTINE EXCH_RX_SEND_PUT_X( array,
11     I myOLw, myOLe, myOLs, myOLn, myNz,
12     I exchWidthX, exchWidthY,
13     I thesimulationMode, thecornerMode, myThid )
14     IMPLICIT NONE
15 cnh 1.2 C !DESCRIPTION:
16     C *==========================================================*
17 jmc 1.14 C | SUBROUTINE EXCH_RX_SEND_PUT_X
18     C | o "Send" or "put" X edges for RX array.
19 cnh 1.2 C *==========================================================*
20 jmc 1.14 C | Routine that invokes actual message passing send or
21     C | direct "put" of data to update X faces of an XY[R] array.
22 cnh 1.2 C *==========================================================*
23 adcroft 1.1
24 cnh 1.2 C !USES:
25 adcroft 1.1 C == Global variables ==
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     #include "EESUPPORT.h"
29     #include "EXCH.h"
30 cnh 1.2
31     C !INPUT/OUTPUT PARAMETERS:
32 adcroft 1.1 C == Routine arguments ==
33 cnh 1.2 C array :: Array with edges to exchange.
34     C myOLw :: West, East, North and South overlap region sizes.
35 adcroft 1.1 C myOLe
36     C myOLn
37     C myOLs
38 cnh 1.2 C exchWidthX :: Width of data region exchanged.
39 adcroft 1.1 C exchWidthY
40 jmc 1.14 C theSimulationMode :: Forward or reverse mode exchange ( provides
41 cnh 1.2 C support for adjoint integration of code. )
42 jmc 1.14 C theCornerMode :: Flag indicating whether corner updates are
43 cnh 1.2 C needed.
44     C myThid :: Thread number of this instance of S/R EXCH...
45     C eBl :: Edge buffer level
46 adcroft 1.1 INTEGER myOLw
47     INTEGER myOLe
48     INTEGER myOLs
49     INTEGER myOLn
50     INTEGER myNz
51     _RX array(1-myOLw:sNx+myOLe,
52 jmc 1.14 & 1-myOLs:sNy+myOLn,
53 adcroft 1.1 & myNZ, nSx, nSy)
54     INTEGER exchWidthX
55     INTEGER exchWidthY
56     INTEGER theSimulationMode
57     INTEGER theCornerMode
58     INTEGER myThid
59    
60 cnh 1.2 C !LOCAL VARIABLES:
61 adcroft 1.1 C == Local variables ==
62 jmc 1.14 C i, j, k, iMin, iMax, iB :: Loop counters and extents
63     C bi, bj
64 cnh 1.2 C biW, bjW :: West tile indices
65     C biE, bjE :: East tile indices
66     C eBl :: Current exchange buffer level
67     C theProc, theTag, theType, :: Variables used in message building
68 adcroft 1.1 C theSize
69 cnh 1.2 C westCommMode :: Working variables holding type
70     C eastCommMode of communication a particular
71     C tile face uses.
72 jmc 1.14 INTEGER i, j, k, iMin, iMax, iB
73 adcroft 1.1 INTEGER bi, bj, biW, bjW, biE, bjE
74     INTEGER eBl
75     INTEGER westCommMode
76     INTEGER eastCommMode
77    
78     #ifdef ALLOW_USE_MPI
79     INTEGER theProc, theTag, theType, theSize, mpiRc
80 utke 1.12 # ifdef ALLOW_AUTODIFF_OPENAD_AMPI
81 utke 1.8 INTEGER mpiStatus(MPI_STATUS_SIZE)
82 utke 1.10 INTEGER pReqI
83 utke 1.8 # endif
84 adcroft 1.1 #endif
85     C-- Write data to exchange buffer
86 jmc 1.14 C Various actions are possible depending on the communication mode
87 adcroft 1.1 C as follows:
88     C Mode Action
89     C -------- ---------------------------
90     C COMM_NONE Do nothing
91     C
92     C COMM_MSG Message passing communication ( e.g. MPI )
93     C Fill west send buffer from this tile.
94     C Send data with tag identifying tile and direction.
95     C Fill east send buffer from this tile.
96     C Send data with tag identifying tile and direction.
97     C
98     C COMM_PUT "Put" communication ( UMP_, shmemput, etc... )
99     C Fill east receive buffer of west-neighbor tile
100     C Fill west receive buffer of east-neighbor tile
101     C Sync. memory
102     C Write data-ready Ack for east edge of west-neighbor
103     C tile
104     C Write data-ready Ack for west edge of east-neighbor
105     C tile
106     C Sync. memory
107 jmc 1.14 C
108 cnh 1.2 CEOP
109    
110 utke 1.12 #ifdef ALLOW_AUTODIFF_OPENAD_AMPI
111 utke 1.8 # ifdef ALLOW_USE_MPI
112     # ifndef ALWAYS_USE_MPI
113 jmc 1.14 IF ( usingMPI ) THEN
114 utke 1.8 # endif
115 jmc 1.14 _BEGIN_MASTER(myThid)
116     DO bj=1,nSy
117     DO bi=1,nSx
118     CALL ampi_awaitall (
119     & exchNReqsX(1,bi,bj) ,
120     & exchReqIdX(1,1,bi,bj) ,
121     & mpiStatus ,
122     & mpiRC )
123     ENDDO
124     ENDDO
125     _END_MASTER(myThid)
126 utke 1.8 # ifndef ALWAYS_USE_MPI
127 jmc 1.14 ENDIF
128 utke 1.8 # endif
129     # endif
130     #endif
131 jmc 1.14
132     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
133    
134     C Prevent anyone to access shared buffer while an other thread modifies it
135     _BARRIER
136    
137     C Fill shared buffers from array values
138 adcroft 1.1 DO bj=myByLo(myThid),myByHi(myThid)
139     DO bi=myBxLo(myThid),myBxHi(myThid)
140    
141 jmc 1.14 eBl = exchangeBufLevel(1,bi,bj)
142     westCommMode = _tileCommModeW(bi,bj)
143     eastCommMode = _tileCommModeE(bi,bj)
144     biE = _tileBiE(bi,bj)
145     bjE = _tileBjE(bi,bj)
146     biW = _tileBiW(bi,bj)
147     bjW = _tileBjW(bi,bj)
148    
149     C >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
150    
151     IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
152 adcroft 1.1
153     C o Send or Put west edge
154     iMin = 1
155     iMax = 1+exchWidthX-1
156 jmc 1.14 IF ( westCommMode .EQ. COMM_MSG ) THEN
157     iB = 0
158     DO k=1,myNz
159     DO j=1,sNy
160     DO i=iMin,iMax
161     iB = iB + 1
162     westSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
163     ENDDO
164 adcroft 1.1 ENDDO
165     ENDDO
166 jmc 1.14 ELSEIF ( westCommMode .EQ. COMM_PUT ) THEN
167     iB = 0
168     DO k=1,myNz
169     DO j=1,sNy
170     DO i=iMin,iMax
171     iB = iB + 1
172     eastRecvBuf_RX(iB,eBl,biW,bjW) = array(i,j,k,bi,bj)
173     ENDDO
174 adcroft 1.1 ENDDO
175     ENDDO
176 jmc 1.14 ELSEIF ( westCommMode .NE. COMM_NONE
177     & .AND. westCommMode .NE. COMM_GET ) THEN
178     STOP ' S/R EXCH: Invalid commW mode.'
179     ENDIF
180 adcroft 1.1
181     C o Send or Put east edge
182     iMin = sNx-exchWidthX+1
183     iMax = sNx
184 jmc 1.14 IF ( eastCommMode .EQ. COMM_MSG ) THEN
185     iB = 0
186     DO k=1,myNz
187     DO j=1,sNy
188     DO i=iMin,iMax
189     iB = iB + 1
190     eastSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
191     ENDDO
192 adcroft 1.1 ENDDO
193     ENDDO
194 jmc 1.14 ELSEIF ( eastCommMode .EQ. COMM_PUT ) THEN
195     iB = 0
196     DO k=1,myNz
197     DO j=1,sNy
198     DO i=iMin,iMax
199     iB = iB + 1
200     westRecvBuf_RX(iB,eBl,biE,bjE) = array(i,j,k,bi,bj)
201     ENDDO
202 adcroft 1.1 ENDDO
203     ENDDO
204 jmc 1.14 ELSEIF ( eastCommMode .NE. COMM_NONE
205     & .AND. eastCommMode .NE. COMM_GET ) THEN
206     STOP ' S/R EXCH: Invalid commE mode.'
207     ENDIF
208 utke 1.8
209 jmc 1.14 C >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
210 adcroft 1.1 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
211 jmc 1.14
212     C o Send or Put west edge
213 adcroft 1.1 iMin = 1-exchWidthX
214     iMax = 0
215 jmc 1.14 IF ( westCommMode .EQ. COMM_MSG ) THEN
216     iB = 0
217     DO k=1,myNz
218     DO j=1,sNy
219     DO i=iMin,iMax
220     iB = iB + 1
221     westSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
222     array(i,j,k,bi,bj) = 0.0
223     ENDDO
224 adcroft 1.1 ENDDO
225     ENDDO
226 jmc 1.14 ELSEIF ( westCommMode .EQ. COMM_PUT ) THEN
227     iB = 0
228     DO k=1,myNz
229     DO j=1,sNy
230     DO i=iMin,iMax
231     iB = iB + 1
232     eastRecvBuf_RX(iB,eBl,biW,bjW) = array(i,j,k,bi,bj)
233     array(i,j,k,bi,bj) = 0.0
234     ENDDO
235 adcroft 1.1 ENDDO
236     ENDDO
237 jmc 1.14 ELSEIF ( westCommMode .NE. COMM_NONE
238     & .AND. westCommMode .NE. COMM_GET ) THEN
239     STOP ' S/R EXCH: Invalid commW mode.'
240     ENDIF
241 adcroft 1.1
242     C o Send or Put east edge
243     iMin = sNx+1
244     iMax = sNx+exchWidthX
245 jmc 1.14 IF ( eastCommMode .EQ. COMM_MSG ) THEN
246     iB = 0
247     DO k=1,myNz
248     DO j=1,sNy
249     DO i=iMin,iMax
250     iB = iB + 1
251     eastSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
252     array(i,j,k,bi,bj) = 0.0
253     ENDDO
254 adcroft 1.1 ENDDO
255     ENDDO
256 jmc 1.14 ELSEIF ( eastCommMode .EQ. COMM_PUT ) THEN
257     iB = 0
258     DO k=1,myNz
259     DO j=1,sNy
260     DO i=iMin,iMax
261     iB = iB + 1
262     westRecvBuf_RX(iB,eBl,biE,bjE) = array(i,j,k,bi,bj)
263     array(i,j,k,bi,bj) = 0.0
264     ENDDO
265 adcroft 1.1 ENDDO
266     ENDDO
267 jmc 1.14 ELSEIF ( eastCommMode .NE. COMM_NONE
268     & .AND. eastCommMode .NE. COMM_GET ) THEN
269     STOP ' S/R EXCH: Invalid commE mode.'
270     ENDIF
271 adcroft 1.1
272     ENDIF
273    
274     ENDDO
275     ENDDO
276    
277 jmc 1.14 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
278 adcroft 1.1 C-- Signal completetion ( making sure system-wide memory state is
279     C-- consistent ).
280    
281     C ** NOTE ** We are relying on being able to produce strong-ordered
282     C memory semantics here. In other words we assume that there is a
283     C mechanism which can ensure that by the time the Ack is seen the
284     C overlap region data that will be exchanged is up to date.
285     IF ( exchNeedsMemSync ) CALL MEMSYNC
286    
287     DO bj=myByLo(myThid),myByHi(myThid)
288     DO bi=myBxLo(myThid),myBxHi(myThid)
289 jmc 1.14 eBl = exchangeBufLevel(1,bi,bj)
290 adcroft 1.1 biE = _tileBiE(bi,bj)
291     bjE = _tileBjE(bi,bj)
292     biW = _tileBiW(bi,bj)
293     bjW = _tileBjW(bi,bj)
294     westCommMode = _tileCommModeW(bi,bj)
295     eastCommMode = _tileCommModeE(bi,bj)
296 jmc 1.7 IF ( westCommMode.EQ.COMM_PUT ) eastRecvAck(eBl,biW,bjW) = 1
297     IF ( eastCommMode.EQ.COMM_PUT ) westRecvAck(eBl,biE,bjE) = 1
298     IF ( westCommMode.EQ.COMM_GET ) eastRecvAck(eBl,biW,bjW) = 1
299     IF ( eastCommMode.EQ.COMM_GET ) westRecvAck(eBl,biE,bjE) = 1
300 adcroft 1.1 ENDDO
301     ENDDO
302    
303     C-- Make sure "ack" setting is seen system-wide.
304     C Here strong-ordering is not an issue but we want to make
305     C sure that processes that might spin on the above Ack settings
306     C will see the setting.
307     C ** NOTE ** On some machines we wont spin on the Ack setting
308     C ( particularly the T90 ), instead we will use s system barrier.
309 jmc 1.14 C On the T90 the system barrier is very fast and switches out the
310 adcroft 1.1 C thread while it waits. On most machines the system barrier
311     C is much too slow and if we own the machine and have one thread
312     C per process preemption is not a problem.
313     IF ( exchNeedsMemSync ) CALL MEMSYNC
314    
315 jmc 1.14 C Wait until all threads finish filling buffer
316 cnh 1.6 _BARRIER
317 cnh 1.4
318 jmc 1.14 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
319    
320     #ifdef ALLOW_USE_MPI
321     #ifndef ALWAYS_USE_MPI
322     IF ( usingMPI ) THEN
323     #endif
324     C-- Send buffer data: Only Master Thread do proc communication
325     _BEGIN_MASTER(myThid)
326    
327     DO bj=1,nSy
328     DO bi=1,nSx
329    
330     eBl = exchangeBufLevel(1,bi,bj)
331     westCommMode = _tileCommModeW(bi,bj)
332     eastCommMode = _tileCommModeE(bi,bj)
333     biE = _tileBiE(bi,bj)
334     bjE = _tileBjE(bi,bj)
335     biW = _tileBiW(bi,bj)
336     bjW = _tileBjW(bi,bj)
337     theType = _MPI_TYPE_RX
338     theSize = sNy*exchWidthX*myNz
339    
340     IF ( westCommMode .EQ. COMM_MSG ) THEN
341     C Send buffer data (copied from west edge)
342     theProc = tilePidW(bi,bj)
343     theTag = _tileTagSendW(bi,bj)
344     # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
345     exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
346     CALL MPI_Isend( westSendBuf_RX(1,eBl,bi,bj), theSize,
347     & theType, theProc, theTag, MPI_COMM_MODEL,
348     & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj),
349     & mpiRc )
350     # else
351     pReqI=exchNReqsX(1,bi,bj)+1
352     CALL ampi_isend_RX(
353     & westSendBuf_RX(1,eBl,bi,bj),
354     & theSize,
355     & theType,
356     & theProc,
357     & theTag,
358     & MPI_COMM_MODEL,
359     & exchReqIdX(pReqI,1,bi,bj),
360     & exchNReqsX(1,bi,bj),
361     & mpiStatus ,
362     & mpiRc )
363     # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
364     c eastRecvAck(eBl,biW,bjW) = 1
365     ENDIF
366    
367     IF ( eastCommMode .EQ. COMM_MSG ) THEN
368     C Send buffer data (copied from east edge)
369     theProc = tilePidE(bi,bj)
370     theTag = _tileTagSendE(bi,bj)
371     # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
372     exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
373     CALL MPI_Isend( eastSendBuf_RX(1,eBl,bi,bj), theSize,
374     & theType, theProc, theTag, MPI_COMM_MODEL,
375     & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj),
376     & mpiRc )
377     # else
378     pReqI=exchNReqsX(1,bi,bj)+1
379     CALL ampi_isend_RX(
380     & eastSendBuf_RX(1,eBl,bi,bj) ,
381     & theSize ,
382     & theType ,
383     & theProc ,
384     & theTag ,
385     & MPI_COMM_MODEL ,
386     & exchReqIdX(pReqI,1,bi,bj) ,
387     & exchNReqsX(1,bi,bj),
388     & mpiStatus ,
389     & mpiRc )
390     # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
391     c westRecvAck(eBl,biE,bjE) = 1
392     ENDIF
393    
394     ENDDO
395     ENDDO
396    
397     _END_MASTER(myThid)
398    
399     #ifndef ALWAYS_USE_MPI
400     ENDIF
401     #endif
402     #endif /* ALLOW_USE_MPI */
403    
404     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
405     RETURN
406 adcroft 1.1 END

  ViewVC Help
Powered by ViewVC 1.1.22