Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:40:46 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
aa582c8e8c Jean*0001 #include "CPP_EEOPTIONS.h"
bd12238ff3 Jean*0002 #undef EXCH_USE_SPINNING
aa582c8e8c Jean*0003 #undef DBUG_EXCH_VEC
eacecc7041 Jean*0004 
                0005 C--   Contents
48e4fc2750 Jean*0006 C--   o EXCH_RECV_GET_VEC_X_RL
                0007 C--   o EXCH_RECV_GET_VEC_Y_RL
eacecc7041 Jean*0008 
                0009 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
aa582c8e8c Jean*0010 CBOP 0
48e4fc2750 Jean*0011 C !ROUTINE: EXCH_RECV_GET_VEC_X_RL
c806179eb4 Alis*0012 
aa582c8e8c Jean*0013 C !INTERFACE:
48e4fc2750 Jean*0014       SUBROUTINE EXCH_RECV_GET_VEC_X_RL(
121ecfb57a Jean*0015      U                        arrayE, arrayW,
                0016      I                        myd1, myThid )
aa582c8e8c Jean*0017 C     !DESCRIPTION:
                0018 C     *==========================================================*
48e4fc2750 Jean*0019 C     | SUBROUTINE EXCH_RECV_GET_VEC_X_RL
aa582c8e8c Jean*0020 C     | o "Receive" or "Get" X edges for RL array.
                0021 C     *==========================================================*
                0022 C     | Routine that invokes actual message passing receive
                0023 C     | of data to update buffer in X direction
                0024 C     *==========================================================*
                0025 
                0026 C     !USES:
c806179eb4 Alis*0027       IMPLICIT NONE
                0028 
                0029 C     == Global variables ==
                0030 #include "SIZE.h"
                0031 #include "EEPARAMS.h"
                0032 #include "EESUPPORT.h"
                0033 #include "EXCH.h"
                0034 
aa582c8e8c Jean*0035 C     !INPUT/OUTPUT PARAMETERS:
                0036 C     arrayE        :: buffer array to collect Eastern Neighbour values
                0037 C     arrayW        :: buffer array to collect Western Neighbour values
                0038 C     myd1          :: size
                0039 C     myThid        :: my Thread Id. number
c806179eb4 Alis*0040       INTEGER myd1
                0041       _RL arrayE(myd1, nSx, nSy), arrayW(myd1, nSx, nSy)
                0042       INTEGER myThid
aa582c8e8c Jean*0043 CEOP
c806179eb4 Alis*0044 
aa582c8e8c Jean*0045 C     !LOCAL VARIABLES:
                0046 C     bi, bj        :: tile indices
                0047 C     biW, bjW      :: West tile indices
                0048 C     biE, bjE      :: East tile indices
b0bdd58b37 Chri*0049 C     theProc       :: Variables used in message building
                0050 C     theTag        :: Variables used in message building
                0051 C     theType       :: Variables used in message building
                0052 C     theSize       :: Variables used in message building
aa582c8e8c Jean*0053 C     westCommMode  :: variables holding type of communication
                0054 C     eastCommMode  ::  a particular tile face uses.
121ecfb57a Jean*0055       INTEGER bi, bj
                0056 c     INTEGER biW, bjW, biE, bjE
c806179eb4 Alis*0057       INTEGER westCommMode
                0058       INTEGER eastCommMode
aa582c8e8c Jean*0059       INTEGER ioUnit
e1fb02e8f0 Jean*0060 #ifdef EXCH_USE_SPINNING
                0061       INTEGER spinCount
                0062 #endif
c806179eb4 Alis*0063 #ifdef ALLOW_USE_MPI
                0064       INTEGER theProc, theTag, theType, theSize
                0065       INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
                0066 #endif
                0067 
ef53b829d7 Jean*0068 C--   Under a "put" scenario we
c806179eb4 Alis*0069 C--     i. set completetion signal for buffer we put into.
ef53b829d7 Jean*0070 C--    ii. wait for completetion signal indicating data has been put in
c806179eb4 Alis*0071 C--        our buffer.
                0072 C--   Under a messaging mode we "receive" the message.
