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

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

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

revision 1.10 by jmc, Wed May 20 21:01:45 2009 UTC revision 1.11 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_SEND_RX1
9    
10    C !INTERFACE:
11        SUBROUTINE EXCH2_SEND_RX1 (        SUBROUTINE EXCH2_SEND_RX1 (
      I       tIlo, tIhi, tiStride,  
      I       tJlo, tJhi, tjStride,  
      I       tKlo, tKhi, tkStride,  
12       I       thisTile, nN,       I       thisTile, nN,
13       I       e2Bufr1_RX, e2BufrRecSize,       I       e2BufrRecSize,
14       I       array,       I       iBufr,
15       I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,       I       e2Bufr1_RX,
16       O       e2_msgHandle,       O       e2_msgHandle,
17       I       commSetting, myThid )       I       commSetting, myThid )
18    
19    C !DESCRIPTION:
20    C     Scalar field (1 component) Exchange:
21    C     Send buffer to the target Process.
22    C     buffer has been previously filled with interior data point
23    C     corresponding to the target-neighbour-edge overlap region.
24    
25    C !USES:
26        IMPLICIT NONE        IMPLICIT NONE
27    
28  #include "SIZE.h"  #include "SIZE.h"
# Line 23  C $Name$ Line 31  C $Name$
31  #include "W2_EXCH2_SIZE.h"  #include "W2_EXCH2_SIZE.h"
32  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
33    
34    C !INPUT/OUTPUT PARAMETERS:
35  C     === Routine arguments ===  C     === Routine arguments ===
36        INTEGER tILo, tIHi, tiStride  C     thisTile      :: sending tile Id. number
37        INTEGER tJLo, tJHi, tjStride  C     nN            :: Neighbour entry that we are processing
38        INTEGER tKLo, tKHi, tkStride  C     e2BufrRecSize :: Number of elements in each entry of e2Bufr1_RX
39        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi  C     iBufr         :: number of buffer elements to transfert
40    C     e2Bufr1_RX    :: Data transport buffer array. This array is used in one of
41    C                   :: two ways. For PUT communication the entry in the buffer
42    C                   :: associated with the source for this receive (determined
43    C                   :: from the opposing_send index) is read.
44    C                   :: For MSG communication the entry in the buffer associated
45    C                   :: with this neighbor of this tile is used as a receive
46    C                   :: location for loading a linear stream of bytes.
47    C     e2_msgHandles :: Synchronization and coordination data structure used to
48    C                   :: coordinate access to e2Bufr1_RX or to regulate message
49    C                   :: buffering. In PUT communication sender will increment
50    C                   :: handle entry once data is ready in buffer. Receiver will
51    C                   :: decrement handle once data is consumed from buffer.
52    C                   :: For MPI MSG communication MPI_Wait uses hanlde to check
53    C                   :: Isend has cleared. This is done in routine after receives.
54    C     commSetting   :: Mode of communication used to exchange with this neighbor
55    C     myThid        :: my Thread Id. number
56    
57        INTEGER thisTile, nN        INTEGER thisTile, nN
58        INTEGER e2BufrRecSize        INTEGER e2BufrRecSize
59          INTEGER iBufr
60        _RX     e2Bufr1_RX( e2BufrRecSize )        _RX     e2Bufr1_RX( e2BufrRecSize )
       _RX     array(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)  
61        INTEGER e2_msgHandle(1)        INTEGER e2_msgHandle(1)
       INTEGER myThid  
62        CHARACTER commSetting        CHARACTER commSetting
63          INTEGER myThid
64    CEOP
65    
66    #ifdef ALLOW_USE_MPI
67    C !LOCAL VARIABLES:
68  C     == Local variables ==  C     == Local variables ==
69  C     itl, jtl, ktl  :: Loop counters  C     tgT         :: Target tile
70  C                    :: itl etc... target local        INTEGER  tgT
 C                    :: itc etc... target canonical  
 C                    :: isl etc... source local  
 C                    :: isc etc... source canonical  
       INTEGER itl, jtl, ktl  
       INTEGER itc, jtc  
       INTEGER isc, jsc  
       INTEGER isl, jsl  
 c     INTEGER ktc, ksc, ksl  
 C     tt         :: Target tile  
 C     itb, jtb   :: Target local to canonical offsets  
 C  
       INTEGER  tt  
       INTEGER itb, jtb  
       INTEGER isb, jsb  
       INTEGER pi(2), pj(2), oi, oj  
       INTEGER iBufr  
