/[MITgcm]/MITgcm/pkg/exch2/exch2_recv_rx1.template
ViewVC logotype

Diff of /MITgcm/pkg/exch2/exch2_recv_rx1.template

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

revision 1.9 by jmc, Wed May 20 21:01:45 2009 UTC revision 1.10 by jmc, Sat May 30 21:18:59 2009 UTC
# Line 4  C $Name$ Line 4  C $Name$
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5  #include "W2_OPTIONS.h"  #include "W2_OPTIONS.h"
6    
7    CBOP 0
8    C !ROUTINE: EXCH2_RECV_RX1
9    
10    C !INTERFACE:
11        SUBROUTINE EXCH2_RECV_RX1(        SUBROUTINE EXCH2_RECV_RX1(
12       I       tIlo, tIhi, tiStride,       I       thisTile, nN,
13       I       tJlo, tJhi, tjStride,       I       e2BufrRecSize,
14       I       tKlo, tKhi, tkStride,       I       iBufr,
15       I       thisTile, thisI, nN,       O       e2Bufr1_RX,
16       I       e2Bufr1_RX, e2BufrRecSize,       I       commSetting, myThid )
17       I       mnb, nt,  
18       U       array,  C !DESCRIPTION:
19       I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,  C     Scalar field (1 component) Exchange:
20       U       e2_msgHandles, myTiles,  C     Receive into buffer exchanged data from the source Process.
21       I       commSetting,  C     buffer data will be used to fill in the tile-edge overlap region.
      I       myThid )  
22    
23    C !USES:
24        IMPLICIT NONE        IMPLICIT NONE
25    
26  #include "SIZE.h"  #include "SIZE.h"
# Line 25  C $Name$ Line 29  C $Name$
29  #include "W2_EXCH2_SIZE.h"  #include "W2_EXCH2_SIZE.h"
30  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
31    
32    C !INPUT/OUTPUT PARAMETERS:
33  C     === Routine arguments ===  C     === Routine arguments ===
34  C     tIlo, tIhi, tIstride :: index range in I that will be filled in target "array"  C     thisTile      :: receiveing tile Id. number
35  C     tJlo, tJhi, tJstride :: index range in J that will be filled in target "array"  C     nN            :: Neighbour entry that we are processing
36  C     tKlo, tKhi, tKstride :: index range in K that will be filled in target "array"  C     e2BufrRecSize :: Number of elements in each entry of e2Bufr1_RX
37  C     thisTile             :: Rank of the receiveing tile  C     iBufr         :: number of buffer elements to transfert
38  C     thisI                :: Index of the receiving tile within this process (used  C     e2Bufr1_RX    :: Data transport buffer array. This array is used in one of
39  C                          :: to select buffer slots that are allowed).  C                   :: two ways. For PUT communication the entry in the buffer
40  C     nN                   :: Neighbour entry that we are processing  C                   :: associated with the source for this receive (determined
41  C     e2Bufr1_RX           :: Data transport buffer array. This array is used in one of  C                   :: from the opposing_send index) is read.
42  C                          :: two ways. For PUT communication the entry in the buffer  C                   :: For MSG communication the entry in the buffer associated
43  C                          :: associated with the source for this receive (determined  C                   :: with this neighbor of this tile is used as a receive
44  C                          :: from the opposing_send index) is read. For MSG communication  C                   :: location for loading a linear stream of bytes.
45  C                          :: the entry in the buffer associated with this neighbor of this  C     commSetting   :: Mode of communication used to exchange with this neighbor
46  C                          :: tile is used as a receive location for loading a linear  C     myThid        :: my Thread Id. number
47  C                          :: stream of bytes.  
48  C     e2BufrRecSize        :: Number of elements in each entry of e2Bufr1_RX        INTEGER thisTile, nN
 C     mnb                  :: Second dimension of e2Bufr1_RX  
 C     nt                   :: Third dimension of e2Bufr1_RX  
 C     array                :: Target array that this receive writes to.  
 C     i1Lo, i1Hi           :: I coordinate bounds of target array  
 C     j1Lo, j1Hi           :: J coordinate bounds of target array  
 C     k1Lo, k1Hi           :: K coordinate bounds of target array  
 C     e2_msgHandles        :: Synchronization and coordination data structure used to coordinate access  
 C                          :: to e2Bufr1_RX or to regulate message buffering. In PUT communication  
 C                          :: sender will increment handle entry once data is ready in buffer.  
 C                          :: Receiver will decrement handle once data is consumed from buffer. For  
 C                          :: MPI MSG communication MPI_Wait uses hanlde to check Isend has cleared.  
 C                          :: This is done in routine after receives.  
 C     myTiles              :: List of nt tiles that this process owns.  
 C     commSetting          :: Mode of communication used to exchnage with this neighbor  
 C     myThid               :: Thread number of this instance of EXCH2_RECV_RX1  
 C  
       INTEGER tILo, tIHi, tiStride  
       INTEGER tJLo, tJHi, tjStride  
       INTEGER tKLo, tKHi, tkStride  
       INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi  
       INTEGER thisTile, nN, thisI  