aa582c8e8c Jean*0073 C--   Under a "get" scenario <= not implemented, we
c806179eb4 Alis*0074 C--     i. Check that the data is ready.
                0075 C--    ii. Read the data.
                0076 C--   iii. Set data read flag + memory sync.
                0077 
aa582c8e8c Jean*0078       ioUnit = errorMessageUnit
c806179eb4 Alis*0079 
bd12238ff3 Jean*0080       _BEGIN_MASTER(myThid)
                0081 
                0082       DO bj=1,nSy
                0083        DO bi=1,nSx
c806179eb4 Alis*0084         westCommMode  = _tileCommModeW(bi,bj)
                0085         eastCommMode  = _tileCommModeE(bi,bj)
aa582c8e8c Jean*0086 #ifdef DBUG_EXCH_VEC
                0087         write(ioUnit,'(A,5I6)') 'RECV_X,0 :',myProcId,bi,bj
                0088 #endif
121ecfb57a Jean*0089 c       biE =  _tileBiE(bi,bj)
                0090 c       bjE =  _tileBjE(bi,bj)
                0091 c       biW =  _tileBiW(bi,bj)
                0092 c       bjW =  _tileBjW(bi,bj)
c806179eb4 Alis*0093         IF ( westCommMode .EQ. COMM_MSG ) THEN
                0094 #ifdef ALLOW_USE_MPI
                0095          IF ( usingMPI ) THEN
48e4fc2750 Jean*0096           theProc = tilePidW(bi,bj)
                0097           theTag  = _tileTagRecvW(bi,bj)
                0098           theType = _MPI_TYPE_RL
                0099           theSize = myd1
aa582c8e8c Jean*0100 #ifdef DBUG_EXCH_VEC
48e4fc2750 Jean*0101           write(ioUnit,'(A,5I5,I8)') 'qq2xW: ',myProcId,bi,bj,
                0102      &          theProc,theTag,theSize
aa582c8e8c Jean*0103 #endif
48e4fc2750 Jean*0104           CALL MPI_Recv( arrayW(1,bi,bj), theSize, theType,
                0105      &                   theProc, theTag, MPI_COMM_MODEL,
                0106      &                   mpiStatus, mpiRc )
c806179eb4 Alis*0107 c         if (theProc .eq. 0 .or. theProc .eq. 2) then
                0108 c         if (arrayW(1,bi,bj) .ne. 0.) then
aa582c8e8c Jean*0109 c            write(errormessageunit,*) 'qq2y: ',myProcId,
c806179eb4 Alis*0110 c     &      theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
                0111 c         else
aa582c8e8c Jean*0112 c            write(errormessageunit,*) 'qq2n: ',myProcId,
c806179eb4 Alis*0113 c     &      theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
                0114 c         endif
                0115 c         endif
aa582c8e8c Jean*0116          ENDIF
c806179eb4 Alis*0117 #endif /* ALLOW_USE_MPI */
                0118         ENDIF
aa582c8e8c Jean*0119 #ifdef DBUG_EXCH_VEC
                0120         write(ioUnit,'(A,5I6)') 'RECV_X,1 :',myProcId,bi,bj
                0121 #endif
48e4fc2750 Jean*0122 
c806179eb4 Alis*0123         IF ( eastCommMode .EQ. COMM_MSG ) THEN
                0124 #ifdef ALLOW_USE_MPI
                0125          IF ( usingMPI ) THEN
48e4fc2750 Jean*0126           theProc = tilePidE(bi,bj)
                0127           theTag  = _tileTagRecvE(bi,bj)
                0128           theType = _MPI_TYPE_RL
                0129           theSize = myd1
aa582c8e8c Jean*0130 #ifdef DBUG_EXCH_VEC
48e4fc2750 Jean*0131           write(ioUnit,'(A,5I5,I8)') 'qq2xE: ',myProcId,bi,bj,
                0132      &          theProc,theTag,theSize