71    
72  C     MPI setup  C     MPI setup
 #ifdef ALLOW_USE_MPI  
73        INTEGER theTag, theType, theHandle        INTEGER theTag, theType, theHandle
74        INTEGER sProc, tProc, mpiRc        INTEGER sProc, tProc, mpiRc
 #endif  
75  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
76        CHARACTER*(MAX_LEN_MBUF) messageBuffer        CHARACTER*(MAX_LEN_MBUF) msgBuf
77  #endif  #endif
78    
79        IF     ( commSetting .EQ. 'P' ) THEN        tgT = exch2_neighbourId(nN, thisTile )
 C      Need to check that buffer synchronisation token is decremented  
 C      before filling buffer.  
       ENDIF  
80    
81        tt=exch2_neighbourId(nN, thisTile )  C     Do data transport depending on communication mechanism between
82        itb=exch2_tBasex(tt)  C     source and target tile
83        jtb=exch2_tBasey(tt)        IF ( commSetting .EQ. 'M' ) THEN
       isb=exch2_tBasex(thisTile)  
       jsb=exch2_tBasey(thisTile)  
       pi(1)=exch2_pij(1,nN,thisTile)  
       pi(2)=exch2_pij(2,nN,thisTile)  
       pj(1)=exch2_pij(3,nN,thisTile)  
       pj(2)=exch2_pij(4,nN,thisTile)  
       oi=exch2_oi(nN,thisTile)  
       oj=exch2_oj(nN,thisTile)  
       iBufr=0  
 #ifdef W2_E2_DEBUG_ON  
       WRITE(messageBuffer,'(A,I4,A,I4)') 'EXCH2_SEND_RX1 sourceTile= ',  
      &                                    thisTile,  
      &                                   'targetTile= ',tt  
       CALL PRINT_MESSAGE(messageBuffer,  
      I      standardMessageUnit,SQUEEZE_BOTH,  
      I      myThid)  
 #endif /* W2_E2_DEBUG_ON */  
       DO ktl=tKlo,tKhi,tKStride  
        DO jtl=tJLo, tJHi, tjStride  
         DO itl=tILo, tIHi, tiStride  
          iBufr=iBufr+1  
          itc=itl+itb  
          jtc=jtl+jtb  
          isc=pi(1)*itc+pi(2)*jtc+oi  
          jsc=pj(1)*itc+pj(2)*jtc+oj  
          isl=isc-isb  
          jsl=jsc-jsb  
          e2Bufr1_RX(iBufr)=array(isl,jsl,ktl)  
 #ifdef W2_E2_DEBUG_ON  
       WRITE(messageBuffer,'(A,2I4)')  
      &     'EXCH2_SEND_RX1 target t(itl,jtl) = ', itl, jtl  
          CALL PRINT_MESSAGE(messageBuffer,  
      I      standardMessageUnit,SQUEEZE_RIGHT,  
      I      myThid)  
          WRITE(messageBuffer,'(A,2I4)')  
      &           '               source  (isl,jsl) = ', isl, jsl  
          CALL PRINT_MESSAGE(messageBuffer,  
      I      standardMessageUnit,SQUEEZE_RIGHT,  
      I      myThid)  
          IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN  
           WRITE(messageBuffer,'(A,2I4)')  
      &        '              *** isl is out of bounds'  
           CALL PRINT_MESSAGE(messageBuffer,  
      I       standardMessageUnit,SQUEEZE_RIGHT,  
      I       myThid)  
          ENDIF  
          IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN  
           WRITE(messageBuffer,'(A,2I4)')  
      &        '              *** jsl is out of bounds'  
           CALL PRINT_MESSAGE(messageBuffer,  
      I       standardMessageUnit,SQUEEZE_RIGHT,  
      I       myThid)  
          ENDIF  
 #endif /* W2_E2_DEBUG_ON */  
 #ifdef   W2_USE_E2_SAFEMODE  
          IF ( iBufr .GT. e2BufrRecSize ) THEN  
 C         Ran off end of buffer. This should not happen  
           STOP 'EXCH2_SEND_RX1:: E2BUFR LIMIT EXCEEDED'  
          ENDIF  
          IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN  
 C         Forward mode send getting from points outside of the  
 C         tiles exclusive domain bounds in X. This should not happen  
           STOP 'EXCH2_SEND_RX1:: ISL OUTSIDE TILE EXCLUSIVE DOMAIN'  
          ENDIF  
          IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN  
 C         Forward mode send getting from points outside of the  
 C         tiles exclusive domain bounds in Y. This should not happen  
           STOP 'EXCH2_SEND_RX1:: JSL OUTSIDE TILE EXCLUSIVE DOMAIN'  
          ENDIF  
 #endif /* W2_USE_E2_SAFEMODE */  
         ENDDO  
        ENDDO  
       ENDDO  
   
 C     Do data transport depending on communication mechanism between source and target tile  
       IF     ( commSetting .EQ. 'P' ) THEN  
 C      Need to set data ready assertion (increment buffer synchronisation token)  
 C      for multithreaded mode, for now do nothing i.e. assume only one thread per process.  
       ELSEIF ( commSetting .EQ. 'M' ) THEN  
 #ifdef ALLOW_USE_MPI  
