--- MITgcm/pkg/exch2/exch2_recv_rx1.template 2009/05/20 21:01:45 1.9 +++ MITgcm/pkg/exch2/exch2_recv_rx1.template 2009/05/30 21:18:59 1.10 @@ -1,22 +1,26 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/exch2/exch2_recv_rx1.template,v 1.9 2009/05/20 21:01:45 jmc Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/exch2/exch2_recv_rx1.template,v 1.10 2009/05/30 21:18:59 jmc Exp $ C $Name: $ #include "CPP_EEOPTIONS.h" #include "W2_OPTIONS.h" +CBOP 0 +C !ROUTINE: EXCH2_RECV_RX1 + +C !INTERFACE: SUBROUTINE EXCH2_RECV_RX1( - I tIlo, tIhi, tiStride, - I tJlo, tJhi, tjStride, - I tKlo, tKhi, tkStride, - I thisTile, thisI, nN, - I e2Bufr1_RX, e2BufrRecSize, - I mnb, nt, - U array, - I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi, - U e2_msgHandles, myTiles, - I commSetting, - I myThid ) + I thisTile, nN, + I e2BufrRecSize, + I iBufr, + O e2Bufr1_RX, + I commSetting, myThid ) + +C !DESCRIPTION: +C Scalar field (1 component) Exchange: +C Receive into buffer exchanged data from the source Process. +C buffer data will be used to fill in the tile-edge overlap region. +C !USES: IMPLICIT NONE #include "SIZE.h" @@ -25,160 +29,77 @@ #include "W2_EXCH2_SIZE.h" #include "W2_EXCH2_TOPOLOGY.h" +C !INPUT/OUTPUT PARAMETERS: C === Routine arguments === -C tIlo, tIhi, tIstride :: index range in I that will be filled in target "array" -C tJlo, tJhi, tJstride :: index range in J that will be filled in target "array" -C tKlo, tKhi, tKstride :: index range in K that will be filled in target "array" -C thisTile :: Rank of the receiveing tile -C thisI :: Index of the receiving tile within this process (used -C :: to select buffer slots that are allowed). -C nN :: Neighbour entry that we are processing -C e2Bufr1_RX :: Data transport buffer array. This array is used in one of -C :: two ways. For PUT communication the entry in the buffer -C :: associated with the source for this receive (determined -C :: from the opposing_send index) is read. For MSG communication -C :: the entry in the buffer associated with this neighbor of this -C :: tile is used as a receive location for loading a linear -C :: stream of bytes. -C e2BufrRecSize :: Number of elements in each entry of e2Bufr1_RX -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 +C thisTile :: receiveing tile Id. number +C nN :: Neighbour entry that we are processing +C e2BufrRecSize :: Number of elements in each entry of e2Bufr1_RX +C iBufr :: number of buffer elements to transfert +C e2Bufr1_RX :: Data transport buffer array. This array is used in one of +C :: two ways. For PUT communication the entry in the buffer +C :: associated with the source for this receive (determined +C :: from the opposing_send index) is read. +C :: For MSG communication the entry in the buffer associated +C :: with this neighbor of this tile is used as a receive +C :: location for loading a linear stream of bytes. +C commSetting :: Mode of communication used to exchange with this neighbor +C myThid :: my Thread Id. number + + INTEGER thisTile, nN INTEGER e2BufrRecSize - INTEGER mnb, nt - _RX e2Bufr1_RX( e2BufrRecSize, mnb, nt, 2 ) - _RX array(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi) - INTEGER e2_msgHandles(mnb, nt) - INTEGER myThid - INTEGER myTiles(nt) + INTEGER iBufr + _RX e2Bufr1_RX( e2BufrRecSize ) CHARACTER commSetting + INTEGER myThid +CEOP +#ifdef ALLOW_USE_MPI +C !LOCAL VARIABLES: C == Local variables == -C itl, jtl, ktl :: Loop counters -C :: itl etc... target local -C :: itc etc... target canonical -C :: isl etc... source local -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 +C soT :: Source tile Id. number +C oNb :: Opposing send record number + INTEGER soT + INTEGER oNb C MPI setup -#ifdef ALLOW_USE_MPI -c INTEGER theTag, theSize, theType INTEGER theTag, theType INTEGER sProc, tProc - INTEGER nri, nrj, nrk INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc #ifdef W2_E2_DEBUG_ON - CHARACTER*(MAX_LEN_MBUF) messageBuffer -#endif + CHARACTER*(MAX_LEN_MBUF) msgBuf #endif - tt=exch2_neighbourId(nN, thisTile ) - oN=exch2_opposingSend(nN, thisTile ) + soT = exch2_neighbourId(nN, thisTile ) + oNb = exch2_opposingSend(nN, thisTile ) -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(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 +C Handle receive end data transport according to communication mechanism +C between source and target tile + IF ( commSetting .EQ. 'M' ) THEN C Setup MPI stuff here - nb = thisI - mb = nN - ir = 2 - theTag = (tt-1)*W2_maxNeighbours + oN + theTag = (soT-1)*W2_maxNeighbours + oNb tProc = exch2_tProc(thisTile)-1 - sProc = exch2_tProc(tt)-1 + sProc = exch2_tProc(soT)-1 theType = _MPI_TYPE_RX - nri = (tIhi-tIlo+1)/tiStride - nrj = (tJhi-tJlo+1)/tjStride - 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 ) + CALL MPI_Recv( e2Bufr1_RX, iBufr, theType, sProc, + & theTag, MPI_COMM_MODEL, mpiStatus, mpiRc ) #ifdef W2_E2_DEBUG_ON - WRITE(messageBuffer,'(A,I4,A,I4,A)') ' RECV FROM TILE=', tt, - & ' (proc = ',sProc,')' - CALL PRINT_MESSAGE(messageBuffer, - I standardMessageUnit,SQUEEZE_RIGHT, - I myThid) - WRITE(messageBuffer,'(A,I4,A,I4,A)') ' INTO TILE=', thisTile, - & ' (proc = ',tProc,')' - CALL PRINT_MESSAGE(messageBuffer, - I standardMessageUnit,SQUEEZE_RIGHT, - I myThid) - WRITE(messageBuffer,'(A,I10)') ' TAG=', theTag - CALL PRINT_MESSAGE(messageBuffer, - I standardMessageUnit,SQUEEZE_RIGHT, - I myThid) - WRITE(messageBuffer,'(A,I4)') ' NEL=', iBufr - CALL PRINT_MESSAGE(messageBuffer, - I standardMessageUnit,SQUEEZE_RIGHT, - I myThid) + WRITE(msgBuf,'(A,I4,A,I4,A)') + & ' RECV FROM TILE=', soT, ' (proc = ',sProc,')' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + I SQUEEZE_RIGHT, myThid ) + WRITE(msgBuf,'(A,I4,A,I4,A)') + & ' INTO TILE=', thisTile, ' (proc = ',tProc,')' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + I SQUEEZE_RIGHT, myThid ) + WRITE(msgBuf,'(A,I10)') ' TAG=', theTag + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + I SQUEEZE_RIGHT, myThid ) + WRITE(msgBuf,'(A,I4)') ' NEL=', iBufr + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + I SQUEEZE_RIGHT, myThid ) #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' ENDIF - - 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 +#endif /* ALLOW_USE_MPI */ RETURN END