aa582c8e8c Jean*0133 #endif
48e4fc2750 Jean*0134           CALL MPI_Recv( arrayE(1,bi,bj), theSize, theType,
                0135      &                   theProc, theTag, MPI_COMM_MODEL,
                0136      &                   mpiStatus, mpiRc )
aa582c8e8c Jean*0137          ENDIF
c806179eb4 Alis*0138 #endif /* ALLOW_USE_MPI */
                0139         ENDIF
aa582c8e8c Jean*0140 #ifdef DBUG_EXCH_VEC
                0141         write(ioUnit,'(A,5I6)') 'RECV_X,2 :',myProcId,bi,bj
                0142 #endif
c806179eb4 Alis*0143        ENDDO
                0144       ENDDO
aa582c8e8c Jean*0145 #ifdef DBUG_EXCH_VEC
                0146       write(ioUnit,'(A,5I6,I12)') 'RECV_X:',myProcId
                0147 #endif
c806179eb4 Alis*0148 
bd12238ff3 Jean*0149       IF ( .NOT.exchUsesBarrier  ) THEN
                0150        DO bj=1,nSy
                0151         DO bi=1,nSx
                0152          IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
                0153 #ifdef ALLOW_USE_MPI
48e4fc2750 Jean*0154           IF ( usingMPI )
                0155      &    CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
bd12238ff3 Jean*0156      &                      mpiStatus, mpiRC )
                0157 #endif /* ALLOW_USE_MPI */
                0158          ENDIF
                0159 C        Clear outstanding requests counter
                0160          exchNReqsX(1,bi,bj) = 0
                0161         ENDDO
                0162        ENDDO
                0163       ENDIF
                0164 
                0165       _END_MASTER(myThid)
                0166 
                0167 C--   need to sync threads after master has received data ;
                0168 C     (done after mpi waitall in case waitall is really needed)
                0169       _BARRIER
                0170 
                0171 C--   Threads wait for buffers I am going to read to be ready.
                0172 C     note: added BARRIER in exch_send_put S/R and here above (message
                0173 C     mode) so that we no longer needs this (undef EXCH_USE_SPINNING)
                0174 #ifdef EXCH_USE_SPINNING
c806179eb4 Alis*0175       IF ( exchUsesBarrier  ) THEN
                0176 C      o On some machines ( T90 ) use system barrier rather than spinning.
                0177        CALL BARRIER( myThid )
                0178       ELSE
                0179 C      o Spin waiting for completetion flag. This avoids a global-lock
                0180 C        i.e. we only lock waiting for data that we need.
                0181        DO bj=myByLo(myThid),myByHi(myThid)
                0182         DO bi=myBxLo(myThid),myBxHi(myThid)
                0183          spinCount = 0
                0184          westCommMode = _tileCommModeW(bi,bj)
                0185          eastCommMode = _tileCommModeE(bi,bj)
aa582c8e8c Jean*0186 #ifdef DBUG_EXCH_VEC
                0187           write(ioUnit,'(A,5I6,I12)') 'spin:', myProcId,bi,bj,
                0188      &          westRecvAck(1,bi,bj), eastRecvAck(1,bi,bj), spinCount
                0189 #endif
c806179eb4 Alis*0190    10    CONTINUE
27977973af Jean*0191           CALL FOOL_THE_COMPILER( spinCount )
c806179eb4 Alis*0192           spinCount = spinCount+1
aa582c8e8c Jean*0193 #ifdef DBUG_EXCH_VEC
                0194           write(ioUnit,'(A,5I6,I12)') 'spin:', myProcId,bi,bj,
                0195      &          westRecvAck(1,bi,bj), eastRecvAck(1,bi,bj), spinCount
                0196           IF ( myThid.EQ.1 .AND. spinCount.GT. _EXCH_SPIN_LIMIT ) THEN
                0197            STOP ' S/R EXCH_RECV_GET_X: spinCount > _EXCH_SPIN_LIMIT'
                0198           ENDIF
                0199 #endif
                0200           IF ( westRecvAck(1,bi,bj) .EQ. 0 ) GOTO 10
                0201           IF ( eastRecvAck(1,bi,bj) .EQ. 0 ) GOTO 10
