pkg/flt/flt_exch2.F

ad773b031f Oliv*0001 #include "FLT_OPTIONS.h"
                0002 #undef DBUG_EXCH_VEC
                0003
                0004       SUBROUTINE FLT_EXCH2 (
                0005      I                       myTime, myIter, myThid )
                0006
                0007 C     ==================================================================
                0008 C     SUBROUTINE FLT_EXCH2
                0009 C     ==================================================================
                0010 C     o Exchange particles between tiles.
                0011 C     started: Arne Biastoch
                0012 C     changed: Antti Westerlund antti.westerlund@helsinki.fi 2004.06.10
                0013 C     adapted to exch2: Oliver Jahn 2010.09
                0014 C     ==================================================================
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018
                0019 C     == global variables ==
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "EESUPPORT.h"
                0023 #include "PARAMS.h"
730d8469b1 Oliv*0024 #include "FLT_SIZE.h"
ad773b031f Oliv*0025 #include "FLT.h"
                0026 #ifdef ALLOW_EXCH2
                0027 #include "W2_EXCH2_SIZE.h"
                0028 #include "W2_EXCH2_PARAMS.h"
                0029 #include "W2_EXCH2_TOPOLOGY.h"
                0030 #endif
                0031
                0032 C     == routine arguments ==
                0033       _RL myTime
                0034       INTEGER myIter, myThid
                0035
                0036 #ifdef ALLOW_EXCH2
                0037
                0038 C     == local variables ==
                0039       INTEGER bi, bj, ic
                0040       INTEGER ip, jp, jl, npNew
                0041       INTEGER icountE, icountW, icountN, icountS
                0042       INTEGER deleteList(max_npart_exch*2)
                0043       INTEGER imax, imax2, m
c028f94099 Jean*0044       INTEGER N, nT, ipass, myFace
ad773b031f Oliv*0045       INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )
36764e47d7 gael*0046       _RL ilo, ihi, jlo, jhi
ad773b031f Oliv*0047       PARAMETER(imax=9)
                0048       PARAMETER(imax2=imax*max_npart_exch)
                0049       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0050
c028f94099 Jean*0051 C     buffer for sending/receiving variables (4 levels <-> N,S,E,W)
ad773b031f Oliv*0052       COMMON/FLTBUF/fltbuf_send,fltbuf_recv
                0053       _RL fltbuf_send(imax2,nSx,nSy,4)
                0054       _RL fltbuf_recv(imax2,nSx,nSy,4)
                0055       LOGICAL wSide, eSide, sSide, nSide
                0056       _RL     flt_stopped
                0057
                0058 C     == end of interface ==
                0059
                0060 C have to do 2 passes to get into tiles diagonally across
                0061       DO ipass=1,2
                0062
                0063 C     Prevent anyone to access shared buffer while an other thread modifies it
c028f94099 Jean*0064 C--   not needed here since send buffer is different fron recv buffer
                0065 C     (which is not the case for usual 3-D field exch in EXCH2)
                0066 c       CALL BAR2( myThid )
ad773b031f Oliv*0067
                0068 C--   Choose floats that have to exchanged with eastern and western tiles
                0069 C     and pack to arrays
                0070
                0071         DO bj=myByLo(myThid),myByHi(myThid)
                0072          DO bi=myBxLo(myThid),myBxHi(myThid)
                0073            nT = W2_myTileList(bi,bj)
                0074            myFace = exch2_myFace(nT)
                0075
                0076 C initialize buffers
                0077            DO N=1,4
c028f94099 Jean*0078             DO m=1,imax2
ad773b031f Oliv*0079              fltbuf_send(m,bi,bj,N) = 0.
                0080              fltbuf_recv(m,bi,bj,N) = 0.
c028f94099 Jean*0081             ENDDO
ad773b031f Oliv*0082            ENDDO
                0083
                0084            icountE=0
                0085            icountW=0
                0086            jl = 0
                0087
                0088            ilo = 0.5 _d 0
                0089            ihi = 0.5 _d 0 + DFLOAT(sNx)
