Back to home page

MITgcm
 
 

    

File indexing completed on 2020-01-15 06:10:56 UTC

view on githubraw file Latest commit 15f808dc on 2019-09-13 16:02:45 UTC
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_RECV_GET_VEC_RL
ad773b031f Oliv*0007 
                0008 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0009 CBOP 0
bd11294ab6 Jean*0010 C !ROUTINE: EXCH2_RECV_GET_VEC_RL
ad773b031f Oliv*0011 
                0012 C !INTERFACE:
bd11294ab6 Jean*0013       SUBROUTINE EXCH2_RECV_GET_VEC_RL(
ad773b031f Oliv*0014      U                        array,
bd11294ab6 Jean*0015      I                        theHandle,
ad773b031f Oliv*0016      I                        myd1, myThid )
                0017 C     !DESCRIPTION:
                0018 C     *==========================================================*
bd11294ab6 Jean*0019 C     | SUBROUTINE EXCH2_RECV_GET_VEC_RL
                0020 C     | o "Receive" edges for RL array.
ad773b031f Oliv*0021 C     *==========================================================*
                0022 C     | Routine that invokes actual message passing receive
                0023 C     | of data to update buffer
                0024 C     *==========================================================*
                0025 
                0026 C     !USES:
                0027       IMPLICIT NONE
                0028 
                0029 C     == Global variables ==
                0030 #include "SIZE.h"
                0031 #include "EEPARAMS.h"
                0032 #include "EESUPPORT.h"
                0033 #ifdef ALLOW_EXCH2
                0034 #include "W2_EXCH2_SIZE.h"
                0035 #include "W2_EXCH2_TOPOLOGY.h"
                0036 #endif
15f808dcb0 gael*0037 #include "FLT_SIZE.h"
ad773b031f Oliv*0038 
                0039 C     !INPUT/OUTPUT PARAMETERS:
                0040 C     arrayE        :: buffer array to collect Eastern Neighbour values
                0041 C     arrayW        :: buffer array to collect Western Neighbour values
                0042 C     myd1          :: size
                0043 C     myThid        :: my Thread Id. number
                0044       INTEGER myd1
                0045       _RL array(myd1, nSx, nSy, 4)
bd11294ab6 Jean*0046 #ifdef ALLOW_EXCH2
                0047       INTEGER theHandle(2,W2_maxNeighbours,nSx,nSy)
                0048 #else
                0049       INTEGER theHandle
                0050 #endif
ad773b031f Oliv*0051       INTEGER myThid
                0052 CEOP
                0053 
                0054 #ifdef ALLOW_EXCH2
bd11294ab6 Jean*0055 #ifdef ALLOW_USE_MPI
ad773b031f Oliv*0056 C     !LOCAL VARIABLES:
                0057 C     bi, bj        :: tile indices
                0058 C     theProc       :: Variables used in message building
                0059 C     theTag        :: Variables used in message building
                0060 C     theType       :: Variables used in message building
                0061 C     theSize       :: Variables used in message building
                0062       INTEGER bi, bj
                0063       INTEGER ioUnit
                0064       INTEGER thisTile, nN, tgT, oNb, dir
                0065       INTEGER theProc, theTag, theType, theSize
bd11294ab6 Jean*0066       INTEGER wHandle
ad773b031f Oliv*0067       INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
f5995a4aae Gael*0068       INTEGER imax, imax2
                0069       PARAMETER(imax=9)
                0070       PARAMETER(imax2=imax*max_npart_exch)
                0071       INTEGER pi(2), pj(2), oi, oj, ip, itb, jtb, isb, jsb
                0072       _RL itc,jtc, itmp, jtmp
ad773b031f Oliv*0073 
                0074 C--   Under a "put" scenario we
                0075 C--     i. set completetion signal for buffer we put into.
                0076 C--    ii. wait for completetion signal indicating data has been put in
                0077 C--        our buffer.
                0078 C--   Under a messaging mode we "receive" the message.
                0079 C--   Under a "get" scenario <= not implemented, we
                0080 C--     i. Check that the data is ready.
                0081 C--    ii. Read the data.
                0082 C--   iii. Set data read flag + memory sync.
                0083 
                0084       ioUnit = errorMessageUnit
                0085 
bd11294ab6 Jean*0086       _BEGIN_MASTER(myThid)
ad773b031f Oliv*0087 
bd11294ab6 Jean*0088       DO bj=1,nSy
                0089        DO bi=1,nSx
                0090          thisTile = W2_myTileList(bi,bj)
ad773b031f Oliv*0091 
                0092 C- loop over neighboring tiles
bd11294ab6 Jean*0093          DO nN=1,exch2_nNeighbours(thisTile)
ad773b031f Oliv*0094 
bd11294ab6 Jean*0095           tgT = exch2_neighbourId(nN, thisTile )
                0096           oNb = exch2_opposingSend(nN, thisTile )
                0097           dir = exch2_neighbourDir(nN,thisTile)
ad773b031f Oliv*0098 
                0099 #ifdef DBUG_EXCH_VEC
bd11294ab6 Jean*0100           write(ioUnit,'(A,5I6)') 'RECV,0 :',myProcId,bi,bj
ad773b031f Oliv*0101 #endif
bd11294ab6 Jean*0102           IF ( W2_myCommFlag(nN,bi,bj) .EQ. 'M' ) THEN
                0103            theProc = W2_tileProc(tgT) - 1
                0104            theTag  = (tgT-1)*W2_maxNeighbours + oNb
                0105            theSize = myd1
                0106            theType = _MPI_TYPE_RL
