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

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

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

revision 1.1 by adcroft, Tue May 29 14:06:38 2001 UTC revision 1.12 by utke, Tue Jul 15 04:00:33 2008 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
4    
5    CBOP
6    C     !ROUTINE: EXCH_RX_RECV_GET_X
7    
8    C     !INTERFACE:
9        SUBROUTINE EXCH_RX_RECV_GET_X( array,        SUBROUTINE EXCH_RX_RECV_GET_X( array,
10       I            myOLw, myOLe, myOLs, myOLn, myNz,       I            myOLw, myOLe, myOLs, myOLn, myNz,
11       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
12       I            theSimulationMode, theCornerMode, myThid )       I            theSimulationMode, theCornerMode, myThid )
 C     /==========================================================\  
 C     | SUBROUTINE RECV_RX_GET_X                                 |  
 C     | o "Send" or "put" X edges for RX array.                  |  
 C     |==========================================================|  
 C     | Routine that invokes actual message passing send or      |  
 C     | direct "put" of data to update X faces of an XY[R] array.|  
 C     \==========================================================/  
13        IMPLICIT NONE        IMPLICIT NONE
14    
15    C     !DESCRIPTION:
16    C     *==========================================================*
17    C     | SUBROUTINE RECV_RX_GET_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    
24    C     !USES:
25  C     == Global variables ==  C     == Global variables ==
26  #include "SIZE.h"  #include "SIZE.h"
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "EESUPPORT.h"  #include "EESUPPORT.h"
29  #include "EXCH.h"  #include "EXCH.h"
30    
31    C     !INPUT/OUTPUT PARAMETERS:
32  C     == Routine arguments ==  C     == Routine arguments ==
33  C     array - Array with edges to exchange.  C     array :: Array with edges to exchange.
34  C     myOLw - West, East, North and South overlap region sizes.  C     myOLw :: West, East, North and South overlap region sizes.
35  C     myOLe  C     myOLe
36  C     myOLn  C     myOLn
37  C     myOLs  C     myOLs
38  C     exchWidthX - Width of data region exchanged.  C     exchWidthX :: Width of data region exchanged.
39  C     exchWidthY  C     exchWidthY
40  C     theSimulationMode - Forward or reverse mode exchange ( provides  C     theSimulationMode :: Forward or reverse mode exchange ( provides
41  C                         support for adjoint integration of code. )  C                         support for adjoint integration of code. )
42  C     theCornerMode     - Flag indicating whether corner updates are  C     theCornerMode     :: Flag indicating whether corner updates are
43  C                         needed.  C                         needed.
44  C     myThid            - Thread number of this instance of S/R EXCH...  C     myThid            :: Thread number of this instance of S/R EXCH...
45  C     eBl               - Edge buffer level  C     eBl               :: Edge buffer level
46        INTEGER myOLw        INTEGER myOLw
47        INTEGER myOLe        INTEGER myOLe
48        INTEGER myOLs        INTEGER myOLs
# Line 48  C     eBl               - Edge buffer le Line 56  C     eBl               - Edge buffer le
56        INTEGER theSimulationMode        INTEGER theSimulationMode
57        INTEGER theCornerMode        INTEGER theCornerMode
58        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
59    
60    C     !LOCAL VARIABLES:
61  C     == Local variables ==  C     == Local variables ==
62  C     I, J, K, iMin, iMax, iB    - Loop counters and extents  C     I, J, K, iMin, iMax, iB    :: Loop counters and extents
63  C     bi, bj  C     bi, bj
64  C     biW, bjW                   - West tile indices  C     biW, bjW                   :: West tile indices
65  C     biE, bjE                   - East tile indices  C     biE, bjE                   :: East tile indices
66  C     eBl                        - Current exchange buffer level  C     eBl                        :: Current exchange buffer level
67  C     theProc, theTag, theType,  - Variables used in message building  C     theProc, theTag, theType,  :: Variables used in message building
68  C     theSize  C     theSize
69  C     westCommMode               - Working variables holding type  C     westCommMode               :: Working variables holding type
70  C     eastCommMode                 of communication a particular  C     eastCommMode                  of communication a particular
71  C                                  tile face uses.  C                                   tile face uses.
72        INTEGER I, J, K, iMin, iMax, iB, iB0        INTEGER I, J, K, iMin, iMax, iB, iB0
73        INTEGER bi, bj, biW, bjW, biE, bjE        INTEGER bi, bj, biW, bjW, biE, bjE
74        INTEGER eBl        INTEGER eBl
# Line 68  C                                  tile Line 76  C                                  tile
76        INTEGER eastCommMode        INTEGER eastCommMode
77        INTEGER spinCount        INTEGER spinCount
78  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
79        INTEGER theProc, theTag, theType, theSize        INTEGER theProc, theTag, theType, theSize, pReqI
80        INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc        INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
81  #endif  #endif
82    CEOP
83    
84           INTEGER myBxLoSave(MAX_NO_THREADS)
85           INTEGER myBxHiSave(MAX_NO_THREADS)
86           INTEGER myByLoSave(MAX_NO_THREADS)
87           INTEGER myByHiSave(MAX_NO_THREADS)
88           LOGICAL doingSingleThreadedComms
89    
90           doingSingleThreadedComms = .FALSE.
91    #ifdef ALLOW_USE_MPI
92    #ifndef ALWAYS_USE_MPI
93          IF ( usingMPI ) THEN
94    #endif
95    C      Set default behavior to have MPI comms done by a single thread.
96    C      Most MPI implementations don't support concurrent comms from
97    C      several threads.
98           IF ( nThreads .GT. 1 ) THEN
99            _BARRIER
100            _BEGIN_MASTER( myThid )
101             DO I=1,nThreads
102              myBxLoSave(I) = myBxLo(I)
103              myBxHiSave(I) = myBxHi(I)
104              myByLoSave(I) = myByLo(I)
105              myByHiSave(I) = myByHi(I)
106             ENDDO
107    C        Comment out loop below and myB[xy][Lo|Hi](1) settings below
108    C        if you want to get multi-threaded MPI comms.
109             DO I=1,nThreads
110              myBxLo(I) = 0
111              myBxHi(I) = -1
112              myByLo(I) = 0
113              myByHi(I) = -1
114             ENDDO
115             myBxLo(1) = 1
116             myBxHi(1) = nSx
117             myByLo(1) = 1
118             myByHi(1) = nSy
119             doingSingleThreadedComms = .TRUE.
120            _END_MASTER( myThid )
121            _BARRIER
122          ENDIF
123    #ifndef ALWAYS_USE_MPI
124          ENDIF
125    #endif
126    #endif
127    
128  C--   Under a "put" scenario we  C--   Under a "put" scenario we
129  C--     i. set completetion signal for buffer we put into.  C--     i. set completetion signal for buffer we put into.
# Line 100  C--   iii. Set data read flag + memory s Line 152  C--   iii. Set data read flag + memory s
152  #endif  #endif
153           theProc = tilePidW(bi,bj)           theProc = tilePidW(bi,bj)
154           theTag  = _tileTagRecvW(bi,bj)           theTag  = _tileTagRecvW(bi,bj)
155           theType = MPI_DOUBLE_PRECISION           theType = _MPI_TYPE_RX
156           theSize = sNy*exchWidthX*myNz           theSize = sNy*exchWidthX*myNz
157    # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
158           CALL MPI_Recv( westRecvBuf_RX(1,eBl,bi,bj), theSize, theType,           CALL MPI_Recv( westRecvBuf_RX(1,eBl,bi,bj), theSize, theType,
159       &                  theProc, theTag, MPI_COMM_MODEL,       &                  theProc, theTag, MPI_COMM_MODEL,
160       &                  mpiStatus, mpiRc )       &                  mpiStatus, mpiRc )
161    # else
162             pReqI=exchNReqsX(1,bi,bj)+1
163             CALL ampi_recv_RX(
164         & westRecvBuf_RX(1,eBl,bi,bj) ,
165         & theSize ,
166         & theType ,
167         & theProc ,
168         & theTag ,
169         & MPI_COMM_MODEL ,
170         & exchReqIdX(pReqI,1,bi,bj),
171         & exchNReqsX(1,bi,bj),
172         & mpiStatus ,
173         & mpiRc )
174    # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
175  #ifndef ALWAYS_USE_MPI  #ifndef ALWAYS_USE_MPI
176          ENDIF                          ENDIF                
177  #endif  #endif
# Line 117  C--   iii. Set data read flag + memory s Line 184  C--   iii. Set data read flag + memory s
184  #endif  #endif
185           theProc = tilePidE(bi,bj)           theProc = tilePidE(bi,bj)
186           theTag  = _tileTagRecvE(bi,bj)           theTag  = _tileTagRecvE(bi,bj)
187           theType = MPI_DOUBLE_PRECISION           theType = _MPI_TYPE_RX
188           theSize = sNy*exchWidthX*myNz           theSize = sNy*exchWidthX*myNz
189    # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
190           CALL MPI_Recv( eastRecvBuf_RX(1,eBl,bi,bj), theSize, theType,           CALL MPI_Recv( eastRecvBuf_RX(1,eBl,bi,bj), theSize, theType,
191       &                  theProc, theTag, MPI_COMM_MODEL,       &                  theProc, theTag, MPI_COMM_MODEL,
192       &                  mpiStatus, mpiRc )       &                  mpiStatus, mpiRc )
193    # else
194             pReqI=exchNReqsX(1,bi,bj)+1
195             CALL ampi_recv_RX(
196         & eastRecvBuf_RX(1,eBl,bi,bj) ,
197         & theSize ,
198         & theType ,
199         & theProc ,
200         & theTag ,
201         & MPI_COMM_MODEL ,
202         & exchReqIdX(pReqI,1,bi,bj),
203         & exchNReqsX(1,bi,bj),
204         & mpiStatus ,
205         & mpiRc )
206    # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
207  #ifndef ALWAYS_USE_MPI  #ifndef ALWAYS_USE_MPI
208          ENDIF                          ENDIF                
209  #endif  #endif
# Line 143  C        i.e. we only lock waiting for d Line 225  C        i.e. we only lock waiting for d
225           ebL = exchangeBufLevel(1,bi,bj)           ebL = exchangeBufLevel(1,bi,bj)
226           westCommMode = _tileCommModeW(bi,bj)           westCommMode = _tileCommModeW(bi,bj)
227           eastCommMode = _tileCommModeE(bi,bj)           eastCommMode = _tileCommModeE(bi,bj)
228    # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
229     10    CONTINUE     10    CONTINUE
230            CALL FOOL_THE_COMPILER            CALL FOOL_THE_COMPILER( spinCount )
231            spinCount = spinCount+1            spinCount = spinCount+1
232  C         IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN  C         IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
233  C          WRITE(*,*) ' eBl = ', ebl  C          WRITE(*,*) ' eBl = ', ebl
234  C          STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'  C          STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
235  C         ENDIF  C         ENDIF
236            IF ( westRecvAck(eBl,bi,bj) .EQ. 0. ) GOTO 10            IF ( westRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
237            IF ( eastRecvAck(eBl,bi,bj) .EQ. 0. ) GOTO 10            IF ( eastRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
238    # else
239             do while ((westRecvAck(eBl,bi,bj) .EQ. 0.
240         &             .or.
241         &              eastRecvAck(eBl,bi,bj) .EQ. 0. ))
242              CALL FOOL_THE_COMPILER( spinCount )
243              spinCount = spinCount+1
244             end do
245    # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
246  C        Clear outstanding requests  C        Clear outstanding requests
247           westRecvAck(eBl,bi,bj) = 0.           westRecvAck(eBl,bi,bj) = 0
248           eastRecvAck(eBl,bi,bj) = 0.           eastRecvAck(eBl,bi,bj) = 0
249    
250           IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN           IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
251  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
252  #ifndef ALWAYS_USE_MPI  #ifndef ALWAYS_USE_MPI
253           IF ( usingMPI ) THEN           IF ( usingMPI ) THEN
254  #endif  #endif
255    # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
256            CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),            CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
257       &                      mpiStatus, mpiRC )       &                      mpiStatus, mpiRC )
258    # else
259              CALL ampi_waitall(
260         & exchNReqsX(1,bi,bj),
261         & exchReqIdX(1,1,bi,bj),
262         & mpiStatus,
263         & mpiRC )
264    # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
265  #ifndef ALWAYS_USE_MPI  #ifndef ALWAYS_USE_MPI
266          ENDIF                          ENDIF                
267  #endif  #endif
# Line 309  C--   Read from the buffers Line 408  C--   Read from the buffers
408         ENDDO         ENDDO
409        ENDDO        ENDDO
410    
411          _BARRIER
412          IF ( doingSingleThreadedComms ) THEN
413    C      Restore saved settings that were stored to allow
414    C      single thred comms.
415           _BEGIN_MASTER(myThid)
416            DO I=1,nThreads
417             myBxLo(I) = myBxLoSave(I)
418             myBxHi(I) = myBxHiSave(I)
419             myByLo(I) = myByLoSave(I)
420             myByHi(I) = myByHiSave(I)
421            ENDDO
422           _END_MASTER(myThid)
423          ENDIF                
424          _BARRIER
425    
426        RETURN        RETURN
427        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22