#include "FLT_OPTIONS.h"
#undef DBUG_EXCH_VEC

      SUBROUTINE FLT_EXCHG (
     I                       myTime, myIter, myThid )

C     ==================================================================
C     SUBROUTINE FLT_EXCHG
C     ==================================================================
C     o Exchange particles between tiles.
C     started: Arne Biastoch
C     changed: Antti Westerlund antti.westerlund@helsinki.fi 2004.06.10
C     ==================================================================

C     !USES:
      IMPLICIT NONE

C     == global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "FLT_SIZE.h"
#include "FLT.h"

C     == routine arguments ==
      _RL myTime
      INTEGER myIter, myThid

C     == shared variables ==
C-    buffer for sending/receiving variables (E/W are also used for S/N)
C     (needs to be in common block for multi-threaded)
      INTEGER imax, imax2
      PARAMETER(imax=9)
      PARAMETER(imax2=imax*max_npart_exch)
      _RL fltbuf_sendE(imax2,nSx,nSy)
      _RL fltbuf_sendW(imax2,nSx,nSy)
      _RL fltbuf_recvE(imax2,nSx,nSy)
      _RL fltbuf_recvW(imax2,nSx,nSy)
      COMMON / FLT_EXCHG_BUFF /
     &   fltbuf_sendE, fltbuf_sendW, fltbuf_recvE, fltbuf_recvW

C     == local variables ==
      INTEGER bi, bj, ic
      INTEGER ip, jp, jl, m, npNew
      INTEGER icountE, icountW, icountN, icountS
      INTEGER deleteList(max_npart_exch*2)
      _RL ilo, ihi, jlo, jhi, iNew, jNew
      CHARACTER*(MAX_LEN_MBUF) msgBuf
#ifdef FLT_WITHOUT_X_PERIODICITY
      LOGICAL wSide, eSide
#endif /* FLT_WITHOUT_X_PERIODICITY */
#ifdef FLT_WITHOUT_Y_PERIODICITY
      LOGICAL sSide, nSide
#endif /* FLT_WITHOUT_Y_PERIODICITY */
      _RL     flt_stopped

C     == end of interface ==

C--   set the "end-time" of a stopped float
      flt_stopped = -2.
      flt_stopped = MIN( baseTime, flt_stopped )

Caw Check if there are eastern/western tiles
c     IF ( Nx.NE.sNx ) THEN
C--   for periodic domain, condition above is wrong ; needs a better test
      IF ( .TRUE. ) THEN

C--   Choose floats that have to exchanged with eastern and western tiles
C     and pack to arrays

        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)

C initialize buffers
           DO m=1,imax2
             fltbuf_sendE(m,bi,bj) = 0.
             fltbuf_sendW(m,bi,bj) = 0.
             fltbuf_recvE(m,bi,bj) = 0.
             fltbuf_recvW(m,bi,bj) = 0.
           ENDDO

           icountE=0
           icountW=0
           jl = 0

           ilo = 0.5 _d 0
           ihi = 0.5 _d 0 + DFLOAT(sNx)
#ifdef FLT_WITHOUT_X_PERIODICITY
           wSide = myXGlobalLo+bi .LE.2
           eSide = myXGlobalLo+bi*sNx.GT.Nx
#endif /* FLT_WITHOUT_X_PERIODICITY */

           DO ip=1,npart_tile(bi,bj)

