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

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

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

revision 1.1 by afe, Fri Jan 9 20:46:09 2004 UTC revision 1.12 by jmc, Tue Sep 4 00:45:25 2012 UTC
# Line 1  Line 1 
1  #include "CPP_OPTIONS.h"  C $Header$
2    C $Name$
3    
4    #include "CPP_EEOPTIONS.h"
5    #include "W2_OPTIONS.h"
6    
7    CBOP 0
8    C !ROUTINE: EXCH2_RECV_RX2
9    
10    C !INTERFACE:
11        SUBROUTINE EXCH2_RECV_RX2(        SUBROUTINE EXCH2_RECV_RX2(
12       I       tIlo, tIhi, tiStride,       I       thisTile, nN,
13       I       tJlo, tJhi, tjStride,       I       e2BufrRecSize,
14       I       tKlo, tKhi, tkStride,       I       iBufr1, iBufr2,
15       I       thisTile, thisI, nN,       I       e2Bufr1_RX, e2Bufr2_RX,
16       I       e2Bufr1_RX, e2Bufr2_RX, e2BufrRecSize,       I       commSetting, myThid )
17       I       mnb, nt,  
18       U       array1,  C !DESCRIPTION:
19       I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,  C     Two components vector field Exchange:
20       U       array2,  C     Receive into buffer exchanged data from the source Process.
21       I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,  C     buffer data will be used to fill in the tile-edge overlap region.
      U       e2_msgHandles, myTiles,  
      I       commSetting,  
      I       myThid )  
22    
23    C !USES:
24        IMPLICIT NONE        IMPLICIT NONE
25    
26  C  #include "SIZE.h"
27  #include "W2_OPTIONS.h"  #include "EEPARAMS.h"
28    #include "EESUPPORT.h"
29    #include "W2_EXCH2_SIZE.h"
30  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
31    
32  #include "EEPARAMS.h"  C !INPUT/OUTPUT PARAMETERS:
       CHARACTER*(MAX_LEN_MBUF) messageBuffer  
 C  
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      :: receiving 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     iBufr1        :: number of buffer-1 elements to transfer
38  C     thisI                :: Index of the receiving tile within this process (used  C     iBufr2        :: number of buffer-2 elements to transfer
39  C                          :: to select buffer slots that are allowed).  C     e2Bufr1_RX    :: Data transport buffer array. This array is used in one of
40  C     nN                   :: Neighbour entry that we are processing  C     e2Bufr2_RX    :: two ways. For PUT communication the entry in the buffer
41  C     e2Bufr1_RX           :: Data transport buffer array. This array is used in one of  C                   :: associated with the source for this receive (determined
42  C                          :: two ways. For PUT communication the entry in the buffer  C                   :: from the opposing_send index) is read.
43  C                          :: associated with the source for this receive (determined  C                   :: For MSG communication the entry in the buffer associated
44  C                          :: from the opposing_send index) is read. For MSG communication  C                   :: with this neighbor of this tile is used as a receive
45  C                          :: the entry in the buffer associated with this neighbor of this  C                   :: location for loading a linear stream of bytes.
46  C                          :: tile is used as a receive location for loading a linear  C     commSetting   :: Mode of communication used to exchange with this neighbor
47  C                          :: stream of bytes.  C     myThid        :: my Thread Id. number
48  C     e2BufrRecSize        :: Number of elements in each entry of e2Bufr1_RX  
49  C     mnb                  :: Second dimension of e2Bufr1_RX        INTEGER thisTile, nN
50  C     nt                   :: Third dimension of e2Bufr1_RX        INTEGER e2BufrRecSize
51  C     array                :: Target array that this receive writes to.        INTEGER iBufr1, iBufr2
52  C     i1Lo, i1Hi           :: I coordinate bounds of target array        _RX     e2Bufr1_RX( e2BufrRecSize )
53  C     j1Lo, j1Hi           :: J coordinate bounds of target array        _RX     e2Bufr2_RX( e2BufrRecSize )
 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 i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi  
       INTEGER thisTile, nN, thisI  
       INTEGER e2BufrRecSize  
       INTEGER mnb, nt  
       _RX     e2Bufr1_RX( e2BufrRecSize, mnb, nt, 2 )  
       _RX     e2Bufr2_RX( e2BufrRecSize, mnb, nt, 2 )  
       _RX     array1(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)  
       _RX     array2(i2Lo:i2Hi,j2Lo:j2Hi,k2Lo:k2Hi)  
       INTEGER e2_msgHandles(2, mnb, nt)  
       INTEGER myThid  
       INTEGER myTiles(nt)  