84  C      Setup MPI stuff here  C      Setup MPI stuff here
85         theTag =  (thisTile-1)*W2_maxNeighbours + nN         theTag =  (thisTile-1)*W2_maxNeighbours + nN
86         tProc = exch2_tProc(tt)-1         tProc = exch2_tProc(tgT)-1
87         sProc = exch2_tProc(thisTile)-1         sProc = exch2_tProc(thisTile)-1
88         theType = _MPI_TYPE_RX         theType = _MPI_TYPE_RX
89  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
90         WRITE(messageBuffer,'(A,I4,A,I4,A)') ' SEND FROM TILE=',         WRITE(msgBuf,'(A,I5,A,I5,A)')
91       &                             thisTile, ' (proc = ',sProc,')'       &  ' SEND FROM TILE=', thisTile, ' (proc =',sProc,')'
92         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
93       I      standardMessageUnit,SQUEEZE_RIGHT,       I                     SQUEEZE_RIGHT, myThid)
94       I      myThid)         WRITE(msgBuf,'(A,I5,A,I5,A)')
95         WRITE(messageBuffer,'(A,I4,A,I4,A)') '        TO TILE=', tt,       &  '        TO TILE=', tgT ' (proc =',tProc,')'
96       &                                   ' (proc = ',tProc,')'         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
97         CALL PRINT_MESSAGE(messageBuffer,       I                     SQUEEZE_RIGHT, myThid)
98       I      standardMessageUnit,SQUEEZE_RIGHT,         WRITE(msgBuf,'(A,I10)') '            TAG=', theTag
99       I      myThid)         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
100         WRITE(messageBuffer,'(A,I10)') '            TAG=', theTag       I                     SQUEEZE_RIGHT, myThid)
101         CALL PRINT_MESSAGE(messageBuffer,         WRITE(msgBuf,'(A,I4)')  '            NEL=', iBufr
102       I      standardMessageUnit,SQUEEZE_RIGHT,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
103       I      myThid)       I                     SQUEEZE_RIGHT, myThid)
        WRITE(messageBuffer,'(A,I4)') '            NEL=', iBufr  
        CALL PRINT_MESSAGE(messageBuffer,  
      I      standardMessageUnit,SQUEEZE_RIGHT,  
      I      myThid)  
104  #endif /* W2_E2_DEBUG_ON */  #endif /* W2_E2_DEBUG_ON */
105         CALL MPI_Isend( e2Bufr1_RX, iBufr, theType,         CALL MPI_Isend( e2Bufr1_RX, iBufr, theType,
106       I                 tProc, theTag, MPI_COMM_MODEL,       I                 tProc, theTag, MPI_COMM_MODEL,
107       O                 theHandle, mpiRc )       O                 theHandle, mpiRc )
108  C      Store MPI_Wait token in messageHandle.  C      Store MPI_Wait token in messageHandle.
109         e2_msgHandle(1) = theHandle         e2_msgHandle(1) = theHandle
 #endif  
       ELSE  
        STOP 'EXCH2_SEND_RX1:: commSetting VALUE IS INVALID'  
110        ENDIF        ENDIF
111    #endif /* ALLOW_USE_MPI */
112    
113        RETURN        RETURN
114        END        END
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22