/[MITgcm]/MITgcm/eesupp/src/exch_send_put_y.F
ViewVC logotype

Contents of /MITgcm/eesupp/src/exch_send_put_y.F

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


Revision 1.2 - (show annotations) (download)
Wed Oct 28 03:11:35 1998 UTC (25 years, 7 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint19, checkpoint18, checkpoint17, checkpoint16
Changes since 1.1: +12 -7 lines
Changes to support
 - g77 compilation under Linux
 - LR(1) form of 64-bit is D or E for constants
 - Modified adjoint of exch with adjoint variables
   acuumulated.

1 C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/exch_send_put_y.F,v 1.1 1998/09/29 18:53:45 cnh Exp $
2 #include "CPP_EEOPTIONS.h"
3
4 SUBROUTINE EXCH_RL_SEND_PUT_Y( array,
5 I myOLw, myOLe, myOLs, myOLn, myNz,
6 I exchWidthX, exchWidthY,
7 I thesimulationMode, thecornerMode, myThid )
8 C /==========================================================\
9 C | SUBROUTINE SEND_PUT_Y |
10 C | o "Send" or "put" Y edges for RL array. |
11 C |==========================================================|
12 C | Routine that invokes actual message passing send or |
13 C | direct "put" of data to update Y faces of an XY[R] array.|
14 C \==========================================================/
15 IMPLICIT NONE
16
17 C == Global variables ==
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "EESUPPORT.h"
21 #include "EXCH.h"
22 C == Routine arguments ==
23 C array - Array with edges to exchange.
24 C myOLw - West, East, North and South overlap region sizes.
25 C myOLe
26 C myOLn
27 C myOLs
28 C exchWidthX - Width of data region exchanged.
29 C exchWidthY
30 C theSimulationMode - Forward or reverse mode exchange ( provides
31 C support for adjoint integration of code. )
32 C Note - the reverse mode for an assignment
33 C is an accumulation. This means that
34 C put implementations that do leary things
35 C like writing to overlap regions in a
36 C remote process need to be even more
37 C careful. You need to be pretty careful
38 C in forward mode too!
39 C theCornerMode - Flag indicating whether corner updates are
40 C needed.
41 C myThid - Thread number of this instance of S/R EXCH...
42 C eBl - Edge buffer level
43 INTEGER myOLw
44 INTEGER myOLe
45 INTEGER myOLs
46 INTEGER myOLn
47 INTEGER myNz
48 _RL array(1-myOLw:sNx+myOLe,
49 & 1-myOLs:sNy+myOLn,
50 & myNZ, nSx, nSy)
51 INTEGER exchWidthX
52 INTEGER exchWidthY
53 INTEGER theSimulationMode
54 INTEGER theCornerMode
55 INTEGER myThid
56 CEndOfInterface
57
58 C == Local variables ==
59 C I, J, K, jMin, jMax, iB - Loop counters and extents
60 C bi, bj
61 C biS, bjS - South tile indices
62 C biN, bjN - North tile indices
63 C eBl - Current exchange buffer level
64 C theProc, theTag, theType, - Variables used in message building
65 C theSize
66 C southCommMode - Working variables holding type
67 C northCommMode of communication a particular
68 C tile face uses.
69 INTEGER I, J, K, jMin, jMax, iMin, iMax, iB
70 INTEGER bi, bj, biS, bjS, biN, bjN
71 INTEGER eBl
72 INTEGER northCommMode
73 INTEGER southCommMode
74
75 #ifdef ALLOW_USE_MPI
76 INTEGER theProc, theTag, theType, theSize, mpiRc
77 #endif
78
79 C-- Write data to exchange buffer
80 C Various actions are possible depending on the communication mode
81 C as follows:
82 C Mode Action
83 C -------- ---------------------------
84 C COMM_NONE Do nothing
85 C
86 C COMM_MSG Message passing communication ( e.g. MPI )
87 C Fill south send buffer from this tile.
88 C Send data with tag identifying tile and direction.
89 C Fill north send buffer from this tile.
90 C Send data with tag identifying tile and direction.
91 C
92 C COMM_PUT "Put" communication ( UMP_, shmemput, etc... )
93 C Fill south receive buffer of south-neighbor tile
94 C Fill north receive buffer of north-neighbor tile
95 C Sync. memory
96 C Write data-ready Ack for north edge of south-neighbor
97 C tile
98 C Write data-ready Ack for south edge of north-neighbor
99 C tile
100 C Sync. memory
101 C
102 DO bj=myByLo(myThid),myByHi(myThid)
103 DO bi=myBxLo(myThid),myBxHi(myThid)
104
105 ebL = exchangeBufLevel(1,bi,bj)
106 southCommMode = _tileCommModeS(bi,bj)
107 northCommMode = _tileCommModeN(bi,bj)
108 biS = _tileBiS(bi,bj)
109 bjS = _tileBjS(bi,bj)
110 biN = _tileBiN(bi,bj)
111 bjN = _tileBjN(bi,bj)
112 iMin = 1
113 iMax = sNx
114 IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
115 iMin = 1-exchWidthX
116 iMax = sNx+exchWidthX
117 ENDIF
118
119 C o Send or Put south edge
120 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
121 jMin = 1
122 jMax = 1+exchWidthY-1
123 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
124 jMin = 1-exchWidthY
125 jMax = 0
126 ENDIF
127 IF ( southCommMode .EQ. COMM_MSG ) THEN
128 iB = 0
129 DO K=1,myNz
130 DO J=jMin,jMax
131 DO I=iMin,iMax
132 iB = iB + 1
133 southSendBuf_RL(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
134 ENDDO
135 ENDDO
136 ENDDO
137 C Send the data
138 #ifdef ALLOW_USE_MPI
139 #ifndef ALWAYS_USE_MPI
140 IF ( usingMPI ) THEN
141 #endif
142 theProc = tilePidS(bi,bj)
143 theTag = _tileTagSendS(bi,bj)
144 theSize = iB
145 theType = MPI_DOUBLE_PRECISION
146 exchNreqsY(1,bi,bj) = exchNreqsY(1,bi,bj)+1
147 CALL MPI_Isend(southSendBuf_RL(1,eBl,bi,bj), theSize, theType,
148 & theProc, theTag, MPI_COMM_WORLD,
149 & exchReqIdY(exchNreqsY(1,bi,bj),1,bi,bj), mpiRc)
150 #ifndef ALWAYS_USE_MPI
151 ENDIF
152 #endif
153 #endif /* ALLOW_USE_MPI */
154 northRecvAck(eBl,biS,bjS) = 1.
155 ELSEIF ( southCommMode .EQ. COMM_PUT ) THEN
156 iB = 0
157 DO K=1,myNz
158 DO J=jMin,jMax
159 DO I=iMin,iMax
160 iB = iB + 1
161 northRecvBuf_RL(iB,eBl,biS,bjS) = array(I,J,K,bi,bj)
162 ENDDO
163 ENDDO
164 ENDDO
165 ELSEIF ( southCommMode .NE. COMM_NONE
166 & .AND. southCommMode .NE. COMM_GET ) THEN
167 STOP ' S/R EXCH: Invalid commS mode.'
168 ENDIF
169
170 C o Send or Put north edge
171 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
172 jMin = sNy-exchWidthY+1
173 jMax = sNy
174 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
175 jMin = sNy+1
176 jMax = sNy+exchWidthY
177 ENDIF
178 IF ( northCommMode .EQ. COMM_MSG ) THEN
179 iB = 0
180 DO K=1,myNz
181 DO J=jMin,jMax
182 DO I=iMin,iMax
183 iB = iB + 1
184 northSendBuf_RL(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
185 ENDDO
186 ENDDO
187 ENDDO
188 C Send the data
189 #ifdef ALLOW_USE_MPI
190 #ifndef ALWAYS_USE_MPI
191 IF ( usingMPI ) THEN
192 #endif
193 theProc = tilePidN(bi,bj)
194 theTag = _tileTagSendN(bi,bj)
195 theSize = iB
196 theType = MPI_DOUBLE_PRECISION
197 exchNreqsY(1,bi,bj) = exchNreqsY(1,bi,bj)+1
198 CALL MPI_Isend(northSendBuf_RL(1,eBl,bi,bj), theSize, theType,
199 & theProc, theTag, MPI_COMM_WORLD,
200 & exchReqIdY(exchNreqsY(1,bi,bj),1,bi,bj), mpiRc )
201 #ifndef ALWAYS_USE_MPI
202 ENDIF
203 #endif
204 #endif /* ALLOW_USE_MPI */
205 southRecvAck(eBl,biN,bjN) = 1.
206 ELSEIF ( northCommMode .EQ. COMM_PUT ) THEN
207 iB = 0
208 DO K=1,myNz
209 DO J=jMin,jMax
210 DO I=iMin,iMax
211 iB = iB + 1
212 southRecvBuf_RL(iB,eBl,biN,bjN) = array(I,J,K,bi,bj)
213 ENDDO
214 ENDDO
215 ENDDO
216 ELSEIF ( northCommMode .NE. COMM_NONE
217 & .AND. northCommMode .NE. COMM_GET ) THEN
218 STOP ' S/R EXCH: Invalid commN mode.'
219 ENDIF
220
221 ENDDO
222 ENDDO
223
224 C-- Signal completetion ( making sure system-wide memory state is
225 C-- consistent ).
226
227 C ** NOTE ** We are relying on being able to produce strong-ordered
228 C memory semantics here. In other words we assume that there is a
229 C mechanism which can ensure that by the time the Ack is seen the
230 C overlap region data that will be exchanged is up to date.
231 IF ( exchNeedsMemSync ) CALL MEMSYNC
232
233 DO bj=myByLo(myThid),myByHi(myThid)
234 DO bi=myBxLo(myThid),myBxHi(myThid)
235 ebL = exchangeBufLevel(1,bi,bj)
236 biS = _tileBiS(bi,bj)
237 bjS = _tileBjS(bi,bj)
238 biN = _tileBiN(bi,bj)
239 bjN = _tileBjN(bi,bj)
240 southCommMode = _tileCommModeS(bi,bj)
241 northCommMode = _tileCommModeN(bi,bj)
242 IF ( southCommMode .EQ. COMM_PUT ) northRecvAck(eBl,biS,bjS) = 1.
243 IF ( northCommMode .EQ. COMM_PUT ) southRecvAck(eBl,biN,bjN) = 1.
244 IF ( southCommMode .EQ. COMM_GET ) northRecvAck(eBl,biS,bjS) = 1.
245 IF ( northCommMode .EQ. COMM_GET ) southRecvAck(eBl,biN,bjN) = 1.
246 ENDDO
247 ENDDO
248
249 C-- Make sure "ack" setting is seen system-wide.
250 C Here strong-ordering is not an issue but we want to make
251 C sure that processes that might spin on the above Ack settings
252 C will see the setting.
253 C ** NOTE ** On some machines we wont spin on the Ack setting
254 C ( particularly the T90 ), instead we will use s system barrier.
255 C On the T90 the system barrier is very fast and switches out the
256 C thread while it waits. On most machines the system barrier
257 C is much too slow and if we own the machine and have one thread
258 C per process preemption is not a problem.
259 IF ( exchNeedsMemSync ) CALL MEMSYNC
260
261 RETURN
262 END
263
264 SUBROUTINE EXCH_RS_SEND_PUT_Y( array,
265 I myOLw, myOLe, myOLs, myOLn, myNz,
266 I exchWidthX, exchWidthY,
267 I thesimulationMode, thecornerMode, myThid )
268 C /==========================================================\
269 C | SUBROUTINE SEND_PUT_Y |
270 C | o "Send" or "put" Y edges for RS array. |
271 C |==========================================================|
272 C | Routine that invokes actual message passing send or |
273 C | direct "put" of data to update Y faces of an XY[R] array.|
274 C \==========================================================/
275 IMPLICIT NONE
276
277 C == Global variables ==
278 #include "SIZE.h"
279 #include "EEPARAMS.h"
280 #include "EESUPPORT.h"
281 #include "EXCH.h"
282 C == Routine arguments ==
283 C array - Array with edges to exchange.
284 C myOLw - West, East, North and South overlap region sizes.
285 C myOLe
286 C myOLn
287 C myOLs
288 C exchWidthX - Width of data region exchanged.
289 C exchWidthY
290 C theSimulationMode - Forward or reverse mode exchange ( provides
291 C support for adjoint integration of code. )
292 C theCornerMode - Flag indicating whether corner updates are
293 C needed.
294 C myThid - Thread number of this instance of S/R EXCH...
295 C eBl - Edge buffer level
296 INTEGER myOLw
297 INTEGER myOLe
298 INTEGER myOLs
299 INTEGER myOLn
300 INTEGER myNz
301 _RS array(1-myOLw:sNx+myOLe,
302 & 1-myOLs:sNy+myOLn,
303 & myNZ, nSx, nSy)
304 INTEGER exchWidthX
305 INTEGER exchWidthY
306 INTEGER theSimulationMode
307 INTEGER theCornerMode
308 INTEGER myThid
309 CEndOfInterface
310
311 C == Local variables ==
312 C I, J, K, jMin, jMax, iB - Loop counters and extents
313 C bi, bj
314 C biS, bjS - South tile indices
315 C biN, bjN - North tile indices
316 C eBl - Current exchange buffer level
317 C theProc, theTag, theType, - Variables used in message building
318 C theSize
319 C southCommMode - Working variables holding type
320 C northCommMode of communication a particular
321 C tile face uses.
322 INTEGER I, J, K, jMin, jMax, iMin, iMax, iB
323 INTEGER bi, bj, biS, bjS, biN, bjN
324 INTEGER eBl
325 INTEGER northCommMode
326 INTEGER southCommMode
327
328 #ifdef ALLOW_USE_MPI
329 INTEGER theProc, theTag, theType, theSize, mpiRc
330 #endif
331
332 C-- Write data to exchange buffer
333 C Various actions are possible depending on the communication mode
334 C as follows:
335 C Mode Action
336 C -------- ---------------------------
337 C COMM_NONE Do nothing
338 C
339 C COMM_MSG Message passing communication ( e.g. MPI )
340 C Fill south send buffer from this tile.
341 C Send data with tag identifying tile and direction.
342 C Fill north send buffer from this tile.
343 C Send data with tag identifying tile and direction.
344 C
345 C COMM_PUT "Put" communication ( UMP_, shmemput, etc... )
346 C Fill south receive buffer of south-neighbor tile
347 C Fill north receive buffer of north-neighbor tile
348 C Sync. memory
349 C Write data-ready Ack for north edge of south-neighbor
350 C tile
351 C Write data-ready Ack for south edge of north-neighbor
352 C tile
353 C Sync. memory
354 C
355 DO bj=myByLo(myThid),myByHi(myThid)
356 DO bi=myBxLo(myThid),myBxHi(myThid)
357
358 ebL = exchangeBufLevel(1,bi,bj)
359 southCommMode = _tileCommModeS(bi,bj)
360 northCommMode = _tileCommModeN(bi,bj)
361 biS = _tileBiS(bi,bj)
362 bjS = _tileBjS(bi,bj)
363 biN = _tileBiN(bi,bj)
364 bjN = _tileBjN(bi,bj)
365 iMin = 1
366 iMax = sNx
367 IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
368 iMin = 1-exchWidthX
369 iMax = sNx+exchWidthX
370 ENDIF
371
372 C o Send or Put south edge
373 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
374 jMin = 1
375 jMax = 1+exchWidthY-1
376 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
377 jMin = 1-exchWidthY
378 jMax = 0
379 ENDIF
380 IF ( southCommMode .EQ. COMM_MSG ) THEN
381 iB = 0
382 DO K=1,myNz
383 DO J=jMin,jMax
384 DO I=iMin,iMax
385 iB = iB + 1
386 southSendBuf_RS(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
387 ENDDO
388 ENDDO
389 ENDDO
390 C Send the data
391 #ifdef ALLOW_USE_MPI
392 #ifndef ALWAYS_USE_MPI
393 IF ( usingMPI ) THEN
394 #endif
395 theProc = tilePidS(bi,bj)
396 theTag = _tileTagSendS(bi,bj)
397 theSize = iB
398 theType = MPI_DOUBLE_PRECISION
399 #ifdef RS_IS_REAL4
400 theType = MPI_REAL4
401 #endif
402 exchNreqsY(1,bi,bj) = exchNreqsY(1,bi,bj)+1
403 CALL MPI_Isend(southSendBuf_RS(1,eBl,bi,bj), theSize, theType,
404 & theProc, theTag, MPI_COMM_WORLD,
405 & exchReqIdY(exchNreqsY(1,bi,bj),1,bi,bj), mpiRc)
406 #ifndef ALWAYS_USE_MPI
407 ENDIF
408 #endif
409 #endif /* ALLOW_USE_MPI */
410 northRecvAck(eBl,biS,bjS) = 1.
411 ELSEIF ( southCommMode .EQ. COMM_PUT ) THEN
412 iB = 0
413 DO K=1,myNz
414 DO J=jMin,jMax
415 DO I=iMin,iMax
416 iB = iB + 1
417 northRecvBuf_RS(iB,eBl,biS,bjS) = array(I,J,K,bi,bj)
418 ENDDO
419 ENDDO
420 ENDDO
421 ELSEIF ( southCommMode .NE. COMM_NONE
422 & .AND. southCommMode .NE. COMM_GET ) THEN
423 STOP ' S/R EXCH: Invalid commS mode.'
424 ENDIF
425
426 C o Send or Put north edge
427 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
428 jMin = sNy-exchWidthY+1
429 jMax = sNy
430 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
431 jMin = sNy+1
432 jMax = sNy+exchWidthY
433 ENDIF
434 IF ( northCommMode .EQ. COMM_MSG ) THEN
435 iB = 0
436 DO K=1,myNz
437 DO J=jMin,jMax
438 DO I=iMin,iMax
439 iB = iB + 1
440 northSendBuf_RS(iB,eBl,bi,bj) = array(I,J,K,bi,bj)
441 ENDDO
442 ENDDO
443 ENDDO
444 C Send the data
445 #ifdef ALLOW_USE_MPI
446 #ifndef ALWAYS_USE_MPI
447 IF ( usingMPI ) THEN
448 #endif
449 theProc = tilePidN(bi,bj)
450 theTag = _tileTagSendN(bi,bj)
451 theSize = iB
452 theType = MPI_DOUBLE_PRECISION
453 #ifdef RS_IS_REAL4
454 theType = MPI_REAL4
455 #endif
456 exchNreqsY(1,bi,bj) = exchNreqsY(1,bi,bj)+1
457 CALL MPI_Isend(northSendBuf_RS(1,eBl,bi,bj), theSize, theType,
458 & theProc, theTag, MPI_COMM_WORLD,
459 & exchReqIdY(exchNreqsY(1,bi,bj),1,bi,bj), mpiRc )
460 #ifndef ALWAYS_USE_MPI
461 ENDIF
462 #endif
463 #endif /* ALLOW_USE_MPI */
464 southRecvAck(eBl,biN,bjN) = 1.
465 ELSEIF ( northCommMode .EQ. COMM_PUT ) THEN
466 iB = 0
467 DO K=1,myNz
468 DO J=jMin,jMax
469 DO I=iMin,iMax
470 iB = iB + 1
471 southRecvBuf_RS(iB,eBl,biN,bjN) = array(I,J,K,bi,bj)
472 ENDDO
473 ENDDO
474 ENDDO
475 ELSEIF ( northCommMode .NE. COMM_NONE
476 & .AND. northCommMode .NE. COMM_GET ) THEN
477 STOP ' S/R EXCH: Invalid commN mode.'
478 ENDIF
479
480 ENDDO
481 ENDDO
482
483 C-- Signal completetion ( making sure system-wide memory state is
484 C-- consistent ).
485
486 C ** NOTE ** We are relying on being able to produce strong-ordered
487 C memory semantics here. In other words we assume that there is a
488 C mechanism which can ensure that by the time the Ack is seen the
489 C overlap region data that will be exchanged is up to date.
490 IF ( exchNeedsMemSync ) CALL MEMSYNC
491
492 DO bj=myByLo(myThid),myByHi(myThid)
493 DO bi=myBxLo(myThid),myBxHi(myThid)
494 ebL = exchangeBufLevel(1,bi,bj)
495 biS = _tileBiS(bi,bj)
496 bjS = _tileBjS(bi,bj)
497 biN = _tileBiN(bi,bj)
498 bjN = _tileBjN(bi,bj)
499 southCommMode = _tileCommModeS(bi,bj)
500 northCommMode = _tileCommModeN(bi,bj)
501 IF ( southCommMode .EQ. COMM_PUT ) northRecvAck(eBl,biS,bjS) = 1.
502 IF ( northCommMode .EQ. COMM_PUT ) southRecvAck(eBl,biN,bjN) = 1.
503 IF ( southCommMode .EQ. COMM_GET ) northRecvAck(eBl,biS,bjS) = 1.
504 IF ( northCommMode .EQ. COMM_GET ) southRecvAck(eBl,biN,bjN) = 1.
505 ENDDO
506 ENDDO
507
508 C-- Make sure "ack" setting is seen system-wide.
509 C Here strong-ordering is not an issue but we want to make
510 C sure that processes that might spin on the above Ack settings
511 C will see the setting.
512 C ** NOTE ** On some machines we wont spin on the Ack setting
513 C ( particularly the T90 ), instead we will use s system barrier.
514 C On the T90 the system barrier is very fast and switches out the
515 C thread while it waits. On most machines the system barrier
516 C is much too slow and if we own the machine and have one thread
517 C per process preemption is not a problem.
518 IF ( exchNeedsMemSync ) CALL MEMSYNC
519
520 RETURN
521 END

  ViewVC Help
Powered by ViewVC 1.1.22