c806179eb4 Alis*0202 C        Clear outstanding requests
aa582c8e8c Jean*0203          westRecvAck(1,bi,bj) = 0
                0204          eastRecvAck(1,bi,bj) = 0
c806179eb4 Alis*0205         ENDDO
                0206        ENDDO
                0207       ENDIF
bd12238ff3 Jean*0208 #endif /* EXCH_USE_SPINNING */
c806179eb4 Alis*0209 
                0210       RETURN
                0211       END
                0212 
eacecc7041 Jean*0213 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
aa582c8e8c Jean*0214 CBOP 0
48e4fc2750 Jean*0215 C !ROUTINE: EXCH_RECV_GET_VEC_Y_RL
c806179eb4 Alis*0216 
aa582c8e8c Jean*0217 C !INTERFACE:
48e4fc2750 Jean*0218       SUBROUTINE EXCH_RECV_GET_VEC_Y_RL(
121ecfb57a Jean*0219      U                        arrayN, arrayS,
                0220      I                        myd1, myThid )
aa582c8e8c Jean*0221 C     !DESCRIPTION:
                0222 C     *==========================================================*
48e4fc2750 Jean*0223 C     | SUBROUTINE EXCH_RECV_GET_VEC_Y_RL
aa582c8e8c Jean*0224 C     | o "Receive" or "Get" Y edges for RL array.
                0225 C     *==========================================================*
                0226 C     | Routine that invokes actual message passing receive
                0227 C     | of data to update buffer in Y direction
                0228 C     *==========================================================*
                0229 
                0230 C     !USES:
c806179eb4 Alis*0231       IMPLICIT NONE
                0232 
                0233 C     == Global variables ==
                0234 #include "SIZE.h"
                0235 #include "EEPARAMS.h"
                0236 #include "EESUPPORT.h"
                0237 #include "EXCH.h"
                0238 
aa582c8e8c Jean*0239 C     !INPUT/OUTPUT PARAMETERS:
                0240 C     arrayN        :: buffer array to collect Northern Neighbour values
                0241 C     arrayS        :: buffer array to collect Southern Neighbour values
                0242 C     myd1          :: size
                0243 C     myThid        :: my Thread Id. number
c806179eb4 Alis*0244       INTEGER myd1
                0245       _RL arrayN(myd1, nSx, nSy), arrayS(myd1, nSx, nSy)
                0246       INTEGER myThid
aa582c8e8c Jean*0247 CEOP
c806179eb4 Alis*0248 
aa582c8e8c Jean*0249 C     !LOCAL VARIABLES:
                0250 C     bi, bj        :: tile indices
                0251 C     biS, bjS      :: South tile indices
                0252 C     biN, bjN      :: North tile indices
b0bdd58b37 Chri*0253 C     theProc       :: Variables used in message building
                0254 C     theTag        :: Variables used in message building
                0255 C     theType       :: Variables used in message building
                0256 C     theSize       :: Variables used in message building
aa582c8e8c Jean*0257 C     southCommMode :: variables holding type of communication
                0258 C     northCommMode ::  a particular tile face uses.
121ecfb57a Jean*0259       INTEGER bi, bj
                0260 c     INTEGER biS, bjS, biN, bjN
c806179eb4 Alis*0261       INTEGER southCommMode
                0262       INTEGER northCommMode
aa582c8e8c Jean*0263       INTEGER ioUnit
e1fb02e8f0 Jean*0264 #ifdef EXCH_USE_SPINNING
                0265       INTEGER spinCount
                0266 #endif
c806179eb4 Alis*0267 #ifdef ALLOW_USE_MPI
                0268       INTEGER theProc, theTag, theType, theSize
                0269       INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
                0270 #endif
                0271 
