pkg/flt/exch2_recv_get_vec.F

C $Header: /u/gcmpack/MITgcm/pkg/flt/exch2_recv_get_vec.F,v 1.3 2012/09/06 16:17:21 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_EEOPTIONS.h"
#undef DBUG_EXCH_VEC

C--   Contents
C--   o EXCH2_RECV_GET_VEC_RL

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C !ROUTINE: EXCH2_RECV_GET_VEC_RL

C !INTERFACE:
      SUBROUTINE EXCH2_RECV_GET_VEC_RL(
     U                        array,
     I                        theHandle,
     I                        myd1, myThid )
C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE EXCH2_RECV_GET_VEC_RL
C     | o "Receive" edges for RL array.
C     *==========================================================*
C     | Routine that invokes actual message passing receive
C     | of data to update buffer
C     *==========================================================*

C     !USES:
      IMPLICIT NONE

C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#ifdef ALLOW_EXCH2
#include "W2_EXCH2_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
C     arrayE        :: buffer array to collect Eastern Neighbour values
C     arrayW        :: buffer array to collect Western Neighbour values
C     myd1          :: size
C     myThid        :: my Thread Id. number
      INTEGER myd1
      _RL array(myd1, nSx, nSy, 4)
#ifdef ALLOW_EXCH2
      INTEGER theHandle(2,W2_maxNeighbours,nSx,nSy)
#else
      INTEGER theHandle
#endif
      INTEGER myThid
CEOP

#ifdef ALLOW_EXCH2
#ifdef ALLOW_USE_MPI
C     !LOCAL VARIABLES:
C     bi, bj        :: tile indices
C     theProc       :: Variables used in message building
C     theTag        :: Variables used in message building
C     theType       :: Variables used in message building
C     theSize       :: Variables used in message building
      INTEGER bi, bj
      INTEGER ioUnit
      INTEGER thisTile, nN, tgT, oNb, dir
      INTEGER theProc, theTag, theType, theSize
      INTEGER wHandle
      INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc

C--   Under a "put" scenario we
C--     i. set completetion signal for buffer we put into.
C--    ii. wait for completetion signal indicating data has been put in
C--        our buffer.
C--   Under a messaging mode we "receive" the message.
C--   Under a "get" scenario <= not implemented, we
C--     i. Check that the data is ready.
C--    ii. Read the data.
C--   iii. Set data read flag + memory sync.

      ioUnit = errorMessageUnit

      _BEGIN_MASTER(myThid)

      DO bj=1,nSy
       DO bi=1,nSx
         thisTile = W2_myTileList(bi,bj)

C- loop over neighboring tiles
         DO nN=1,exch2_nNeighbours(thisTile)

          tgT = exch2_neighbourId(nN, thisTile )
          oNb = exch2_opposingSend(nN, thisTile )
          dir = exch2_neighbourDir(nN,thisTile)

#ifdef DBUG_EXCH_VEC
          write(ioUnit,'(A,5I6)') 'RECV,0 :',myProcId,bi,bj
#endif
          IF ( W2_myCommFlag(nN,bi,bj) .EQ. 'M' ) THEN
           theProc = W2_tileProc(tgT) - 1
           theTag  = (tgT-1)*W2_maxNeighbours + oNb
           theSize = myd1
           theType = _MPI_TYPE_RL
#ifdef DBUG_EXCH_VEC
           write(ioUnit,'(A,5I5,I8)') 'qq2xW: ',myProcId,bi,bj,
     &           theProc,theTag,theSize
#endif
           CALL MPI_Recv( array(1,bi,bj,dir), theSize, theType,
     &                    theProc, theTag, MPI_COMM_MODEL,
     &                    mpiStatus, mpiRc )
          ENDIF
#ifdef DBUG_EXCH_VEC
          write(ioUnit,'(A,5I6)') 'RECV,1 :',myProcId,bi,bj
#endif
C-       nN
         ENDDO
C-     bj,bi
       ENDDO
      ENDDO