#ifdef FLT_WITHOUT_X_PERIODICITY
             IF ( eSide .AND.
     &           (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
     &           .AND. ipart(ip,bi,bj).GE.ihi ) THEN
C          stop the float:
              tend(ip,bi,bj) = flt_stopped
             ELSEIF ( ipart(ip,bi,bj).GE.ihi ) THEN
#else /* FLT_WITHOUT_X_PERIODICITY */
             IF ( ipart(ip,bi,bj).GE.ihi ) THEN
#endif /* FLT_WITHOUT_X_PERIODICITY */
              icountE=icountE+1
              IF ( icountE.LE.max_npart_exch ) THEN

               ic = (icountE-1)*imax
               iNew = ipart(ip,bi,bj) - DFLOAT(sNx)
               fltbuf_sendE(ic+1,bi,bj) =   npart(ip,bi,bj)
               fltbuf_sendE(ic+2,bi,bj) =  tstart(ip,bi,bj)
               fltbuf_sendE(ic+3,bi,bj) =   iNew
               fltbuf_sendE(ic+4,bi,bj) =   jpart(ip,bi,bj)
               fltbuf_sendE(ic+5,bi,bj) =   kpart(ip,bi,bj)
               fltbuf_sendE(ic+6,bi,bj) =  kfloat(ip,bi,bj)
               fltbuf_sendE(ic+7,bi,bj) =     iup(ip,bi,bj)
               fltbuf_sendE(ic+8,bi,bj) =    itop(ip,bi,bj)
               fltbuf_sendE(ic+9,bi,bj) =    tend(ip,bi,bj)

C tag this float to be removed:
               jl = jl + 1
               deleteList(jl) = ip
               npart(ip,bi,bj) = 0.

              ENDIF
             ENDIF

#ifdef FLT_WITHOUT_X_PERIODICITY
             IF ( wSide .AND.
     &           (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
     &           .AND. ipart(ip,bi,bj).LT.ilo ) THEN
C          stop the float:
              tend(ip,bi,bj) = flt_stopped
             ELSEIF ( ipart(ip,bi,bj).LT.ilo ) THEN
#else /* FLT_WITHOUT_X_PERIODICITY */
             IF ( ipart(ip,bi,bj).LT.ilo ) THEN
#endif /* FLT_WITHOUT_X_PERIODICITY */
              icountW=icountW+1
              IF ( icountW.LE.max_npart_exch ) THEN

               ic = (icountW-1)*imax
               iNew = ipart(ip,bi,bj) + DFLOAT(sNx)
               fltbuf_sendW(ic+1,bi,bj) =   npart(ip,bi,bj)
               fltbuf_sendW(ic+2,bi,bj) =  tstart(ip,bi,bj)
               fltbuf_sendW(ic+3,bi,bj) =   iNew
               fltbuf_sendW(ic+4,bi,bj) =   jpart(ip,bi,bj)
               fltbuf_sendW(ic+5,bi,bj) =   kpart(ip,bi,bj)
               fltbuf_sendW(ic+6,bi,bj) =  kfloat(ip,bi,bj)
               fltbuf_sendW(ic+7,bi,bj) =     iup(ip,bi,bj)
               fltbuf_sendW(ic+8,bi,bj) =    itop(ip,bi,bj)
               fltbuf_sendW(ic+9,bi,bj) =    tend(ip,bi,bj)

C tag this float to be removed:
               jl = jl + 1
               deleteList(jl) = ip
               npart(ip,bi,bj) = 0.

              ENDIF
             ENDIF

           ENDDO
           IF ( icountE.GT.max_npart_exch ) THEN
             WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCHG:',
     &         ' bi,bj=', bi, bj,
     &         ' icountE=', icountE,
     &         ' > max_npart_exch=', max_npart_exch
             CALL PRINT_ERROR( msgBuf, myThid )
           ENDIF
           IF ( icountW.GT.max_npart_exch ) THEN
             WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCHG:',
     &         ' bi,bj=', bi, bj,
     &         ' icountW=', icountW,
     &         ' > max_npart_exch=', max_npart_exch
             CALL PRINT_ERROR( msgBuf, myThid )
           ENDIF
           IF ( icountE.GT.max_npart_exch
     &     .OR. icountW.GT.max_npart_exch ) THEN
             STOP 'ABNORMAL END: S/R FLT_EXCHG'
           ENDIF
           IF ( (icountE+icountW).GT.0 ) THEN
C Remove from this tile-list, floats which have been sent to an other tile
             npNew = npart_tile(bi,bj) - (icountE+icountW)
             jl = 0
             DO jp = npNew+1,npart_tile(bi,bj)
              IF ( npart(jp,bi,bj).NE.0. _d 0 ) THEN
                jl = jl + 1
                ip = deleteList(jl)
C        copy: ip <-- jp
                npart (ip,bi,bj) =  npart (jp,bi,bj)
                tstart(ip,bi,bj) =  tstart(jp,bi,bj)
                ipart (ip,bi,bj) =  ipart (jp,bi,bj)
                jpart (ip,bi,bj) =  jpart (jp,bi,bj)
                kpart (ip,bi,bj) =  kpart (jp,bi,bj)
                kfloat(ip,bi,bj) =  kfloat(jp,bi,bj)
                iup   (ip,bi,bj) =  iup   (jp,bi,bj)
                itop  (ip,bi,bj) =  itop  (jp,bi,bj)
                tend  (ip,bi,bj) =  tend  (jp,bi,bj)
              ENDIF
             ENDDO
             npart_tile(bi,bj) = npNew
           ENDIF

         ENDDO
        ENDDO

C--   Send or Put east and west edges.

#ifdef DBUG_EXCH_VEC
        WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 0x', myIter
#endif
        CALL EXCH_SEND_PUT_VEC_X_RL(
     I                               fltbuf_sendE, fltbuf_sendW,
     O                               fltbuf_recvE, fltbuf_recvW,
     I                               imax2, myThid )
#ifdef DBUG_EXCH_VEC
        WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 1x', myIter
#endif
C--   Receive east/west arrays
        CALL EXCH_RECV_GET_VEC_X_RL(
     U                               fltbuf_recvE, fltbuf_recvW,
     I                               imax2, myThid )
#ifdef DBUG_EXCH_VEC
        WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 2x', myIter
#endif

C--   Unpack arrays on new tiles

        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)

           DO ip=1,max_npart_exch

            ic=(ip-1)*imax
            IF ( fltbuf_recvE(ic+1,bi,bj).NE.0. ) THEN
             npart_tile(bi,bj) = npart_tile(bi,bj) + 1
             IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
               jp = npart_tile(bi,bj)
               npart( jp,bi,bj) = fltbuf_recvE(ic+1,bi,bj)
               tstart(jp,bi,bj) = fltbuf_recvE(ic+2,bi,bj)
               ipart( jp,bi,bj) = fltbuf_recvE(ic+3,bi,bj)
               jpart( jp,bi,bj) = fltbuf_recvE(ic+4,bi,bj)
               kpart( jp,bi,bj) = fltbuf_recvE(ic+5,bi,bj)
               kfloat(jp,bi,bj) = fltbuf_recvE(ic+6,bi,bj)
               iup(   jp,bi,bj) = fltbuf_recvE(ic+7,bi,bj)
               itop(  jp,bi,bj) = fltbuf_recvE(ic+8,bi,bj)
               tend(  jp,bi,bj) = fltbuf_recvE(ic+9,bi,bj)
             ENDIF
            ENDIF

           ENDDO
           IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
             WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCHG:+E',
     &         ' bi,bj=', bi, bj,
     &         ' npart_tile=', npart_tile(bi,bj),
     &         ' > max_npart_tile=', max_npart_tile
              CALL PRINT_ERROR( msgBuf, myThid )
              STOP 'ABNORMAL END: S/R FLT_EXCHG'
           ENDIF

           DO ip=1,max_npart_exch

            ic=(ip-1)*imax
            IF ( fltbuf_recvW(ic+1,bi,bj).NE.0. ) THEN
             npart_tile(bi,bj) = npart_tile(bi,bj) + 1
             IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
               jp = npart_tile(bi,bj)
               npart( jp,bi,bj) = fltbuf_recvW(ic+1,bi,bj)
               tstart(jp,bi,bj) = fltbuf_recvW(ic+2,bi,bj)
               ipart( jp,bi,bj) = fltbuf_recvW(ic+3,bi,bj)
               jpart( jp,bi,bj) = fltbuf_recvW(ic+4,bi,bj)
               kpart( jp,bi,bj) = fltbuf_recvW(ic+5,bi,bj)
               kfloat(jp,bi,bj) = fltbuf_recvW(ic+6,bi,bj)
               iup(   jp,bi,bj) = fltbuf_recvW(ic+7,bi,bj)
               itop(  jp,bi,bj) = fltbuf_recvW(ic+8,bi,bj)
               tend(  jp,bi,bj) = fltbuf_recvW(ic+9,bi,bj)
             ENDIF
            ENDIF

           ENDDO
           IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
             WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCHG:+W',
     &         ' bi,bj=', bi, bj,
     &         ' npart_tile=', npart_tile(bi,bj),
     &         ' > max_npart_tile=', max_npart_tile
              CALL PRINT_ERROR( msgBuf, myThid )
              STOP 'ABNORMAL END: S/R FLT_EXCHG'
           ENDIF

         ENDDO
        ENDDO

Caw end tile check
      ENDIF

C--   Choose floats that have to exchanged with northern and southern tiles
C     and pack to arrays

Caw Check if there are northern/southern tiles
c     IF ( Ny.NE.sNy ) THEN
C--   for periodic domain, condition above is wrong ; needs a better test
      IF ( .TRUE. ) THEN

        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)