49        INTEGER e2BufrRecSize        INTEGER e2BufrRecSize
50        INTEGER mnb, nt        INTEGER iBufr
51        _RX     e2Bufr1_RX( e2BufrRecSize, mnb, nt, 2 )        _RX     e2Bufr1_RX( e2BufrRecSize )
       _RX     array(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)  
       INTEGER e2_msgHandles(mnb, nt)  
       INTEGER myThid  
       INTEGER myTiles(nt)  
52        CHARACTER commSetting        CHARACTER commSetting
53          INTEGER myThid
54    CEOP
55    
56    #ifdef ALLOW_USE_MPI
57    C !LOCAL VARIABLES:
58  C     == Local variables ==  C     == Local variables ==
59  C     itl, jtl, ktl  :: Loop counters  C     soT     :: Source tile Id. number
60  C                    :: itl etc... target local  C     oNb     :: Opposing send record number
61  C                    :: itc etc... target canonical        INTEGER soT
62  C                    :: isl etc... source local        INTEGER oNb
 C                    :: isc etc... source canonical  
       INTEGER itl, jtl, ktl  
 c     INTEGER itc, jtc, ktc  
 c     INTEGER isc, jsc, ksc  
 c     INTEGER isl, jsl, ksl  
 C     tt         :: Target tile  
 C     iBufr      :: Buffer counter  
       INTEGER tt  
       INTEGER iBufr  
 C     mb, nb :: Selects e2Bufr, msgHandle record to use  
 C     ir     ::  
       INTEGER mb, nb, ir  
 C     oN     :: Opposing send record number  
       INTEGER oN  
 C     Loop counters  
 c     INTEGER I, nri, nrj, nrk  
       INTEGER I  
63    
64  C     MPI setup  C     MPI setup
 #ifdef ALLOW_USE_MPI  
 c     INTEGER theTag, theSize, theType  
65        INTEGER theTag, theType        INTEGER theTag, theType
66        INTEGER sProc, tProc        INTEGER sProc, tProc
       INTEGER nri, nrj, nrk  
67        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc
68  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
69        CHARACTER*(MAX_LEN_MBUF) messageBuffer        CHARACTER*(MAX_LEN_MBUF) msgBuf
 #endif  
70  #endif  #endif
71    
72        tt=exch2_neighbourId(nN, thisTile )        soT = exch2_neighbourId(nN, thisTile )
73        oN=exch2_opposingSend(nN, thisTile )        oNb = exch2_opposingSend(nN, thisTile )
74    
75  C     Handle receive end data transport according to communication mechanism between  C     Handle receive end data transport according to communication mechanism
76  C     source and target tile  C     between source and target tile
77        IF     ( commSetting .EQ. 'P' ) THEN        IF ( commSetting .EQ. 'M' ) THEN
 C      1 Need to check and spin on data ready assertion for multithreaded mode, for now do nothing i.e.  
 C        assume only one thread per process.  
   
 C      2 Need to set e2Bufr to use put buffer from opposing send.  
        oN = exch2_opposingSend(nN, thisTile )  
        mb = oN  
        DO I=1,nt  
         IF ( myTiles(I) .EQ. tt ) THEN  
          nb = I  
          ir = 1  
         ENDIF  
        ENDDO  
 C      Get data from e2Bufr(1,mb,nb)  
       ELSEIF ( commSetting .EQ. 'M' ) THEN  
 #ifdef ALLOW_USE_MPI  
