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

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

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

revision 1.2 by cnh, Fri Sep 21 03:55:50 2001 UTC revision 1.11 by utke, Wed Apr 9 22:33:42 2008 UTC
# Line 77  C                                   tile Line 77  C                                   tile
77    
78  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
79        INTEGER theProc, theTag, theType, theSize, mpiRc        INTEGER theProc, theTag, theType, theSize, mpiRc
80    # ifdef ALLOW_AUTODIFF_OPENAD
81          INTEGER mpiStatus(MPI_STATUS_SIZE)
82          INTEGER pReqI
83    # endif
84  #endif  #endif
85  C--   Write data to exchange buffer  C--   Write data to exchange buffer
86  C     Various actions are possible depending on the communication mode  C     Various actions are possible depending on the communication mode
# Line 103  C                Sync. memory Line 107  C                Sync. memory
107  C        C      
108  CEOP  CEOP
109    
110           INTEGER myBxLoSave(MAX_NO_THREADS)
111           INTEGER myBxHiSave(MAX_NO_THREADS)
112           INTEGER myByLoSave(MAX_NO_THREADS)
113           INTEGER myByHiSave(MAX_NO_THREADS)
114           LOGICAL doingSingleThreadedComms
115    
116           doingSingleThreadedComms = .FALSE.
117    #ifdef ALLOW_USE_MPI
118    #ifndef ALWAYS_USE_MPI
119          IF ( usingMPI ) THEN
120    #endif
121    C      Set default behavior to have MPI comms done by a single thread.
122    C      Most MPI implementations don't support concurrent comms from
123    C      several threads.
124           IF ( nThreads .GT. 1 ) THEN
125            _BARRIER
126            _BEGIN_MASTER( myThid )
127             DO I=1,nThreads
128              myBxLoSave(I) = myBxLo(I)
129              myBxHiSave(I) = myBxHi(I)
130              myByLoSave(I) = myByLo(I)
131              myByHiSave(I) = myByHi(I)
132             ENDDO
133    C        Comment out loop below and myB[xy][Lo|Hi](1) settings below
134    C        if you want to get multi-threaded MPI comms.
135             DO I=1,nThreads
136              myBxLo(I) = 0
137              myBxHi(I) = -1
138              myByLo(I) = 0
139              myByHi(I) = -1
140             ENDDO
141             myBxLo(1) = 1
142             myBxHi(1) = nSx
143             myByLo(1) = 1
144             myByHi(1) = nSy
145             doingSingleThreadedComms = .TRUE.
146            _END_MASTER( myThid )
147            _BARRIER
148          ENDIF
149    #ifndef ALWAYS_USE_MPI
150          ENDIF
151    #endif
152    #endif
153    
154    #ifdef ALLOW_AUTODIFF_OPENAD
155    # ifdef ALLOW_USE_MPI
156          DO bj=myByLo(myThid),myByHi(myThid)
157           DO bi=myBxLo(myThid),myBxHi(myThid)
158    
159    #  ifndef ALWAYS_USE_MPI
160             IF ( usingMPI ) THEN
161    #  endif
162              CALL ampi_awaitall (
163         & exchNReqsX(1,bi,bj) ,
164         & exchReqIdX(1,1,bi,bj) ,
165         & mpiStatus ,
166         & mpiRC )
167    #  ifndef ALWAYS_USE_MPI
168             ENDIF
169    #  endif
170           ENDDO
171          ENDDO
172    # endif
173    #endif
174        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
175         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
176    
# Line 140  C        Send the data Line 208  C        Send the data
208           theProc = tilePidW(bi,bj)           theProc = tilePidW(bi,bj)
209           theTag  = _tileTagSendW(bi,bj)           theTag  = _tileTagSendW(bi,bj)
210           theSize = iB           theSize = iB
211           theType = MPI_DOUBLE_PRECISION           theType = _MPI_TYPE_RX
212    # ifndef ALLOW_AUTODIFF_OPENAD
213           exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1           exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
214           CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,           CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,
215       &                  theProc, theTag, MPI_COMM_MODEL,       &                  theProc, theTag, MPI_COMM_MODEL,
216       &                  exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )       &                  exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
217    # else
218             pReqI=exchNReqsX(1,bi,bj)+1
219             CALL ampi_isend_RX(
220         & westSendBuf_RX(1,eBl,bi,bj),
221         & theSize,
222         & theType,
223         & theProc,
224         & theTag,
225         & MPI_COMM_MODEL,
226         & exchReqIdX(pReqI,1,bi,bj),
227         & exchNReqsX(1,bi,bj),
228         & mpiStatus ,
229         & mpiRc )
230    # endif /* ALLOW_AUTODIFF_OPENAD */
231  #ifndef ALWAYS_USE_MPI  #ifndef ALWAYS_USE_MPI
232           ENDIF           ENDIF
233  #endif  #endif
234  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
235           eastRecvAck(eBl,biW,bjW) = 1.           eastRecvAck(eBl,biW,bjW) = 1
236          ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN          ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN
237           iB  = 0           iB  = 0
238           DO K=1,myNz           DO K=1,myNz
# Line 186  C        Send the data Line 269  C        Send the data
269           theProc = tilePidE(bi,bj)           theProc = tilePidE(bi,bj)
270           theTag  = _tileTagSendE(bi,bj)           theTag  = _tileTagSendE(bi,bj)
271           theSize = iB           theSize = iB
272           theType = MPI_DOUBLE_PRECISION           theType = _MPI_TYPE_RX
273    # ifndef ALLOW_AUTODIFF_OPENAD
274           exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1           exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
275           CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,           CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,
276       &                  theProc, theTag, MPI_COMM_MODEL,       &                  theProc, theTag, MPI_COMM_MODEL,
277       &                  exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )       &                  exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )
278    # else
279             pReqI=exchNReqsX(1,bi,bj)+1
280             CALL ampi_isend_RX(
281         & eastSendBuf_RX(1,eBl,bi,bj) ,
282         & theSize ,
283         & theType ,
284         & theProc ,
285         & theTag ,
286         & MPI_COMM_MODEL ,
287         & exchReqIdX(pReqI,1,bi,bj) ,
288         & exchNReqsX(1,bi,bj),
289         & mpiStatus ,
290         & mpiRc  )
291    # endif /* ALLOW_AUTODIFF_OPENAD */
292  #ifndef ALWAYS_USE_MPI  #ifndef ALWAYS_USE_MPI
293           ENDIF           ENDIF
294  #endif  #endif
295  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
296           westRecvAck(eBl,biE,bjE) = 1.           westRecvAck(eBl,biE,bjE) = 1
297          ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN          ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN
298           iB  = 0           iB  = 0
299           DO K=1,myNz           DO K=1,myNz
# Line 210  C        Send the data Line 308  C        Send the data
308       &   .AND.   eastCommMode .NE. COMM_GET  ) THEN       &   .AND.   eastCommMode .NE. COMM_GET  ) THEN
309           STOP ' S/R EXCH: Invalid commE mode.'           STOP ' S/R EXCH: Invalid commE mode.'
310          ENDIF          ENDIF
311    
312  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
313  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
314  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
# Line 235  C        Send the data Line 334  C        Send the data
334           theProc = tilePidW(bi,bj)           theProc = tilePidW(bi,bj)
335           theTag  = _tileTagSendW(bi,bj)           theTag  = _tileTagSendW(bi,bj)
336           theSize = iB           theSize = iB
337           theType = MPI_DOUBLE_PRECISION           theType = _MPI_TYPE_RX
338           exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1           exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
339           CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,           CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,
340       &                  theProc, theTag, MPI_COMM_MODEL,       &                  theProc, theTag, MPI_COMM_MODEL,
# Line 244  C        Send the data Line 343  C        Send the data
343           ENDIF           ENDIF
344  #endif  #endif
345  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
346           eastRecvAck(eBl,biW,bjW) = 1.           eastRecvAck(eBl,biW,bjW) = 1
347          ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN          ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN
348           iB  = 0           iB  = 0
349           DO K=1,myNz           DO K=1,myNz
# Line 283  C        Send the data Line 382  C        Send the data
382           theProc = tilePidE(bi,bj)           theProc = tilePidE(bi,bj)
383           theTag  = _tileTagSendE(bi,bj)           theTag  = _tileTagSendE(bi,bj)
384           theSize = iB           theSize = iB
385           theType = MPI_DOUBLE_PRECISION           theType = _MPI_TYPE_RX
386           exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1           exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
387           CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,           CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,
388       &                  theProc, theTag, MPI_COMM_MODEL,       &                  theProc, theTag, MPI_COMM_MODEL,
# Line 292  C        Send the data Line 391  C        Send the data
391           ENDIF           ENDIF
392  #endif  #endif
393  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
394           westRecvAck(eBl,biE,bjE) = 1.           westRecvAck(eBl,biE,bjE) = 1
395          ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN          ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN
396           iB  = 0           iB  = 0
397           DO K=1,myNz           DO K=1,myNz
# Line 332  C     overlap region data that will be e Line 431  C     overlap region data that will be e
431          bjW = _tileBjW(bi,bj)          bjW = _tileBjW(bi,bj)
432          westCommMode = _tileCommModeW(bi,bj)          westCommMode = _tileCommModeW(bi,bj)
433          eastCommMode = _tileCommModeE(bi,bj)          eastCommMode = _tileCommModeE(bi,bj)
434          IF ( westCommMode .EQ. COMM_PUT ) eastRecvAck(eBl,biW,bjW) = 1.          IF ( westCommMode.EQ.COMM_PUT ) eastRecvAck(eBl,biW,bjW) = 1
435          IF ( eastCommMode .EQ. COMM_PUT ) westRecvAck(eBl,biE,bjE) = 1.          IF ( eastCommMode.EQ.COMM_PUT ) westRecvAck(eBl,biE,bjE) = 1
436          IF ( westCommMode .EQ. COMM_GET ) eastRecvAck(eBl,biW,bjW) = 1.          IF ( westCommMode.EQ.COMM_GET ) eastRecvAck(eBl,biW,bjW) = 1
437          IF ( eastCommMode .EQ. COMM_GET ) westRecvAck(eBl,biE,bjE) = 1.          IF ( eastCommMode.EQ.COMM_GET ) westRecvAck(eBl,biE,bjE) = 1
438         ENDDO         ENDDO
439        ENDDO        ENDDO
440    
# Line 351  C     is much too slow and if we own the Line 450  C     is much too slow and if we own the
450  C     per process preemption is not a problem.  C     per process preemption is not a problem.
451        IF ( exchNeedsMemSync  ) CALL MEMSYNC        IF ( exchNeedsMemSync  ) CALL MEMSYNC
452    
453          _BARRIER
454          IF ( doingSingleThreadedComms ) THEN
455    C      Restore saved settings that were stored to allow
456    C      single thred comms.
457           _BEGIN_MASTER(myThid)
458            DO I=1,nThreads
459             myBxLo(I) = myBxLoSave(I)
460             myBxHi(I) = myBxHiSave(I)
461             myByLo(I) = myByLoSave(I)
462             myByHi(I) = myByHiSave(I)
463            ENDDO
464           _END_MASTER(myThid)
465          ENDIF                
466          _BARRIER
467    
468        RETURN        RETURN
469        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22