/[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.4 - (hide annotations) (download)
Mon Nov 7 19:03:36 2005 UTC (18 years, 6 months ago) by cnh
Branch: MAIN
Changes since 1.3: +42 -1 lines
Adding CPP option to switch to single-threaded EXCH comms in a multi-threaded run.
This is useful for broken MPI implementations that can only do single
threaded messaging (almost every MPI implementation is like this!).

1 cnh 1.4 C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_send_put_x.template,v 1.3 2003/11/12 00:02:44 dimitri 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     C | SUBROUTINE EXCH_RX_SEND_PUT_X
18     C | o "Send" or "put" X edges for RX array.
19     C *==========================================================*
20     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     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 cnh 1.2 C theSimulationMode :: Forward or reverse mode exchange ( provides
41     C support for adjoint integration of code. )
42     C theCornerMode :: Flag indicating whether corner updates are
43     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     & 1-myOLs:sNy+myOLn,
53     & 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 cnh 1.2 C I, J, K, iMin, iMax, iB :: Loop counters and extents
63 adcroft 1.1 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 adcroft 1.1 INTEGER I, J, K, iMin, iMax, iB
73     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     #endif
81     C-- Write data to exchange buffer
82     C Various actions are possible depending on the communication mode
83     C as follows:
84     C Mode Action
85     C -------- ---------------------------
86     C COMM_NONE Do nothing
87     C
88     C COMM_MSG Message passing communication ( e.g. MPI )
89     C Fill west send buffer from this tile.
90     C Send data with tag identifying tile and direction.
91     C Fill east send buffer from this tile.
92     C Send data with tag identifying tile and direction.
93     C
94     C COMM_PUT "Put" communication ( UMP_, shmemput, etc... )
95     C Fill east receive buffer of west-neighbor tile
96     C Fill west receive buffer of east-neighbor tile
97     C Sync. memory
98     C Write data-ready Ack for east edge of west-neighbor
99     C tile
100     C Write data-ready Ack for west edge of east-neighbor
101     C tile
102     C Sync. memory
103     C
104 cnh 1.2 CEOP
105    
106 cnh 1.4 #ifdef USE_SINGLE_THREADED_EXCH_COMMS
107     INTEGER myBxLoSave(MAX_NO_THREADS)
108     INTEGER myBxHiSave(MAX_NO_THREADS)
109     INTEGER myByLoSave(MAX_NO_THREADS)
110     INTEGER myByHiSave(MAX_NO_THREADS)
111     #endif /* SINGLE_THREADED_EXCH_COMMS */
112    
113     #ifdef USE_SINGLE_THREADED_EXCH_COMMS
114     _BARRIER
115     IF ( myThid .EQ. 1 ) THEN
116     DO I=1,nThreads
117     myBxLoSave(I) = myBxLo(I)
118     myBxHiSave(I) = myBxHi(I)
119     myByLoSave(I) = myByLo(I)
120     myByHiSave(I) = myByHi(I)
121     myBxLo(I) = 0
122     myBxHi(I) = -1
123     myByLo(I) = 0
124     myByHi(I) = -1
125     ENDDO
126     myBxLo(1) = 1
127     myBxHi(1) = nSx
128     myByLo(1) = 1
129     myByHi(1) = nSy
130     ENDIF
131     _BARRIER
132     #endif /* SINGLE_THREADED_EXCH_COMMS */
133    
134 adcroft 1.1 DO bj=myByLo(myThid),myByHi(myThid)
135     DO bi=myBxLo(myThid),myBxHi(myThid)
136    
137     ebL = exchangeBufLevel(1,bi,bj)
138     westCommMode = _tileCommModeW(bi,bj)
139     eastCommMode = _tileCommModeE(bi,bj)
140     biE = _tileBiE(bi,bj)
141     bjE = _tileBjE(bi,bj)
142     biW = _tileBiW(bi,bj)
143     bjW = _tileBjW(bi,bj)
144    
145     C o Send or Put west edge
146     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
147     c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
148     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
149    
150     IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
151     iMin = 1
152     iMax = 1+exchWidthX-1
153     IF ( westCommMode .EQ. COMM_MSG ) THEN
154     iB = 0
155     DO K=1,myNz
156     DO J=1,sNy
157     DO I=iMin,iMax
158     iB = iB + 1
159     westSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
160     ENDDO
161     ENDDO
162     ENDDO
163     C Send the data
164     #ifdef ALLOW_USE_MPI
165     #ifndef ALWAYS_USE_MPI
166     IF ( usingMPI ) THEN
167     #endif
168     theProc = tilePidW(bi,bj)
169     theTag = _tileTagSendW(bi,bj)
170     theSize = iB
171 dimitri 1.3 theType = _MPI_TYPE_RX
172 adcroft 1.1 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
173     CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,
174     & theProc, theTag, MPI_COMM_MODEL,
175     & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
176     #ifndef ALWAYS_USE_MPI
177     ENDIF
178     #endif
179     #endif /* ALLOW_USE_MPI */
180     eastRecvAck(eBl,biW,bjW) = 1.
181     ELSEIF ( westCommMode .EQ. COMM_PUT ) THEN
182     iB = 0
183     DO K=1,myNz
184     DO J=1,sNy
185     DO I=iMin,iMax
186     iB = iB + 1
187     eastRecvBuf_RX(iB,eBl,biW,bjW) = array(I,J,K,bi,bj)
188     ENDDO
189     ENDDO
190     ENDDO
191     ELSEIF ( westCommMode .NE. COMM_NONE
192     & .AND. westCommMode .NE. COMM_GET ) THEN
193     STOP ' S/R EXCH: Invalid commW mode.'
194     ENDIF
195    
196     C o Send or Put east edge
197     iMin = sNx-exchWidthX+1
198     iMax = sNx
199     IF ( eastCommMode .EQ. COMM_MSG ) THEN
200     iB = 0
201     DO K=1,myNz
202     DO J=1,sNy
203     DO I=iMin,iMax
204     iB = iB + 1
205     eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
206     ENDDO
207     ENDDO
208     ENDDO
209     C Send the data
210     #ifdef ALLOW_USE_MPI
211     #ifndef ALWAYS_USE_MPI
212     IF ( usingMPI ) THEN
213     #endif
214     theProc = tilePidE(bi,bj)
215     theTag = _tileTagSendE(bi,bj)
216     theSize = iB
217 dimitri 1.3 theType = _MPI_TYPE_RX
218 adcroft 1.1 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
219     CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,
220     & theProc, theTag, MPI_COMM_MODEL,
221     & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
222     #ifndef ALWAYS_USE_MPI
223     ENDIF
224     #endif
225     #endif /* ALLOW_USE_MPI */
226     westRecvAck(eBl,biE,bjE) = 1.
227     ELSEIF ( eastCommMode .EQ. COMM_PUT ) THEN
228     iB = 0
229     DO K=1,myNz
230     DO J=1,sNy
231     DO I=iMin,iMax
232     iB = iB + 1
233     westRecvBuf_RX(iB,eBl,biE,bjE) = array(I,J,K,bi,bj)
234     ENDDO
235     ENDDO
236     ENDDO
237     ELSEIF ( eastCommMode .NE. COMM_NONE
238     & .AND. eastCommMode .NE. COMM_GET ) THEN
239     STOP ' S/R EXCH: Invalid commE mode.'
240     ENDIF
241     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
242     c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
243     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
244     ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
245     iMin = 1-exchWidthX
246     iMax = 0
247     IF ( westCommMode .EQ. COMM_MSG ) THEN
248     iB = 0
249     DO K=1,myNz
250     DO J=1,sNy
251     DO I=iMin,iMax
252     iB = iB + 1
253     westSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
254     array(I,J,K,bi,bj) = 0.0
255     ENDDO
256     ENDDO
257     ENDDO
258     C Send the data
259     #ifdef ALLOW_USE_MPI
260     #ifndef ALWAYS_USE_MPI
261     IF ( usingMPI ) THEN
262     #endif
263     theProc = tilePidW(bi,bj)
264     theTag = _tileTagSendW(bi,bj)
265     theSize = iB
266 dimitri 1.3 theType = _MPI_TYPE_RX
267 adcroft 1.1 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
268     CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,
269     & theProc, theTag, MPI_COMM_MODEL,
270     & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
271     #ifndef ALWAYS_USE_MPI
272     ENDIF
273     #endif
274     #endif /* ALLOW_USE_MPI */
275     eastRecvAck(eBl,biW,bjW) = 1.
276     ELSEIF ( westCommMode .EQ. COMM_PUT ) THEN
277     iB = 0
278     DO K=1,myNz
279     DO J=1,sNy
280     DO I=iMin,iMax
281     iB = iB + 1
282     eastRecvBuf_RX(iB,eBl,biW,bjW) = array(I,J,K,bi,bj)
283     array(I,J,K,bi,bj) = 0.0
284     ENDDO
285     ENDDO
286     ENDDO
287     ELSEIF ( westCommMode .NE. COMM_NONE
288     & .AND. westCommMode .NE. COMM_GET ) THEN
289     STOP ' S/R EXCH: Invalid commW mode.'
290     ENDIF
291    
292     C o Send or Put east edge
293     iMin = sNx+1
294     iMax = sNx+exchWidthX
295     IF ( eastCommMode .EQ. COMM_MSG ) THEN
296     iB = 0
297     DO K=1,myNz
298     DO J=1,sNy
299     DO I=iMin,iMax
300     iB = iB + 1
301     eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
302     array(I,J,K,bi,bj) = 0.0
303     ENDDO
304     ENDDO
305     ENDDO
306     C Send the data
307     #ifdef ALLOW_USE_MPI
308     #ifndef ALWAYS_USE_MPI
309     IF ( usingMPI ) THEN
310     #endif
311     theProc = tilePidE(bi,bj)
312     theTag = _tileTagSendE(bi,bj)
313     theSize = iB
314 dimitri 1.3 theType = _MPI_TYPE_RX
315 adcroft 1.1 exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
316     CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,
317     & theProc, theTag, MPI_COMM_MODEL,
318     & exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
319     #ifndef ALWAYS_USE_MPI
320     ENDIF
321     #endif
322     #endif /* ALLOW_USE_MPI */
323     westRecvAck(eBl,biE,bjE) = 1.
324     ELSEIF ( eastCommMode .EQ. COMM_PUT ) THEN
325     iB = 0
326     DO K=1,myNz
327     DO J=1,sNy
328     DO I=iMin,iMax
329     iB = iB + 1
330     westRecvBuf_RX(iB,eBl,biE,bjE) = array(I,J,K,bi,bj)
331     array(I,J,K,bi,bj) = 0.0
332     ENDDO
333     ENDDO
334     ENDDO
335     ELSEIF ( eastCommMode .NE. COMM_NONE
336     & .AND. eastCommMode .NE. COMM_GET ) THEN
337     STOP ' S/R EXCH: Invalid commE mode.'
338     ENDIF
339    
340     ENDIF
341    
342     ENDDO
343     ENDDO
344    
345     C-- Signal completetion ( making sure system-wide memory state is
346     C-- consistent ).
347    
348     C ** NOTE ** We are relying on being able to produce strong-ordered
349     C memory semantics here. In other words we assume that there is a
350     C mechanism which can ensure that by the time the Ack is seen the
351     C overlap region data that will be exchanged is up to date.
352     IF ( exchNeedsMemSync ) CALL MEMSYNC
353    
354     DO bj=myByLo(myThid),myByHi(myThid)
355     DO bi=myBxLo(myThid),myBxHi(myThid)
356     ebL = exchangeBufLevel(1,bi,bj)
357     biE = _tileBiE(bi,bj)
358     bjE = _tileBjE(bi,bj)
359     biW = _tileBiW(bi,bj)
360     bjW = _tileBjW(bi,bj)
361     westCommMode = _tileCommModeW(bi,bj)
362     eastCommMode = _tileCommModeE(bi,bj)
363     IF ( westCommMode .EQ. COMM_PUT ) eastRecvAck(eBl,biW,bjW) = 1.
364     IF ( eastCommMode .EQ. COMM_PUT ) westRecvAck(eBl,biE,bjE) = 1.
365     IF ( westCommMode .EQ. COMM_GET ) eastRecvAck(eBl,biW,bjW) = 1.
366     IF ( eastCommMode .EQ. COMM_GET ) westRecvAck(eBl,biE,bjE) = 1.
367     ENDDO
368     ENDDO
369    
370     C-- Make sure "ack" setting is seen system-wide.
371     C Here strong-ordering is not an issue but we want to make
372     C sure that processes that might spin on the above Ack settings
373     C will see the setting.
374     C ** NOTE ** On some machines we wont spin on the Ack setting
375     C ( particularly the T90 ), instead we will use s system barrier.
376     C On the T90 the system barrier is very fast and switches out the
377     C thread while it waits. On most machines the system barrier
378     C is much too slow and if we own the machine and have one thread
379     C per process preemption is not a problem.
380     IF ( exchNeedsMemSync ) CALL MEMSYNC
381    
382 cnh 1.4 #ifdef USE_SINGLE_THREADED_EXCH_COMMS
383     _BARRIER
384     IF ( myThid .EQ. 1 ) THEN
385     DO I=1,nThreads
386     myBxLo(I) = myBxLoSave(I)
387     myBxHi(I) = myBxHiSave(I)
388     myByLo(I) = myByLoSave(I)
389     myByHi(I) = myByHiSave(I)
390     ENDDO
391     ENDIF
392     _BARRIER
393     #endif /* USE_SINGLE_THREADED_EXCH_COMMS */
394    
395 adcroft 1.1 RETURN
396     END

  ViewVC Help
Powered by ViewVC 1.1.22