54        CHARACTER commSetting        CHARACTER commSetting
55          INTEGER myThid
56    CEOP
57    
58    #ifdef ALLOW_USE_MPI
59    C !LOCAL VARIABLES:
60  C     == Local variables ==  C     == Local variables ==
61  C     itl, jtl, ktl  :: Loop counters  C     soT     :: Source tile Id. number
62  C                    :: itl etc... target local  C     oNb     :: Opposing send record number
63  C                    :: itc etc... target canonical        INTEGER soT
64  C                    :: isl etc... source local        INTEGER oNb
 C                    :: isc etc... source canonical  
       INTEGER itl, jtl, ktl  
       INTEGER itc, jtc, ktc  
       INTEGER isc, jsc, ksc  
       INTEGER isl, jsl, ksl  
 C     tt         :: Target tile  
 C     iBufr1     :: Buffer counter  
 C     iBufr2     ::  
       INTEGER tt  
       INTEGER iBufr1, iBufr2  
 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  
       INTEGER I, nri1, nrj1, nrk1  
       INTEGER    nri2, nrj2, nrk2  
       INTEGER itl1reduce, jtl1reduce  
       INTEGER itl2reduce, jtl2reduce  
65    
66  C     MPI setup  C     MPI setup
67  #include "SIZE.h"        INTEGER theTag1, theTag2, theType
 #include "EESUPPORT.h"  
       INTEGER theTag1, theSize1, theType  
       INTEGER theTag2, theSize2  
68        INTEGER sProc, tProc        INTEGER sProc, tProc
 #ifdef ALLOW_USE_MPI  
69        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc
70    #ifdef W2_E2_DEBUG_ON
71          CHARACTER*(MAX_LEN_MBUF) msgBuf
72  #endif  #endif
73    
74        tt=exch2_neighbourId(nN, thisTile )        soT = exch2_neighbourId(nN, thisTile )
75        oN=exch2_opposingSend_record(nN, thisTile )        oNb = exch2_opposingSend(nN, thisTile )
76        itl1reduce=0  
77        jtl1reduce=0  C     Handle receive end data transport according to communication mechanism
78        itl2reduce=0  C     between source and target tile
79        jtl2reduce=0        IF ( commSetting .EQ. 'M' ) THEN
       IF ( exch2_pi(1,oN,tt) .EQ. -1 ) itl1reduce=1  
       IF ( exch2_pj(1,oN,tt) .EQ. -1 ) itl1reduce=1  
       IF ( exch2_pi(2,oN,tt) .EQ. -1 ) jtl2reduce=1  
       IF ( exch2_pj(2,oN,tt) .EQ. -1 ) jtl2reduce=1  
   
 C     Handle receive end data transport according to communication mechanism between  
 C     source and target tile  
       IF     ( commSetting .EQ. 'P' ) 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_record(nN, thisTile )  
        mb = oN  
        ir = 1  
        DO I=1,nt  
         IF ( myTiles(I) .EQ. tt ) THEN  
          nb = I  
         ENDIF  
        ENDDO  
 C      Get data from e2Bufr(1,mb,nb)  
       ELSEIF ( commSetting .EQ. 'M' ) THEN  
 #ifdef ALLOW_USE_MPI  