ef53b829d7 Jean*0272 C--   Under a "put" scenario we
c806179eb4 Alis*0273 C--     i. set completetion signal for buffer we put into.
ef53b829d7 Jean*0274 C--    ii. wait for completetion signal indicating data has been put in
c806179eb4 Alis*0275 C--        our buffer.
                0276 C--   Under a messaging mode we "receive" the message.
aa582c8e8c Jean*0277 C--   Under a "get" scenario <= not implemented, we
c806179eb4 Alis*0278 C--     i. Check that the data is ready.
                0279 C--    ii. Read the data.
                0280 C--   iii. Set data read flag + memory sync.
                0281 
aa582c8e8c Jean*0282       ioUnit = errorMessageUnit
c806179eb4 Alis*0283 
bd12238ff3 Jean*0284       _BEGIN_MASTER(myThid)
                0285 
                0286       DO bj=1,nSy
                0287        DO bi=1,nSx
c806179eb4 Alis*0288         southCommMode  = _tileCommModeS(bi,bj)
                0289         northCommMode  = _tileCommModeN(bi,bj)
aa582c8e8c Jean*0290 #ifdef DBUG_EXCH_VEC
                0291         write(ioUnit,'(A,5I6)') 'RECV_Y,0 :',myProcId,bi,bj
                0292 #endif
121ecfb57a Jean*0293 c       biN =  _tileBiN(bi,bj)
                0294 c       bjN =  _tileBjN(bi,bj)
                0295 c       biS =  _tileBiS(bi,bj)
                0296 c       bjS =  _tileBjS(bi,bj)
c806179eb4 Alis*0297         IF ( southCommMode .EQ. COMM_MSG ) THEN
                0298 #ifdef ALLOW_USE_MPI
                0299          IF ( usingMPI ) THEN
48e4fc2750 Jean*0300           theProc = tilePidS(bi,bj)
                0301           theTag  = _tileTagRecvS(bi,bj)
                0302           theType = _MPI_TYPE_RL
                0303           theSize = myd1
                0304           CALL MPI_Recv( arrayS(1,bi,bj), theSize, theType,
                0305      &                   theProc, theTag, MPI_COMM_MODEL,
                0306      &                   mpiStatus, mpiRc )
aa582c8e8c Jean*0307          ENDIF
c806179eb4 Alis*0308 #endif /* ALLOW_USE_MPI */
                0309         ENDIF
aa582c8e8c Jean*0310 #ifdef DBUG_EXCH_VEC
                0311         write(ioUnit,'(A,5I6)') 'RECV_Y,1 :',myProcId,bi,bj
                0312 #endif
48e4fc2750 Jean*0313 
c806179eb4 Alis*0314         IF ( northCommMode .EQ. COMM_MSG ) THEN
                0315 #ifdef ALLOW_USE_MPI
                0316          IF ( usingMPI ) THEN
48e4fc2750 Jean*0317           theProc = tilePidN(bi,bj)
                0318           theTag  = _tileTagRecvN(bi,bj)
                0319           theType = _MPI_TYPE_RL
                0320           theSize = myd1
                0321           CALL MPI_Recv( arrayN(1,bi,bj), theSize, theType,
                0322      &                   theProc, theTag, MPI_COMM_MODEL,
                0323      &                   mpiStatus, mpiRc )
aa582c8e8c Jean*0324          ENDIF
c806179eb4 Alis*0325 #endif /* ALLOW_USE_MPI */
                0326         ENDIF
aa582c8e8c Jean*0327 #ifdef DBUG_EXCH_VEC
                0328         write(ioUnit,'(A,5I6)') 'RECV_Y,2 :',myProcId,bi,bj
                0329 #endif
c806179eb4 Alis*0330        ENDDO
                0331       ENDDO
aa582c8e8c Jean*0332 #ifdef DBUG_EXCH_VEC
                0333       write(ioUnit,'(A,5I6,I12)') 'RECV_Y:',myProcId
                0334 #endif
