pkg/flt/exch2_send_put_vec.F

ad773b031f Oliv*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_EEOPTIONS.h"
                0003 #undef DBUG_EXCH_VEC
                0004
                0005 C--   Contents
bd11294ab6 Jean*0006 C--   o EXCH2_SEND_PUT_VEC_RL
ad773b031f Oliv*0007
                0008 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0009 CBOP 0
bd11294ab6 Jean*0010 C !ROUTINE: EXCH2_SEND_PUT_VEC_RL
ad773b031f Oliv*0011
                0012 C !INTERFACE:
bd11294ab6 Jean*0013       SUBROUTINE EXCH2_SEND_PUT_VEC_RL(
e90cda2b3f Jean*0014      I                        array,
                0015      O                        bufRec,
ad773b031f Oliv*0016      O                        theHandle,
                0017      I                        myd1, myThid )
                0018 C     !DESCRIPTION:
                0019 C     *==========================================================*
bd11294ab6 Jean*0020 C     | SUBROUTINE EXCH2_SEND_PUT_VEC_RL
ad773b031f Oliv*0021 C     | o "Send" or "put" edges for RL array.
                0022 C     *==========================================================*
                0023 C     | Routine that invokes actual message passing send or
                0024 C     | direct "put" of data to update buffer
                0025 C     *==========================================================*
                0026
                0027 C     !USES:
                0028       IMPLICIT NONE
                0029
                0030 C     == Global variables ==
                0031 #include "SIZE.h"
                0032 #include "EEPARAMS.h"
                0033 #include "EESUPPORT.h"
                0034 #ifdef ALLOW_EXCH2
                0035 #include "W2_EXCH2_SIZE.h"
                0036 #include "W2_EXCH2_TOPOLOGY.h"
                0037 #endif
                0038
                0039 C     !INPUT/OUTPUT PARAMETERS:
                0040 C     array         :: Input buffer array to send to Neighbours
                0041 C     bufRec        :: buffer array to collect Neighbour values
                0042 C     myd1          :: size
                0043 C     myThid        :: my Thread Id. number
                0044       INTEGER myd1
                0045       _RL  array(myd1,nSx,nSy,4)
                0046       _RL bufRec(myd1,nSx,nSy,4)
                0047 #ifdef ALLOW_EXCH2
                0048       INTEGER theHandle(2,W2_maxNeighbours,nSx,nSy)
                0049 #else
                0050       INTEGER theHandle
                0051 #endif
                0052       INTEGER myThid
                0053 CEOP
                0054
                0055 #ifdef ALLOW_EXCH2
                0056
                0057 C     !LOCAL VARIABLES:
                0058 C     I             :: Loop counters
                0059 C     bi, bj        :: tile indices
                0060 C     theProc       :: Variables used in message building
                0061 C     theTag        :: Variables used in message building
                0062 C     theType       :: Variables used in message building
                0063 C     theSize       :: Variables used in message building
                0064       INTEGER I,J,sBi,sBj, nN, thisTile, tgT, tgN, dir, sDir
                0065       INTEGER bi, bj
                0066 #ifdef ALLOW_USE_MPI
                0067       INTEGER theProc, theTag, theType, theSize, mpiRc
                0068 #endif
                0069 #ifdef DBUG_EXCH_VEC
                0070       INTEGER ioUnit
                0071 #endif
                0072
                0073 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0074 C--   Write data to exchange buffer
                0075 C     Various actions are possible depending on the communication mode
                0076 C     as follows:
                0077 C       Mode      Action
                0078 C     --------   ---------------------------
                0079 C     COMM_NONE  Do nothing
                0080 C
                0081 C     COMM_MSG   Message passing communication ( e.g. MPI )
                0082 C                Fill west send buffer from this tile.
                0083 C                Send data with tag identifying tile and direction.
                0084 C                Fill east send buffer from this tile.
                0085 C                Send data with tag identifying tile and direction.
                0086 C
                0087 C     COMM_PUT   "Put" communication ( UMP_, shmemput, etc... )
                0088 C                Fill east receive buffer of west-neighbor tile
                0089 C                Fill west receive buffer of east-neighbor tile
                0090 C                Sync. memory
bd11294ab6 Jean*0091 C                Write data-ready Ack for east edge of west-neighbor tile
                0092 C                Write data-ready Ack for west edge of east-neighbor tile
ad773b031f Oliv*0093 C                Sync. memory
                0094
bd11294ab6 Jean*0095       _BEGIN_MASTER(myThid)
                0096
ad773b031f Oliv*0097 #ifdef DBUG_EXCH_VEC
                0098       ioUnit = errorMessageUnit
                0099 #endif
                0100
bd11294ab6 Jean*0101       DO bj=1,nSy
                0102       DO bi=1,nSx
ad773b031f Oliv*0103
                0104        thisTile = W2_myTileList(bi,bj)
                0105
                0106 C- loop over neighboring tiles
                0107        DO nN=1,exch2_nNeighbours(thisTile)
                0108
                0109         tgT = exch2_neighbourId(nN, thisTile )
                0110         dir = exch2_neighbourDir(nN,thisTile)
                0111         tgN = exch2_opposingSend(nN,thisTIle)
                0112         sDir = exch2_neighbourDir(tgN,tgT)
                0113
bd11294ab6 Jean*0114         IF ( W2_myCommFlag(nN,bi,bj) .EQ. 'P' ) THEN
ad773b031f Oliv*0115 C         find bi,bj of target tile
                0116           DO j=1,nSy
                0117            DO i=1,nSx
                0118             IF ( W2_myTileList(i,j).EQ.tgT ) THEN
                0119              sBi = i
                0120              sBj = j
                0121             ENDIF
                0122            ENDDO
                0123           ENDDO
                0124           DO I=1,myd1
bd11294ab6 Jean*0125             bufRec(I,sBi,sBj,sDir) = array(I,bi,bj,dir)
ad773b031f Oliv*0126           ENDDO
bd11294ab6 Jean*0127 #ifdef ALLOW_USE_MPI
                0128         ELSEIF ( usingMPI .AND.
                0129      &           W2_myCommFlag(nN,bi,bj) .EQ. 'M' ) THEN
                0130 C        Send the data
                0131           theProc = W2_tileProc(tgT) - 1
                0132           theTag  = (thisTile-1)*W2_maxNeighbours + nN
                0133           theSize = myd1
                0134           theType = _MPI_TYPE_RL
                0135 #ifdef DBUG_EXCH_VEC
                0136           write(ioUnit,'(A,5I5,I8)') 'qq1xW: ',myProcId,bi,bj,
                0137      &          theProc,theTag, theSize
                0138 #endif
                0139           CALL MPI_Isend(array(1,bi,bj,dir), theSize, theType,
                0140      &                  theProc, theTag, MPI_COMM_MODEL,
                0141      &                  theHandle(1,nN,bi,bj), mpiRc)
                0142 #endif /* ALLOW_USE_MPI */
ad773b031f Oliv*0143         ELSE
bd11294ab6 Jean*0144          STOP 'S/R EXCH2_SEND_PUT_VEC_RL: Invalid commFlag.'
ad773b031f Oliv*0145         ENDIF
                0146
                0147 C-     nN
                0148        ENDDO
                0149
                0150 C-    bj,bi
                0151       ENDDO
                0152       ENDDO
                0153
bd11294ab6 Jean*0154       _END_MASTER(myThid)
                0155
ad773b031f Oliv*0156 #endif /* ALLOW_EXCH2 */
                0157
                0158       RETURN
                0159       END