78  C      Setup MPI stuff here  C      Setup MPI stuff here
79         nb = thisI         theTag =  (soT-1)*W2_maxNeighbours + oNb
        mb = nN  
        ir = 2  
        theTag =  (tt-1)*W2_maxNeighbours + oN  
80         tProc = exch2_tProc(thisTile)-1         tProc = exch2_tProc(thisTile)-1
81         sProc = exch2_tProc(tt)-1         sProc = exch2_tProc(soT)-1
82         theType = _MPI_TYPE_RX         theType = _MPI_TYPE_RX
83         nri = (tIhi-tIlo+1)/tiStride         CALL MPI_Recv( e2Bufr1_RX, iBufr, theType, sProc,
84         nrj = (tJhi-tJlo+1)/tjStride       &                theTag, MPI_COMM_MODEL, mpiStatus, mpiRc )
        nrk = (tKhi-tKlo+1)/tkStride  
        iBufr = nri*nrj*nrk  
        CALL MPI_Recv( e2Bufr1_RX(1,mb,nb,ir), iBufr, theType, sProc,  
      &               theTag, MPI_COMM_MODEL, mpiStatus, mpiRc )  
85  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
86         WRITE(messageBuffer,'(A,I4,A,I4,A)') ' RECV FROM TILE=', tt,         WRITE(msgBuf,'(A,I4,A,I4,A)')
87       &                                   ' (proc = ',sProc,')'       &   ' RECV FROM TILE=', soT, ' (proc = ',sProc,')'
88         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
89       I      standardMessageUnit,SQUEEZE_RIGHT,       I                     SQUEEZE_RIGHT, myThid )
90       I      myThid)         WRITE(msgBuf,'(A,I4,A,I4,A)')
91         WRITE(messageBuffer,'(A,I4,A,I4,A)') '  INTO TILE=', thisTile,       &   '  INTO TILE=', thisTile, ' (proc = ',tProc,')'
92       &                                   ' (proc = ',tProc,')'         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
93         CALL PRINT_MESSAGE(messageBuffer,       I                     SQUEEZE_RIGHT, myThid )
94       I      standardMessageUnit,SQUEEZE_RIGHT,         WRITE(msgBuf,'(A,I10)') '            TAG=', theTag
95       I      myThid)         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
96         WRITE(messageBuffer,'(A,I10)') '            TAG=', theTag       I                     SQUEEZE_RIGHT, myThid )
97         CALL PRINT_MESSAGE(messageBuffer,         WRITE(msgBuf,'(A,I4)')  '            NEL=', iBufr
98       I      standardMessageUnit,SQUEEZE_RIGHT,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
99       I      myThid)       I                     SQUEEZE_RIGHT, myThid )
        WRITE(messageBuffer,'(A,I4)') '            NEL=', iBufr  
        CALL PRINT_MESSAGE(messageBuffer,  
      I      standardMessageUnit,SQUEEZE_RIGHT,  
      I      myThid)  
100  #endif /* W2_E2_DEBUG_ON */  #endif /* W2_E2_DEBUG_ON */
 C      Set mb to neighbour entry  
 C      Set nt to this tiles rank  
        mb = nN  
 #endif  
       ELSE  
        STOP 'EXCH2_RECV_RX1:: commSetting VALUE IS INVALID'  
101        ENDIF        ENDIF
102    #endif /* ALLOW_USE_MPI */
       iBufr=0  
       DO ktl=tKlo,tKhi,tKStride  
        DO jtl=tJLo, tJHi, tjStride  
         DO itl=tILo, tIHi, tiStride  
 C        Read from e2Bufr1_RX(iBufr,mb,nb)  
          iBufr=iBufr+1  
          array(itl,jtl,ktl)=e2Bufr1_RX(iBufr,mb,nb,ir)  
         ENDDO  
        ENDDO  
       ENDDO  
103    
104        RETURN        RETURN
105        END        END
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22