C initialize buffers

           DO m=1,imax2
             fltbuf_sendE(m,bi,bj) = 0.
             fltbuf_sendW(m,bi,bj) = 0.
             fltbuf_recvE(m,bi,bj) = 0.
             fltbuf_recvW(m,bi,bj) = 0.
           ENDDO

           icountN=0
           icountS=0
           jl = 0

           jlo = 0.5 _d 0
           jhi = 0.5 _d 0 + DFLOAT(sNy)
#ifdef FLT_WITHOUT_Y_PERIODICITY
           sSide = myYGlobalLo+bj .LE.2
           nSide = myYGlobalLo+bj*sNy.GT.Ny
#endif /* FLT_WITHOUT_Y_PERIODICITY */

           DO ip=1,npart_tile(bi,bj)

#ifdef FLT_WITHOUT_Y_PERIODICITY
             IF ( nSide .AND.
     &           (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
     &           .AND. jpart(ip,bi,bj).GE.jhi ) THEN
C          stop the float:
              tend(ip,bi,bj) = flt_stopped
             ELSEIF ( jpart(ip,bi,bj).GE.jhi ) THEN
#else /* FLT_WITHOUT_Y_PERIODICITY */
             IF ( jpart(ip,bi,bj).GE.jhi ) THEN
#endif /* FLT_WITHOUT_Y_PERIODICITY */
              icountN=icountN+1
              IF ( icountN.LE.max_npart_exch ) THEN

               ic = (icountN-1)*imax
               jNew = jpart(ip,bi,bj) - DFLOAT(sNy)
               fltbuf_sendE(ic+1,bi,bj) =   npart(ip,bi,bj)
               fltbuf_sendE(ic+2,bi,bj) =  tstart(ip,bi,bj)
               fltbuf_sendE(ic+3,bi,bj) =   ipart(ip,bi,bj)
               fltbuf_sendE(ic+4,bi,bj) =   jNew
               fltbuf_sendE(ic+5,bi,bj) =   kpart(ip,bi,bj)
               fltbuf_sendE(ic+6,bi,bj) =  kfloat(ip,bi,bj)
               fltbuf_sendE(ic+7,bi,bj) =     iup(ip,bi,bj)
               fltbuf_sendE(ic+8,bi,bj) =    itop(ip,bi,bj)
               fltbuf_sendE(ic+9,bi,bj) =    tend(ip,bi,bj)

C tag this float to be removed:
               jl = jl + 1
               deleteList(jl) = ip
               npart(ip,bi,bj) = 0.

c             ELSE
c              WRITE(msgBuf,'(2A,2I4,I6,A,2F17.6))') ' FLT_EXCHG,N:',
c    &         ' bi,bj,ip=', bi, bj, ip,
c    &         ' yp,yHi=', jpart(ip,bi,bj), jhi
c              CALL PRINT_ERROR( msgBuf, myThid )
              ENDIF
             ENDIF

#ifdef FLT_WITHOUT_Y_PERIODICITY
             IF ( sSide .AND.
     &           (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
     &           .AND. jpart(ip,bi,bj).LT.jlo ) THEN
C          stop the float:
              tend(ip,bi,bj) = flt_stopped
             ELSEIF ( jpart(ip,bi,bj).LT.jlo ) THEN
#else /* FLT_WITHOUT_Y_PERIODICITY */
             IF ( jpart(ip,bi,bj).LT.jlo ) THEN
#endif /* FLT_WITHOUT_Y_PERIODICITY */
              icountS=icountS+1
              IF ( icountS.LE.max_npart_exch ) THEN

               ic = (icountS-1)*imax
               jNew = jpart(ip,bi,bj) + DFLOAT(sNy)
               fltbuf_sendW(ic+1,bi,bj) =   npart(ip,bi,bj)
               fltbuf_sendW(ic+2,bi,bj) =  tstart(ip,bi,bj)
               fltbuf_sendW(ic+3,bi,bj) =   ipart(ip,bi,bj)
               fltbuf_sendW(ic+4,bi,bj) =   jNew
               fltbuf_sendW(ic+5,bi,bj) =   kpart(ip,bi,bj)
               fltbuf_sendW(ic+6,bi,bj) =  kfloat(ip,bi,bj)
               fltbuf_sendW(ic+7,bi,bj) =     iup(ip,bi,bj)
               fltbuf_sendW(ic+8,bi,bj) =    itop(ip,bi,bj)
               fltbuf_sendW(ic+9,bi,bj) =    tend(ip,bi,bj)

C tag this float to be removed:
               jl = jl + 1
               deleteList(jl) = ip
               npart(ip,bi,bj) = 0.

c             ELSE
c              WRITE(msgBuf,'(2A,2I4,I6,A,2F17.6))') ' FLT_EXCHG,S:',
c    &         ' bi,bj,ip=', bi, bj, ip,
c    &         ' yp,yLo=', jpart(ip,bi,bj), jlo
c              CALL PRINT_ERROR( msgBuf, myThid )
              ENDIF
             ENDIF

           ENDDO
           IF ( icountN.GT.max_npart_exch ) THEN
             WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCHG:',
     &         ' bi,bj=', bi, bj,
     &         ' icountN=', icountN,
     &         ' > max_npart_exch=', max_npart_exch
             CALL PRINT_ERROR( msgBuf, myThid )
           ENDIF
           IF ( icountS.GT.max_npart_exch ) THEN
             WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCHG:',
     &         ' bi,bj=', bi, bj,
     &         ' icountS=', icountS,
     &         ' > max_npart_exch=', max_npart_exch
             CALL PRINT_ERROR( msgBuf, myThid )
           ENDIF
           IF ( icountN.GT.max_npart_exch
     &     .OR. icountS.GT.max_npart_exch ) THEN
             STOP 'ABNORMAL END: S/R FLT_EXCHG'
           ENDIF
           IF ( (icountN+icountS).GT.0 ) THEN
C Remove from this tile-list, floats which have been sent to an other tile
             npNew = npart_tile(bi,bj) - (icountN+icountS)
             jl = 0
             DO jp = npNew+1,npart_tile(bi,bj)
              IF ( npart(jp,bi,bj).NE.0. _d 0 ) THEN
                jl = jl + 1
                ip = deleteList(jl)
C        copy: ip <-- jp
                npart (ip,bi,bj) =  npart (jp,bi,bj)
                tstart(ip,bi,bj) =  tstart(jp,bi,bj)
                ipart (ip,bi,bj) =  ipart (jp,bi,bj)
                jpart (ip,bi,bj) =  jpart (jp,bi,bj)
                kpart (ip,bi,bj) =  kpart (jp,bi,bj)
                kfloat(ip,bi,bj) =  kfloat(jp,bi,bj)
                iup   (ip,bi,bj) =  iup   (jp,bi,bj)
                itop  (ip,bi,bj) =  itop  (jp,bi,bj)
                tend  (ip,bi,bj) =  tend  (jp,bi,bj)
              ENDIF
             ENDDO
             npart_tile(bi,bj) = npNew
           ENDIF

         ENDDO
        ENDDO

C     Send or Put north and south arrays.
#ifdef DBUG_EXCH_VEC
        WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 0y', myIter
#endif
        CALL EXCH_SEND_PUT_VEC_Y_RL(
     I                               fltbuf_sendE, fltbuf_sendW,
     O                               fltbuf_recvE, fltbuf_recvW,
     I                               imax2, myThid )
#ifdef DBUG_EXCH_VEC
        WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 1y', myIter
#endif
C     Receive north and south arrays
        CALL EXCH_RECV_GET_VEC_Y_RL(
     U                               fltbuf_recvE, fltbuf_recvW,
     I                               imax2, myThid )
#ifdef DBUG_EXCH_VEC
        WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 2y', myIter
c       STOP 'FLT_EXCHG: Normal End'
#endif

C--   Unpack arrays on new tiles

        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)

           DO ip=1,max_npart_exch

            ic=(ip-1)*imax
            IF ( fltbuf_recvE(ic+1,bi,bj).NE.0. ) THEN
             npart_tile(bi,bj) = npart_tile(bi,bj) + 1
             IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
               jp = npart_tile(bi,bj)
               npart( jp,bi,bj) = fltbuf_recvE(ic+1,bi,bj)
               tstart(jp,bi,bj) = fltbuf_recvE(ic+2,bi,bj)
               ipart( jp,bi,bj) = fltbuf_recvE(ic+3,bi,bj)
               jpart( jp,bi,bj) = fltbuf_recvE(ic+4,bi,bj)
               kpart( jp,bi,bj) = fltbuf_recvE(ic+5,bi,bj)
               kfloat(jp,bi,bj) = fltbuf_recvE(ic+6,bi,bj)
               iup(   jp,bi,bj) = fltbuf_recvE(ic+7,bi,bj)
               itop(  jp,bi,bj) = fltbuf_recvE(ic+8,bi,bj)
               tend(  jp,bi,bj) = fltbuf_recvE(ic+9,bi,bj)
             ENDIF
            ENDIF

           ENDDO
           IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
             WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCHG:+N',
     &         ' bi,bj=', bi, bj,
     &         ' npart_tile=', npart_tile(bi,bj),
     &         ' > max_npart_tile=', max_npart_tile
              CALL PRINT_ERROR( msgBuf, myThid )
              STOP 'ABNORMAL END: S/R FLT_EXCHG'
           ENDIF

           DO ip=1,max_npart_exch

            ic=(ip-1)*imax
            IF ( fltbuf_recvW(ic+1,bi,bj).NE.0. ) THEN
             npart_tile(bi,bj) = npart_tile(bi,bj) + 1
             IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
               jp = npart_tile(bi,bj)
               npart( jp,bi,bj) = fltbuf_recvW(ic+1,bi,bj)
               tstart(jp,bi,bj) = fltbuf_recvW(ic+2,bi,bj)
               ipart( jp,bi,bj) = fltbuf_recvW(ic+3,bi,bj)
               jpart( jp,bi,bj) = fltbuf_recvW(ic+4,bi,bj)
               kpart( jp,bi,bj) = fltbuf_recvW(ic+5,bi,bj)
               kfloat(jp,bi,bj) = fltbuf_recvW(ic+6,bi,bj)
               iup(   jp,bi,bj) = fltbuf_recvW(ic+7,bi,bj)
               itop(  jp,bi,bj) = fltbuf_recvW(ic+8,bi,bj)
               tend(  jp,bi,bj) = fltbuf_recvW(ic+9,bi,bj)
             ENDIF
            ENDIF

           ENDDO
           IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
             WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCHG:+S',
     &         ' bi,bj=', bi, bj,
     &         ' npart_tile=', npart_tile(bi,bj),
     &         ' > max_npart_tile=', max_npart_tile
              CALL PRINT_ERROR( msgBuf, myThid )
              STOP 'ABNORMAL END: S/R FLT_EXCHG'
           ENDIF

         ENDDO
        ENDDO

Caw end tile check
      ENDIF

      RETURN
      END