80  C      Setup MPI stuff here  C      Setup MPI stuff here
81         nb = thisI         theTag1 = (soT-1)*W2_maxNeighbours*2 + oNb-1
82         mb = nN         theTag2 = (soT-1)*W2_maxNeighbours*2 + W2_maxNeighbours + oNb-1
83         ir = 2         tProc = W2_tileProc(thisTile)-1
84         theTag1 =  (tt-1)*MAX_NEIGHBOURS*2 + oN-1         sProc = W2_tileProc(soT)-1
85       &         + 10000*(         theType = _MPI_TYPE_RX
86       &            (thisTile-1)*MAX_NEIGHBOURS*2 + oN-1         CALL MPI_Recv( e2Bufr1_RX, iBufr1, theType, sProc,
87       &           )       &                theTag1, MPI_COMM_MODEL, mpiStatus, mpiRc )
88         theTag2 =  (tt-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + oN-1         CALL MPI_Recv( e2Bufr2_RX, iBufr2, theType, sProc,
89       &         + 10000*(       &                theTag2, MPI_COMM_MODEL, mpiStatus, mpiRc )
      &            (thisTile-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + oN-1  
      &           )  
        tProc = exch2_tProc(thisTile)-1  
        sProc = exch2_tProc(tt)-1  
        theType = MPI_REAL8  
        nri1 = (tIhi-tIlo+1-itl1reduce)/tiStride  
        nrj1 = (tJhi-tJlo+1-jtl1reduce)/tjStride  
        nrk1 = (tKhi-tKlo+1)/tkStride  
        iBufr1 = nri1*nrj1*nrk1  
        nri2 = (tIhi-tIlo+1-itl2reduce)/tiStride  
        nrj2 = (tJhi-tJlo+1-jtl2reduce)/tjStride  
        nrk2 = (tKhi-tKlo+1)/tkStride  
        iBufr2 = nri2*nrj2*nrk2  
        CALL MPI_Recv( e2Bufr1_RX(1,mb,nb,ir), iBufr1, theType, sProc,  
      &               theTag1, MPI_COMM_MODEL, mpiStatus, mpiRc )  
        CALL MPI_Recv( e2Bufr2_RX(1,mb,nb,ir), iBufr2, theType, sProc,  
      &               theTag2, MPI_COMM_MODEL, mpiStatus, mpiRc )  
90  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
91         WRITE(messageBuffer,'(A,I4,A,I4,A)') ' RECV FROM TILE=', tt,         WRITE(msgBuf,'(A,I4,A,I4,A)')
92       &                                   ' (proc = ',sProc,')'       &   ' RECV FROM TILE=', soT, ' (proc = ',sProc,')'
93         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
94       I      standardMessageUnit,SQUEEZE_RIGHT,       I                     SQUEEZE_RIGHT, myThid )
95       I      myThid)         WRITE(msgBuf,'(A,I4,A,I4,A)')
96         WRITE(messageBuffer,'(A,I4,A,I4,A)') '      INTO TILE=', thisTile,       &   '  INTO TILE=', thisTile, ' (proc = ',tProc,')'
97       &                                   ' (proc = ',tProc,')'         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
98         CALL PRINT_MESSAGE(messageBuffer,       I                     SQUEEZE_RIGHT, myThid )
99       I      standardMessageUnit,SQUEEZE_RIGHT,         WRITE(msgBuf,'(A,I10)') '            TAG1=', theTag1
100       I      myThid)         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
101         WRITE(messageBuffer,'(A,I10)') '            TAG1=', theTag1       I                     SQUEEZE_RIGHT, myThid )
102         CALL PRINT_MESSAGE(messageBuffer,         WRITE(msgBuf,'(A,I4)')  '            NEL1=', iBufr1
103       I      standardMessageUnit,SQUEEZE_RIGHT,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
104       I      myThid)       I                     SQUEEZE_RIGHT, myThid )
105         WRITE(messageBuffer,'(A,I4)') '            NEL1=', iBufr1         WRITE(msgBuf,'(A,I10)') '            TAG2=', theTag2
106         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
107       I      standardMessageUnit,SQUEEZE_RIGHT,       I                     SQUEEZE_RIGHT, myThid )
108       I      myThid)         WRITE(msgBuf,'(A,I4)')  '            NEL2=', iBufr2
109         WRITE(messageBuffer,'(A,I10)') '            TAG2=', theTag2         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
110         CALL PRINT_MESSAGE(messageBuffer,       I                     SQUEEZE_RIGHT, myThid )
      I      standardMessageUnit,SQUEEZE_RIGHT,  
      I      myThid)  
        WRITE(messageBuffer,'(A,I4)') '            NEL2=', iBufr2  
        CALL PRINT_MESSAGE(messageBuffer,  
      I      standardMessageUnit,SQUEEZE_RIGHT,  
      I      myThid)  
111  #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_RX2:: commSetting VALUE IS INVALID'  
112        ENDIF        ENDIF
113    #endif /* ALLOW_USE_MPI */
114    
       iBufr1=0  
       DO ktl=tKlo,tKhi,tKStride  
        DO jtl=tJLo+jtl1reduce, tJHi, tjStride  
         DO itl=tILo+itl1reduce, tIHi, tiStride  
 C        Read from e2Bufr1_RX(iBufr,mb,nb)  
          iBufr1=iBufr1+1  
          array1(itl,jtl,ktl)=e2Bufr1_RX(iBufr1,mb,nb,ir)  
         ENDDO  
        ENDDO  
       ENDDO  
   
       iBufr2=0  
       DO ktl=tKlo,tKhi,tKStride  
        DO jtl=tJLo+jtl2reduce, tJHi, tjStride  
         DO itl=tILo+itl2reduce, tIHi, tiStride  
 C        Read from e2Bufr1_RX(iBufr,mb,nb)  
          iBufr2=iBufr2+1  
          array2(itl,jtl,ktl)=e2Bufr2_RX(iBufr2,mb,nb,ir)  
         ENDDO  
        ENDDO  
       ENDDO  
   
115        RETURN        RETURN
116        END        END
117    
118    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
119    
120    CEH3 ;;; Local Variables: ***
121    CEH3 ;;; mode:fortran ***
122    CEH3 ;;; End: ***
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22