c806179eb4 Alis*0335 
bd12238ff3 Jean*0336 C--   Processes wait for buffers I am going to read to be ready.
                0337       IF ( .NOT.exchUsesBarrier  ) THEN
                0338        DO bj=1,nSy
                0339         DO bi=1,nSx
                0340          IF ( exchNReqsY(1,bi,bj) .GT. 0 ) THEN
                0341 #ifdef ALLOW_USE_MPI
48e4fc2750 Jean*0342           IF ( usingMPI )
                0343      &    CALL MPI_Waitall( exchNReqsY(1,bi,bj), exchReqIdY(1,1,bi,bj),
bd12238ff3 Jean*0344      &                      mpiStatus, mpiRC )
                0345 #endif /* ALLOW_USE_MPI */
                0346          ENDIF
                0347 C        Clear outstanding requests counter
                0348          exchNReqsY(1,bi,bj) = 0
                0349         ENDDO
                0350        ENDDO
                0351       ENDIF
                0352 
                0353       _END_MASTER(myThid)
                0354 
                0355 C--   need to sync threads after master has received data ;
                0356 C     (done after mpi waitall in case waitall is really needed)
                0357       _BARRIER
                0358 
                0359 C--   Threads wait for buffers I am going to read to be ready.
                0360 C     note: added BARRIER in exch_send_put S/R and here above (message
                0361 C     mode) so that we no longer needs this (undef EXCH_USE_SPINNING)
                0362 #ifdef EXCH_USE_SPINNING
c806179eb4 Alis*0363       IF ( exchUsesBarrier  ) THEN
                0364 C      o On some machines ( T90 ) use system barrier rather than spinning.
                0365        CALL BARRIER( myThid )
                0366       ELSE
                0367 C      o Spin waiting for completetion flag. This avoids a global-lock
                0368 C        i.e. we only lock waiting for data that we need.
                0369        DO bj=myByLo(myThid),myByHi(myThid)
                0370         DO bi=myBxLo(myThid),myBxHi(myThid)
                0371          spinCount = 0
                0372          southCommMode = _tileCommModeS(bi,bj)
                0373          northCommMode = _tileCommModeN(bi,bj)
aa582c8e8c Jean*0374 #ifdef DBUG_EXCH_VEC
                0375           write(ioUnit,'(A,5I6,I12)') 'spin:', myProcId,bi,bj,
                0376      &          southRecvAck(1,bi,bj), northRecvAck(1,bi,bj), spinCount
                0377 #endif
c806179eb4 Alis*0378    10    CONTINUE
27977973af Jean*0379           CALL FOOL_THE_COMPILER( spinCount )
c806179eb4 Alis*0380           spinCount = spinCount+1
aa582c8e8c Jean*0381 #ifdef DBUG_EXCH_VEC
                0382           write(ioUnit,'(A,5I6,I12)') 'spin:', myProcId,bi,bj,
                0383      &          southRecvAck(1,bi,bj), northRecvAck(1,bi,bj), spinCount
                0384           IF ( myThid.EQ.1 .AND. spinCount.GT. _EXCH_SPIN_LIMIT ) THEN
                0385            STOP ' S/R EXCH_RECV_GET_X: spinCount > _EXCH_SPIN_LIMIT'
                0386           ENDIF
                0387 #endif
                0388           IF ( southRecvAck(1,bi,bj) .EQ. 0 ) GOTO 10
                0389           IF ( northRecvAck(1,bi,bj) .EQ. 0 ) GOTO 10
c806179eb4 Alis*0390 C        Clear outstanding requests
aa582c8e8c Jean*0391          southRecvAck(1,bi,bj) = 0
                0392          northRecvAck(1,bi,bj) = 0
c806179eb4 Alis*0393         ENDDO
                0394        ENDDO
                0395       ENDIF
bd12238ff3 Jean*0396 #endif /* EXCH_USE_SPINNING */
c806179eb4 Alis*0397 
                0398       RETURN
                0399       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!