c028f94099 Jean*0090            wSide = exch2_isWedge(nT).EQ.1
                0091      &       .AND. facet_link(W2_WEST,myFace).EQ.0.
                0092            eSide = exch2_isEedge(nT).EQ.1
                0093      &       .AND. facet_link(W2_EAST,myFace).EQ.0.
ad773b031f Oliv*0094            flt_stopped = -2.
                0095            flt_stopped = MIN( baseTime, flt_stopped )
                0096
                0097            DO ip=1,npart_tile(bi,bj)
                0098
                0099              IF ( eSide .AND.
                0100      &           (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
                0101      &           .AND. ipart(ip,bi,bj).GE.ihi ) THEN
                0102 C          stop the float:
                0103               tend(ip,bi,bj) = flt_stopped
                0104              ELSEIF ( ipart(ip,bi,bj).GE.ihi ) THEN
                0105               icountE=icountE+1
                0106               IF ( icountE.LE.max_npart_exch ) THEN
                0107
                0108                ic = (icountE-1)*imax
                0109                fltbuf_send(ic+1,bi,bj,W2_EAST) =   npart(ip,bi,bj)
                0110                fltbuf_send(ic+2,bi,bj,W2_EAST) =  tstart(ip,bi,bj)
f5995a4aae Gael*0111                fltbuf_send(ic+3,bi,bj,W2_EAST) =   ipart(ip,bi,bj)
ad773b031f Oliv*0112                fltbuf_send(ic+4,bi,bj,W2_EAST) =   jpart(ip,bi,bj)
                0113                fltbuf_send(ic+5,bi,bj,W2_EAST) =   kpart(ip,bi,bj)
                0114                fltbuf_send(ic+6,bi,bj,W2_EAST) =  kfloat(ip,bi,bj)
                0115                fltbuf_send(ic+7,bi,bj,W2_EAST) =     iup(ip,bi,bj)
                0116                fltbuf_send(ic+8,bi,bj,W2_EAST) =    itop(ip,bi,bj)
                0117                fltbuf_send(ic+9,bi,bj,W2_EAST) =    tend(ip,bi,bj)
                0118
                0119 C tag this float to be removed:
                0120                jl = jl + 1
                0121                deleteList(jl) = ip
                0122                npart(ip,bi,bj) = 0.
                0123
                0124               ENDIF
                0125              ENDIF
                0126
                0127              IF ( wSide .AND.
                0128      &           (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
                0129      &           .AND. ipart(ip,bi,bj).LT.ilo ) THEN
                0130 C          stop the float:
                0131               tend(ip,bi,bj) = flt_stopped
                0132              ELSEIF ( ipart(ip,bi,bj).LT.ilo ) THEN
                0133               icountW=icountW+1
                0134               IF ( icountW.LE.max_npart_exch ) THEN
                0135
                0136                ic = (icountW-1)*imax
                0137                fltbuf_send(ic+1,bi,bj,W2_WEST) =   npart(ip,bi,bj)
                0138                fltbuf_send(ic+2,bi,bj,W2_WEST) =  tstart(ip,bi,bj)
f5995a4aae Gael*0139                fltbuf_send(ic+3,bi,bj,W2_WEST) =   ipart(ip,bi,bj)
ad773b031f Oliv*0140                fltbuf_send(ic+4,bi,bj,W2_WEST) =   jpart(ip,bi,bj)
                0141                fltbuf_send(ic+5,bi,bj,W2_WEST) =   kpart(ip,bi,bj)
                0142                fltbuf_send(ic+6,bi,bj,W2_WEST) =  kfloat(ip,bi,bj)
                0143                fltbuf_send(ic+7,bi,bj,W2_WEST) =     iup(ip,bi,bj)
                0144                fltbuf_send(ic+8,bi,bj,W2_WEST) =    itop(ip,bi,bj)
                0145                fltbuf_send(ic+9,bi,bj,W2_WEST) =    tend(ip,bi,bj)
                0146
                0147 C tag this float to be removed:
                0148                jl = jl + 1
                0149                deleteList(jl) = ip
                0150                npart(ip,bi,bj) = 0.
                0151
                0152               ENDIF
                0153              ENDIF
                0154
                0155            ENDDO
                0156            IF ( icountE.GT.max_npart_exch ) THEN
                0157              WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCH2:',
                0158      &         ' bi,bj=', bi, bj,
                0159      &         ' icountE=', icountE,
                0160      &         ' > max_npart_exch=', max_npart_exch
                0161              CALL PRINT_ERROR( msgBuf, myThid )
                0162            ENDIF
                0163            IF ( icountW.GT.max_npart_exch ) THEN
                0164              WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCH2:',
                0165      &         ' bi,bj=', bi, bj,
                0166      &         ' icountW=', icountW,
                0167      &         ' > max_npart_exch=', max_npart_exch
                0168              CALL PRINT_ERROR( msgBuf, myThid )
                0169            ENDIF
                0170            IF ( icountE.GT.max_npart_exch
                0171      &     .OR. icountW.GT.max_npart_exch ) THEN
                0172              STOP 'ABNORMAL END: S/R FLT_EXCH2'
                0173            ENDIF
                0174            IF ( (icountE+icountW).GT.0 ) THEN
                0175 C Remove from this tile-list, floats which have been sent to an other tile
                0176              npNew = npart_tile(bi,bj) - (icountE+icountW)
                0177              jl = 0
                0178              DO jp = npNew+1,npart_tile(bi,bj)
                0179               IF ( npart(jp,bi,bj).NE.0. _d 0 ) THEN
                0180                 jl = jl + 1
                0181                 ip = deleteList(jl)
                0182 C        copy: ip <-- jp
                0183                 npart (ip,bi,bj) =  npart (jp,bi,bj)
                0184                 tstart(ip,bi,bj) =  tstart(jp,bi,bj)
                0185                 ipart (ip,bi,bj) =  ipart (jp,bi,bj)
                0186                 jpart (ip,bi,bj) =  jpart (jp,bi,bj)
                0187                 kpart (ip,bi,bj) =  kpart (jp,bi,bj)
                0188                 kfloat(ip,bi,bj) =  kfloat(jp,bi,bj)
                0189                 iup   (ip,bi,bj) =  iup   (jp,bi,bj)
                0190                 itop  (ip,bi,bj) =  itop  (jp,bi,bj)
                0191                 tend  (ip,bi,bj) =  tend  (jp,bi,bj)
                0192               ENDIF
                0193              ENDDO
                0194              npart_tile(bi,bj) = npNew
                0195            ENDIF
                0196
                0197            icountN=0
                0198            icountS=0
                0199            jl = 0
                0200
                0201            jlo = 0.5 _d 0
                0202            jhi = 0.5 _d 0 + DFLOAT(sNy)
c028f94099 Jean*0203            sSide = exch2_isSedge(nT).EQ.1
                0204      &       .AND. facet_link(W2_SOUTH,myFace).EQ.0.
                0205            nSide = exch2_isNedge(nT).EQ.1
                0206      &       .AND. facet_link(W2_NORTH,myFace).EQ.0.
ad773b031f Oliv*0207            flt_stopped = -2.
                0208            flt_stopped = MIN( baseTime, flt_stopped )
                0209
                0210            DO ip=1,npart_tile(bi,bj)
                0211
                0212             IF ( npart(ip,bi,bj).NE.0 ) THEN
                0213
                0214              IF ( nSide .AND.
                0215      &           (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
                0216      &           .AND. jpart(ip,bi,bj).GE.jhi ) THEN
                0217 C          stop the float:
                0218               tend(ip,bi,bj) = flt_stopped
                0219              ELSEIF ( jpart(ip,bi,bj).GE.jhi ) THEN
                0220               icountN=icountN+1
                0221               IF ( icountN.LE.max_npart_exch ) THEN
                0222
                0223                ic = (icountN-1)*imax
                0224                fltbuf_send(ic+1,bi,bj,W2_NORTH) =   npart(ip,bi,bj)
                0225                fltbuf_send(ic+2,bi,bj,W2_NORTH) =  tstart(ip,bi,bj)
                0226                fltbuf_send(ic+3,bi,bj,W2_NORTH) =   ipart(ip,bi,bj)
f5995a4aae Gael*0227                fltbuf_send(ic+4,bi,bj,W2_NORTH) =   jpart(ip,bi,bj)
ad773b031f Oliv*0228                fltbuf_send(ic+5,bi,bj,W2_NORTH) =   kpart(ip,bi,bj)
                0229                fltbuf_send(ic+6,bi,bj,W2_NORTH) =  kfloat(ip,bi,bj)
                0230                fltbuf_send(ic+7,bi,bj,W2_NORTH) =     iup(ip,bi,bj)
                0231                fltbuf_send(ic+8,bi,bj,W2_NORTH) =    itop(ip,bi,bj)
                0232                fltbuf_send(ic+9,bi,bj,W2_NORTH) =    tend(ip,bi,bj)
                0233
                0234 C tag this float to be removed:
                0235                jl = jl + 1
                0236                deleteList(jl) = ip
                0237                npart(ip,bi,bj) = 0.
                0238
                0239 c             ELSE
                0240 c              WRITE(msgBuf,'(2A,2I4,I6,A,2F17.6))') ' FLT_EXCH2,N:',
                0241 c    &         ' bi,bj,ip=', bi, bj, ip,
                0242 c    &         ' yp,yHi=', jpart(ip,bi,bj), jhi
                0243 c              CALL PRINT_ERROR( msgBuf, myThid )
                0244               ENDIF
                0245              ENDIF
                0246
                0247              IF ( sSide .AND.
                0248      &           (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
                0249      &           .AND. jpart(ip,bi,bj).LT.jlo ) THEN
                0250 C          stop the float:
                0251               tend(ip,bi,bj) = flt_stopped
                0252              ELSEIF ( jpart(ip,bi,bj).LT.jlo ) THEN
                0253               icountS=icountS+1
                0254               IF ( icountS.LE.max_npart_exch ) THEN
                0255
                0256                ic = (icountS-1)*imax
                0257                fltbuf_send(ic+1,bi,bj,W2_SOUTH) =   npart(ip,bi,bj)
                0258                fltbuf_send(ic+2,bi,bj,W2_SOUTH) =  tstart(ip,bi,bj)
                0259                fltbuf_send(ic+3,bi,bj,W2_SOUTH) =   ipart(ip,bi,bj)
f5995a4aae Gael*0260                fltbuf_send(ic+4,bi,bj,W2_SOUTH) =   jpart(ip,bi,bj)
ad773b031f Oliv*0261                fltbuf_send(ic+5,bi,bj,W2_SOUTH) =   kpart(ip,bi,bj)
                0262                fltbuf_send(ic+6,bi,bj,W2_SOUTH) =  kfloat(ip,bi,bj)
                0263                fltbuf_send(ic+7,bi,bj,W2_SOUTH) =     iup(ip,bi,bj)
                0264                fltbuf_send(ic+8,bi,bj,W2_SOUTH) =    itop(ip,bi,bj)
                0265                fltbuf_send(ic+9,bi,bj,W2_SOUTH) =    tend(ip,bi,bj)
                0266
                0267 C tag this float to be removed:
                0268                jl = jl + 1
                0269                deleteList(jl) = ip
                0270                npart(ip,bi,bj) = 0.
                0271
                0272 c             ELSE
                0273 c              WRITE(msgBuf,'(2A,2I4,I6,A,2F17.6))') ' FLT_EXCH2,S:',
                0274 c    &         ' bi,bj,ip=', bi, bj, ip,
                0275 c    &         ' yp,yLo=', jpart(ip,bi,bj), jlo
                0276 c              CALL PRINT_ERROR( msgBuf, myThid )
                0277               ENDIF
                0278              ENDIF
                0279
                0280             ENDIF
                0281
                0282            ENDDO
                0283            IF ( icountN.GT.max_npart_exch ) THEN
                0284              WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCH2:',
                0285      &         ' bi,bj=', bi, bj,
                0286      &         ' icountN=', icountN,
                0287      &         ' > max_npart_exch=', max_npart_exch
                0288              CALL PRINT_ERROR( msgBuf, myThid )
                0289            ENDIF
                0290            IF ( icountS.GT.max_npart_exch ) THEN
                0291              WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCH2:',
                0292      &         ' bi,bj=', bi, bj,
                0293      &         ' icountS=', icountS,
                0294      &         ' > max_npart_exch=', max_npart_exch
                0295              CALL PRINT_ERROR( msgBuf, myThid )
                0296            ENDIF
                0297            IF ( icountN.GT.max_npart_exch
                0298      &     .OR. icountS.GT.max_npart_exch ) THEN
                0299              STOP 'ABNORMAL END: S/R FLT_EXCH2'
                0300            ENDIF
                0301            IF ( (icountN+icountS).GT.0 ) THEN
                0302 C Remove from this tile-list, floats which have been sent to an other tile
                0303              npNew = npart_tile(bi,bj) - (icountN+icountS)
                0304              jl = 0
                0305              DO jp = npNew+1,npart_tile(bi,bj)
                0306               IF ( npart(jp,bi,bj).NE.0. _d 0 ) THEN
                0307                 jl = jl + 1
                0308                 ip = deleteList(jl)
                0309 C        copy: ip <-- jp
                0310                 npart (ip,bi,bj) =  npart (jp,bi,bj)
                0311                 tstart(ip,bi,bj) =  tstart(jp,bi,bj)
                0312                 ipart (ip,bi,bj) =  ipart (jp,bi,bj)
                0313                 jpart (ip,bi,bj) =  jpart (jp,bi,bj)
                0314                 kpart (ip,bi,bj) =  kpart (jp,bi,bj)
                0315                 kfloat(ip,bi,bj) =  kfloat(jp,bi,bj)
                0316                 iup   (ip,bi,bj) =  iup   (jp,bi,bj)
                0317                 itop  (ip,bi,bj) =  itop  (jp,bi,bj)
                0318                 tend  (ip,bi,bj) =  tend  (jp,bi,bj)
                0319               ENDIF
                0320              ENDDO
                0321              npart_tile(bi,bj) = npNew
                0322            ENDIF
                0323
                0324          ENDDO
                0325         ENDDO
                0326
c028f94099 Jean*0327 C     Prevent anyone to access shared buffer while an other thread modifies it
                0328         _BARRIER
                0329
ad773b031f Oliv*0330 C--   Send or Put east and west edges.
                0331
                0332 #ifdef DBUG_EXCH_VEC
                0333         WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 0x', myIter
                0334 #endif
c028f94099 Jean*0335         CALL EXCH2_SEND_PUT_VEC_RL(
                0336      I                               fltbuf_send,
                0337      O                               fltbuf_recv,
ad773b031f Oliv*0338      O                               e2_msgHandles(1,1,1,1),
                0339      I                               imax2, myThid )
                0340 #ifdef DBUG_EXCH_VEC
                0341         WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH2: 1x', myIter
                0342 #endif
c028f94099 Jean*0343
                0344 #ifdef ALLOW_USE_MPI
                0345         IF ( usingMPI ) THEN
ad773b031f Oliv*0346 C--   Receive east/west arrays
c028f94099 Jean*0347          CALL EXCH2_RECV_GET_VEC_RL(
ad773b031f Oliv*0348      U                               fltbuf_recv,
c028f94099 Jean*0349      I                               e2_msgHandles(1,1,1,1),
ad773b031f Oliv*0350      I                               imax2, myThid )
                0351 #ifdef DBUG_EXCH_VEC
c028f94099 Jean*0352          WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH2: 2x', myIter
ad773b031f Oliv*0353 #endif
c028f94099 Jean*0354         ENDIF
                0355 #endif /* ALLOW_USE_MPI */
ad773b031f Oliv*0356
c028f94099 Jean*0357 C--   need to sync threads after master has received data ;
                0358 C     (done after mpi waitall in case waitall is really needed)
                0359         _BARRIER
ad773b031f Oliv*0360
                0361 C--   Unpack arrays on new tiles
                0362
                0363         DO bj=myByLo(myThid),myByHi(myThid)
                0364          DO bi=myBxLo(myThid),myBxHi(myThid)
                0365
                0366            DO ip=1,max_npart_exch
                0367
                0368             ic=(ip-1)*imax
                0369             IF ( fltbuf_recv(ic+1,bi,bj,W2_EAST).NE.0. ) THEN
                0370              npart_tile(bi,bj) = npart_tile(bi,bj) + 1
                0371              IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
                0372                jp = npart_tile(bi,bj)
                0373                npart( jp,bi,bj) = fltbuf_recv(ic+1,bi,bj,W2_EAST)
                0374                tstart(jp,bi,bj) = fltbuf_recv(ic+2,bi,bj,W2_EAST)
                0375                ipart( jp,bi,bj) = fltbuf_recv(ic+3,bi,bj,W2_EAST)
                0376                jpart( jp,bi,bj) = fltbuf_recv(ic+4,bi,bj,W2_EAST)
                0377                kpart( jp,bi,bj) = fltbuf_recv(ic+5,bi,bj,W2_EAST)
                0378                kfloat(jp,bi,bj) = fltbuf_recv(ic+6,bi,bj,W2_EAST)
                0379                iup(   jp,bi,bj) = fltbuf_recv(ic+7,bi,bj,W2_EAST)
                0380                itop(  jp,bi,bj) = fltbuf_recv(ic+8,bi,bj,W2_EAST)
                0381                tend(  jp,bi,bj) = fltbuf_recv(ic+9,bi,bj,W2_EAST)
                0382              ENDIF
                0383             ENDIF
                0384
                0385            ENDDO
                0386            IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
                0387              WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCH2:+E',
                0388      &         ' bi,bj=', bi, bj,
                0389      &         ' npart_tile=', npart_tile(bi,bj),
                0390      &         ' > max_npart_tile=', max_npart_tile
                0391               CALL PRINT_ERROR( msgBuf, myThid )
                0392               STOP 'ABNORMAL END: S/R FLT_EXCH2'
                0393            ENDIF
                0394
                0395            DO ip=1,max_npart_exch
                0396
                0397             ic=(ip-1)*imax
                0398             IF ( fltbuf_recv(ic+1,bi,bj,W2_WEST).NE.0. ) THEN
                0399              npart_tile(bi,bj) = npart_tile(bi,bj) + 1
                0400              IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
                0401                jp = npart_tile(bi,bj)
                0402                npart( jp,bi,bj) = fltbuf_recv(ic+1,bi,bj,W2_WEST)
                0403                tstart(jp,bi,bj) = fltbuf_recv(ic+2,bi,bj,W2_WEST)
                0404                ipart( jp,bi,bj) = fltbuf_recv(ic+3,bi,bj,W2_WEST)
                0405                jpart( jp,bi,bj) = fltbuf_recv(ic+4,bi,bj,W2_WEST)
                0406                kpart( jp,bi,bj) = fltbuf_recv(ic+5,bi,bj,W2_WEST)
                0407                kfloat(jp,bi,bj) = fltbuf_recv(ic+6,bi,bj,W2_WEST)
                0408                iup(   jp,bi,bj) = fltbuf_recv(ic+7,bi,bj,W2_WEST)
                0409                itop(  jp,bi,bj) = fltbuf_recv(ic+8,bi,bj,W2_WEST)
                0410                tend(  jp,bi,bj) = fltbuf_recv(ic+9,bi,bj,W2_WEST)
                0411              ENDIF
                0412             ENDIF
                0413
                0414            ENDDO
                0415            IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
                0416              WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCH2:+W',
                0417      &         ' bi,bj=', bi, bj,
                0418      &         ' npart_tile=', npart_tile(bi,bj),
                0419      &         ' > max_npart_tile=', max_npart_tile
                0420               CALL PRINT_ERROR( msgBuf, myThid )
                0421               STOP 'ABNORMAL END: S/R FLT_EXCH2'
                0422            ENDIF
                0423
                0424            DO ip=1,max_npart_exch
                0425
                0426             ic=(ip-1)*imax
                0427             IF ( fltbuf_recv(ic+1,bi,bj,W2_NORTH).NE.0. ) THEN
                0428              npart_tile(bi,bj) = npart_tile(bi,bj) + 1
                0429              IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
                0430                jp = npart_tile(bi,bj)
                0431                npart( jp,bi,bj) = fltbuf_recv(ic+1,bi,bj,W2_NORTH)
                0432                tstart(jp,bi,bj) = fltbuf_recv(ic+2,bi,bj,W2_NORTH)
                0433                ipart( jp,bi,bj) = fltbuf_recv(ic+3,bi,bj,W2_NORTH)
                0434                jpart( jp,bi,bj) = fltbuf_recv(ic+4,bi,bj,W2_NORTH)
                0435                kpart( jp,bi,bj) = fltbuf_recv(ic+5,bi,bj,W2_NORTH)
                0436                kfloat(jp,bi,bj) = fltbuf_recv(ic+6,bi,bj,W2_NORTH)
                0437                iup(   jp,bi,bj) = fltbuf_recv(ic+7,bi,bj,W2_NORTH)
                0438                itop(  jp,bi,bj) = fltbuf_recv(ic+8,bi,bj,W2_NORTH)
                0439                tend(  jp,bi,bj) = fltbuf_recv(ic+9,bi,bj,W2_NORTH)
                0440              ENDIF
                0441             ENDIF
                0442
                0443            ENDDO
                0444            IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
                0445              WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCH2:+N',
                0446      &         ' bi,bj=', bi, bj,
                0447      &         ' npart_tile=', npart_tile(bi,bj),
                0448      &         ' > max_npart_tile=', max_npart_tile
                0449               CALL PRINT_ERROR( msgBuf, myThid )
                0450               STOP 'ABNORMAL END: S/R FLT_EXCH2'
                0451            ENDIF
                0452
                0453            DO ip=1,max_npart_exch
                0454
                0455             ic=(ip-1)*imax
                0456             IF ( fltbuf_recv(ic+1,bi,bj,W2_SOUTH).NE.0. ) THEN
                0457              npart_tile(bi,bj) = npart_tile(bi,bj) + 1
                0458              IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
                0459                jp = npart_tile(bi,bj)
                0460                npart( jp,bi,bj) = fltbuf_recv(ic+1,bi,bj,W2_SOUTH)
                0461                tstart(jp,bi,bj) = fltbuf_recv(ic+2,bi,bj,W2_SOUTH)
                0462                ipart( jp,bi,bj) = fltbuf_recv(ic+3,bi,bj,W2_SOUTH)
                0463                jpart( jp,bi,bj) = fltbuf_recv(ic+4,bi,bj,W2_SOUTH)
                0464                kpart( jp,bi,bj) = fltbuf_recv(ic+5,bi,bj,W2_SOUTH)
                0465                kfloat(jp,bi,bj) = fltbuf_recv(ic+6,bi,bj,W2_SOUTH)
                0466                iup(   jp,bi,bj) = fltbuf_recv(ic+7,bi,bj,W2_SOUTH)
                0467                itop(  jp,bi,bj) = fltbuf_recv(ic+8,bi,bj,W2_SOUTH)
                0468                tend(  jp,bi,bj) = fltbuf_recv(ic+9,bi,bj,W2_SOUTH)
                0469              ENDIF
                0470             ENDIF
                0471
                0472            ENDDO
                0473            IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
                0474              WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCH2:+S',
                0475      &         ' bi,bj=', bi, bj,
                0476      &         ' npart_tile=', npart_tile(bi,bj),
                0477      &         ' > max_npart_tile=', max_npart_tile
                0478               CALL PRINT_ERROR( msgBuf, myThid )
                0479               STOP 'ABNORMAL END: S/R FLT_EXCH2'
                0480            ENDIF
                0481
                0482          ENDDO
                0483         ENDDO
                0484
                0485 C ipass
                0486       ENDDO
                0487
                0488 #endif /* ALLOW_EXCH2 */
                0489
                0490       RETURN
                0491       END