#ifdef DBUG_EXCH_VEC
       write(ioUnit,'(A,5I6,I12)') 'RECV:',myProcId
#endif

C--   Clear message handles/locks
      DO bj=1,nSy
       DO bi=1,nSx
         thisTile = W2_myTileList(bi,bj)
         DO nN=1,exch2_nNeighbours(thisTile)
c          tgT = exch2_neighbourId(nN, thisTile )

C-    Note: In a between process tile-tile data transport using
C           MPI the sender needs to clear an Isend wait handle here.
C           In a within process tile-tile data transport using true
C           shared address space/or direct transfer through commonly
C           addressable memory blocks the receiver needs to assert
C           that he has consumed the buffer the sender filled here.
           IF ( W2_myCommFlag(nN,bi,bj) .EQ. 'M' ) THEN
            wHandle = theHandle(1,nN,bi,bj)
            CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
           ENDIF

         ENDDO
       ENDDO
      ENDDO

      _END_MASTER(myThid)

C--   need to sync threads after master has received data
      _BARRIER

#endif /* ALLOW_USE_MPI */
#endif /* ALLOW_EXCH2 */

      RETURN
      END
1	jmc	1.4	C $Header: /u/gcmpack/MITgcm/pkg/flt/exch2_recv_get_vec.F,v 1.3 2012/09/06 16:17:21 jmc Exp $
2	jmc	1.2	C $Name: $
3	jahn	1.1
4			#include "PACKAGES_CONFIG.h"
5			#include "CPP_EEOPTIONS.h"
6			#undef DBUG_EXCH_VEC
7
8			C-- Contents
9	jmc	1.3	C-- o EXCH2_RECV_GET_VEC_RL
10	jahn	1.1
11			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
12			CBOP 0
13	jmc	1.3	C !ROUTINE: EXCH2_RECV_GET_VEC_RL
14	jahn	1.1
15			C !INTERFACE:
16	jmc	1.3	SUBROUTINE EXCH2_RECV_GET_VEC_RL(
17	jahn	1.1	U array,
18	jmc	1.3	I theHandle,
19	jahn	1.1	I myd1, myThid )
20			C !DESCRIPTION:
21			C ==========================================================
22	jmc	1.3	C \| SUBROUTINE EXCH2_RECV_GET_VEC_RL
23			C \| o "Receive" edges for RL array.
24	jahn	1.1	C ==========================================================
25			C \| Routine that invokes actual message passing receive
26			C \| of data to update buffer
27			C ==========================================================
28
29			C !USES:
30			IMPLICIT NONE
31
32			C == Global variables ==
33			#include "SIZE.h"
34			#include "EEPARAMS.h"
35			#include "EESUPPORT.h"
36			#ifdef ALLOW_EXCH2
37			#include "W2_EXCH2_SIZE.h"
38			#include "W2_EXCH2_TOPOLOGY.h"
39			#endif
40
41			C !INPUT/OUTPUT PARAMETERS:
42			C arrayE :: buffer array to collect Eastern Neighbour values
43			C arrayW :: buffer array to collect Western Neighbour values
44			C myd1 :: size
45			C myThid :: my Thread Id. number
46			INTEGER myd1
47			_RL array(myd1, nSx, nSy, 4)
48	jmc	1.3	#ifdef ALLOW_EXCH2
49			INTEGER theHandle(2,W2_maxNeighbours,nSx,nSy)
50			#else
51			INTEGER theHandle
52			#endif
53	jahn	1.1	INTEGER myThid
54			CEOP
55
56			#ifdef ALLOW_EXCH2
57	jmc	1.3	#ifdef ALLOW_USE_MPI
58	jahn	1.1	C !LOCAL VARIABLES:
59			C bi, bj :: tile indices
60			C theProc :: Variables used in message building
61			C theTag :: Variables used in message building
62			C theType :: Variables used in message building
63			C theSize :: Variables used in message building
64			INTEGER bi, bj
65			INTEGER ioUnit
66			INTEGER thisTile, nN, tgT, oNb, dir
67			INTEGER theProc, theTag, theType, theSize
68	jmc	1.3	INTEGER wHandle
69	jahn	1.1	INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
70
71			C-- Under a "put" scenario we
72			C-- i. set completetion signal for buffer we put into.
73			C-- ii. wait for completetion signal indicating data has been put in
74			C-- our buffer.
75			C-- Under a messaging mode we "receive" the message.
76			C-- Under a "get" scenario <= not implemented, we
77			C-- i. Check that the data is ready.
78			C-- ii. Read the data.
79			C-- iii. Set data read flag + memory sync.
80
81			ioUnit = errorMessageUnit
82
83	jmc	1.3	_BEGIN_MASTER(myThid)
84	jahn	1.1
85	jmc	1.3	DO bj=1,nSy
86			DO bi=1,nSx
87			thisTile = W2_myTileList(bi,bj)
88	jahn	1.1
89			C- loop over neighboring tiles
90	jmc	1.3	DO nN=1,exch2_nNeighbours(thisTile)
91	jahn	1.1
92	jmc	1.3	tgT = exch2_neighbourId(nN, thisTile )
93			oNb = exch2_opposingSend(nN, thisTile )
94			dir = exch2_neighbourDir(nN,thisTile)
95	jahn	1.1
96			#ifdef DBUG_EXCH_VEC
97	jmc	1.3	write(ioUnit,'(A,5I6)') 'RECV,0 :',myProcId,bi,bj
98	jahn	1.1	#endif
99	jmc	1.3	IF ( W2_myCommFlag(nN,bi,bj) .EQ. 'M' ) THEN
100			theProc = W2_tileProc(tgT) - 1
101			theTag = (tgT-1)*W2_maxNeighbours + oNb
102			theSize = myd1
103			theType = _MPI_TYPE_RL
104	jahn	1.1	#ifdef DBUG_EXCH_VEC
105	jmc	1.3	write(ioUnit,'(A,5I5,I8)') 'qq2xW: ',myProcId,bi,bj,
106			& theProc,theTag,theSize
107	jahn	1.1	#endif
108	jmc	1.3	CALL MPI_Recv( array(1,bi,bj,dir), theSize, theType,
109			& theProc, theTag, MPI_COMM_MODEL,
110			& mpiStatus, mpiRc )
111			ENDIF
112	jahn	1.1	#ifdef DBUG_EXCH_VEC
113	jmc	1.3	write(ioUnit,'(A,5I6)') 'RECV,1 :',myProcId,bi,bj
114	jahn	1.1	#endif
115	jmc	1.3	C- nN
116			ENDDO
117			C- bj,bi
118	jahn	1.1	ENDDO
119			ENDDO
120			#ifdef DBUG_EXCH_VEC
121	jmc	1.3	write(ioUnit,'(A,5I6,I12)') 'RECV:',myProcId
122	jahn	1.1	#endif
123
124	jmc	1.3	C-- Clear message handles/locks
125			DO bj=1,nSy
126			DO bi=1,nSx
127			thisTile = W2_myTileList(bi,bj)
128			DO nN=1,exch2_nNeighbours(thisTile)
129			c tgT = exch2_neighbourId(nN, thisTile )
130
131			C- Note: In a between process tile-tile data transport using
132			C MPI the sender needs to clear an Isend wait handle here.
133			C In a within process tile-tile data transport using true
134			C shared address space/or direct transfer through commonly
135			C addressable memory blocks the receiver needs to assert
136			C that he has consumed the buffer the sender filled here.
137			IF ( W2_myCommFlag(nN,bi,bj) .EQ. 'M' ) THEN
138			wHandle = theHandle(1,nN,bi,bj)
139			CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
140			ENDIF
141
142			ENDDO
143			ENDDO
144			ENDDO
145
146			_END_MASTER(myThid)
147
148			C-- need to sync threads after master has received data
149			_BARRIER
150
151			#endif /* ALLOW_USE_MPI */
152	jahn	1.1	#endif /* ALLOW_EXCH2 */
153
154			RETURN
155			END