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