ad773b031f Oliv*0107 #ifdef DBUG_EXCH_VEC
bd11294ab6 Jean*0108            write(ioUnit,'(A,5I5,I8)') 'qq2xW: ',myProcId,bi,bj,
                0109      &           theProc,theTag,theSize
ad773b031f Oliv*0110 #endif
bd11294ab6 Jean*0111            CALL MPI_Recv( array(1,bi,bj,dir), theSize, theType,
                0112      &                    theProc, theTag, MPI_COMM_MODEL,
                0113      &                    mpiStatus, mpiRc )
f5995a4aae Gael*0114 
                0115 C- apply exch2_pij to rotate or shift indices
                0116            itb = exch2_tBasex(tgT)
                0117            jtb = exch2_tBasey(tgT)
                0118            isb = exch2_tBasex(thisTile)
                0119            jsb = exch2_tBasey(thisTile)
                0120            pi(1)=exch2_pij(1,nN,thisTile)
                0121            pi(2)=exch2_pij(2,nN,thisTile)
                0122            pj(1)=exch2_pij(3,nN,thisTile)
                0123            pj(2)=exch2_pij(4,nN,thisTile)
                0124            oi  = exch2_oi(nN,thisTile)
                0125            oj  = exch2_oj(nN,thisTile)
                0126 
                0127 #ifdef DBUG_EXCH_VEC
                0128            DO ip=1,max_npart_exch
                0129             IF (array(imax*(ip-1)+1,bi,bj,dir).NE.0.) THEN
                0130              itc=array(imax*(ip-1)+3,bi,bj,dir)+itb
                0131              jtc=array(imax*(ip-1)+4,bi,bj,dir)+jtb
                0132              itmp = pi(1)*itc+pi(2)*jtc+oi-isb
                0133              jtmp = pj(1)*itc+pj(2)*jtc+oj-jsb          
                0134              write(ioUnit,'(A,3I6)') 'LOC,1 :',thisTile,tgT,dir
                0135              write(ioUnit,'(A,8F10.3)') 'LOC,2 :',
                0136      &       array(imax*(ip-1)+1,bi,bj,dir),
                0137      &       array(imax*(ip-1)+2,bi,bj,dir),
                0138      &       array(imax*(ip-1)+3,bi,bj,dir),
                0139      &       array(imax*(ip-1)+4,bi,bj,dir),
                0140      &       itc,jtc,itmp,jtmp
                0141             ENDIF
                0142            ENDDO
                0143 #endif
                0144 
                0145            DO ip=1,max_npart_exch
                0146             IF (array(imax*(ip-1)+1,bi,bj,dir).NE.0.) THEN
                0147              itc=array(imax*(ip-1)+3,bi,bj,dir)+itb
                0148              jtc=array(imax*(ip-1)+4,bi,bj,dir)+jtb
                0149              array(imax*(ip-1)+3,bi,bj,dir) = pi(1)*itc+pi(2)*jtc+oi-isb
                0150              array(imax*(ip-1)+4,bi,bj,dir) = pj(1)*itc+pj(2)*jtc+oj-jsb
                0151             ENDIF
                0152            ENDDO
                0153 
bd11294ab6 Jean*0154           ENDIF
ad773b031f Oliv*0155 #ifdef DBUG_EXCH_VEC
bd11294ab6 Jean*0156           write(ioUnit,'(A,5I6)') 'RECV,1 :',myProcId,bi,bj
ad773b031f Oliv*0157 #endif
bd11294ab6 Jean*0158 C-       nN
                0159          ENDDO
                0160 C-     bj,bi
ad773b031f Oliv*0161        ENDDO
                0162       ENDDO
                0163 #ifdef DBUG_EXCH_VEC
bd11294ab6 Jean*0164        write(ioUnit,'(A,5I6,I12)') 'RECV:',myProcId
ad773b031f Oliv*0165 #endif
                0166 
bd11294ab6 Jean*0167 C--   Clear message handles/locks
                0168       DO bj=1,nSy
                0169        DO bi=1,nSx
                0170          thisTile = W2_myTileList(bi,bj)
                0171          DO nN=1,exch2_nNeighbours(thisTile)
                0172 c          tgT = exch2_neighbourId(nN, thisTile )
                0173 
                0174 C-    Note: In a between process tile-tile data transport using
                0175 C           MPI the sender needs to clear an Isend wait handle here.
                0176 C           In a within process tile-tile data transport using true
                0177 C           shared address space/or direct transfer through commonly
                0178 C           addressable memory blocks the receiver needs to assert
                0179 C           that he has consumed the buffer the sender filled here.
                0180            IF ( W2_myCommFlag(nN,bi,bj) .EQ. 'M' ) THEN
                0181             wHandle = theHandle(1,nN,bi,bj)
                0182             CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
                0183            ENDIF
                0184 
                0185          ENDDO
                0186        ENDDO
                0187       ENDDO
                0188 
                0189       _END_MASTER(myThid)
                0190 
                0191 C--   need to sync threads after master has received data
                0192       _BARRIER
                0193 
                0194 #endif /* ALLOW_USE_MPI */
ad773b031f Oliv*0195 #endif /* ALLOW_EXCH2 */
                0196 
                0197       RETURN
                0198       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!