C $Header: /u/gcmpack/MITgcm/pkg/flt/exch2_recv_get_vec.F,v 1.5 2017/02/11 21:07:13 gforget 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 #ifdef DEVEL_FLT_EXCH2 # include "FLT_SIZE.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 #ifdef DEVEL_FLT_EXCH2 INTEGER imax, imax2 PARAMETER(imax=9) PARAMETER(imax2=imax*max_npart_exch) INTEGER pi(2), pj(2), oi, oj, ip, itb, jtb, isb, jsb _RL itc,jtc, itmp, jtmp #endif 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 ) #ifdef DEVEL_FLT_EXCH2 C- apply exch2_pij to rotate or shift indices itb = exch2_tBasex(tgT) jtb = exch2_tBasey(tgT) 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) #ifdef DBUG_EXCH_VEC DO ip=1,max_npart_exch IF (array(imax*(ip-1)+1,bi,bj,dir).NE.0.) THEN itc=array(imax*(ip-1)+3,bi,bj,dir)+itb jtc=array(imax*(ip-1)+4,bi,bj,dir)+jtb itmp = pi(1)*itc+pi(2)*jtc+oi-isb jtmp = pj(1)*itc+pj(2)*jtc+oj-jsb write(ioUnit,'(A,3I6)') 'LOC,1 :',thisTile,tgT,dir write(ioUnit,'(A,8F10.3)') 'LOC,2 :', & array(imax*(ip-1)+1,bi,bj,dir), & array(imax*(ip-1)+2,bi,bj,dir), & array(imax*(ip-1)+3,bi,bj,dir), & array(imax*(ip-1)+4,bi,bj,dir), & itc,jtc,itmp,jtmp ENDIF ENDDO #endif DO ip=1,max_npart_exch IF (array(imax*(ip-1)+1,bi,bj,dir).NE.0.) THEN itc=array(imax*(ip-1)+3,bi,bj,dir)+itb jtc=array(imax*(ip-1)+4,bi,bj,dir)+jtb array(imax*(ip-1)+3,bi,bj,dir) = pi(1)*itc+pi(2)*jtc+oi-isb array(imax*(ip-1)+4,bi,bj,dir) = pj(1)*itc+pj(2)*jtc+oj-jsb ENDIF ENDDO #endif 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