File indexing completed on 2018-03-02 18:40:48 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
0a3ae49bfc Jean*0001 #include "FLT_OPTIONS.h"
e09457787a Jean*0002 #undef DBUG_EXCH_VEC
c806179eb4 Alis*0003
eacecc7041 Jean*0004 SUBROUTINE FLT_EXCHG (
0005 I myTime, myIter, myThid )
0006
0007
a11169c200 Jean*0008
eacecc7041 Jean*0009
0010
0011
0012
0013
0014
a11169c200 Jean*0015
0016 IMPLICIT NONE
c806179eb4 Alis*0017
a11169c200 Jean*0018
c806179eb4 Alis*0019 #include "SIZE.h"
0020 #include "EEPARAMS.h"
0021 #include "PARAMS.h"
730d8469b1 Oliv*0022 #include "FLT_SIZE.h"
521db80798 Jean*0023 #include "FLT.h"
c806179eb4 Alis*0024
eacecc7041 Jean*0025
0026 _RL myTime
0027 INTEGER myIter, myThid
c806179eb4 Alis*0028
bd12238ff3 Jean*0029
0030
0031
0032 INTEGER imax, imax2
eacecc7041 Jean*0033 PARAMETER(imax=9)
0034 PARAMETER(imax2=imax*max_npart_exch)
c806179eb4 Alis*0035 _RL fltbuf_sendE(imax2,nSx,nSy)
0036 _RL fltbuf_sendW(imax2,nSx,nSy)
0037 _RL fltbuf_recvE(imax2,nSx,nSy)
0038 _RL fltbuf_recvW(imax2,nSx,nSy)
bd12238ff3 Jean*0039 COMMON / FLT_EXCHG_BUFF /
0040 & fltbuf_sendE, fltbuf_sendW, fltbuf_recvE, fltbuf_recvW
0041
0042
0043 INTEGER bi, bj, ic
0044 INTEGER ip, jp, jl, m, npNew
0045 INTEGER icountE, icountW, icountN, icountS
0046 INTEGER deleteList(max_npart_exch*2)
0047 _RL ilo, ihi, jlo, jhi, iNew, jNew
0048 CHARACTER*(MAX_LEN_MBUF) msgBuf
7c4c60e70f Jean*0049 #ifdef FLT_WITHOUT_X_PERIODICITY
0050 LOGICAL wSide, eSide
0051 #endif /* FLT_WITHOUT_X_PERIODICITY */
0052 #ifdef FLT_WITHOUT_Y_PERIODICITY
0053 LOGICAL sSide, nSide
0054 #endif /* FLT_WITHOUT_Y_PERIODICITY */
0055 _RL flt_stopped
c806179eb4 Alis*0056
eacecc7041 Jean*0057
c806179eb4 Alis*0058
7c4c60e70f Jean*0059
0060 flt_stopped = -2.
0061 flt_stopped = MIN( baseTime, flt_stopped )
0062
eacecc7041 Jean*0063
121ecfb57a Jean*0064
0065
0066 IF ( .TRUE. ) THEN
e47631944b Ed H*0067
c806179eb4 Alis*0068
0069
0070
eacecc7041 Jean*0071 DO bj=myByLo(myThid),myByHi(myThid)
0072 DO bi=myBxLo(myThid),myBxHi(myThid)
0073
0074
0075 DO m=1,imax2
0076 fltbuf_sendE(m,bi,bj) = 0.
0077 fltbuf_sendW(m,bi,bj) = 0.
0078 fltbuf_recvE(m,bi,bj) = 0.
0079 fltbuf_recvW(m,bi,bj) = 0.
0080 ENDDO
0081
0082 icountE=0
0083 icountW=0
382c316761 Jean*0084 jl = 0
eacecc7041 Jean*0085
d5477ff298 Jean*0086 ilo = 0.5 _d 0
0087 ihi = 0.5 _d 0 + DFLOAT(sNx)
7c4c60e70f Jean*0088 #ifdef FLT_WITHOUT_X_PERIODICITY
0089 wSide = myXGlobalLo+bi .LE.2
0090 eSide = myXGlobalLo+bi*sNx.GT.Nx
0091 #endif /* FLT_WITHOUT_X_PERIODICITY */
eacecc7041 Jean*0092
0093 DO ip=1,npart_tile(bi,bj)
0094
7c4c60e70f Jean*0095 #ifdef FLT_WITHOUT_X_PERIODICITY
0096 IF ( eSide .AND.
0097 & (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
0098 & .AND. ipart(ip,bi,bj).GE.ihi ) THEN
0099
0100 tend(ip,bi,bj) = flt_stopped
0101 ELSEIF ( ipart(ip,bi,bj).GE.ihi ) THEN
0102 #else /* FLT_WITHOUT_X_PERIODICITY */
d5477ff298 Jean*0103 IF ( ipart(ip,bi,bj).GE.ihi ) THEN
7c4c60e70f Jean*0104 #endif /* FLT_WITHOUT_X_PERIODICITY */
eacecc7041 Jean*0105 icountE=icountE+1
0106 IF ( icountE.LE.max_npart_exch ) THEN
0107
d5477ff298 Jean*0108 ic = (icountE-1)*imax
0109 iNew = ipart(ip,bi,bj) - DFLOAT(sNx)
eacecc7041 Jean*0110 fltbuf_sendE(ic+1,bi,bj) = npart(ip,bi,bj)
0111 fltbuf_sendE(ic+2,bi,bj) = tstart(ip,bi,bj)
d5477ff298 Jean*0112 fltbuf_sendE(ic+3,bi,bj) = iNew
0113 fltbuf_sendE(ic+4,bi,bj) = jpart(ip,bi,bj)
eacecc7041 Jean*0114 fltbuf_sendE(ic+5,bi,bj) = kpart(ip,bi,bj)
0115 fltbuf_sendE(ic+6,bi,bj) = kfloat(ip,bi,bj)
0116 fltbuf_sendE(ic+7,bi,bj) = iup(ip,bi,bj)
0117 fltbuf_sendE(ic+8,bi,bj) = itop(ip,bi,bj)
0118 fltbuf_sendE(ic+9,bi,bj) = tend(ip,bi,bj)
0119
382c316761 Jean*0120
0121 jl = jl + 1
0122 deleteList(jl) = ip
0123 npart(ip,bi,bj) = 0.
eacecc7041 Jean*0124
0125 ENDIF
0126 ENDIF
0127
7c4c60e70f Jean*0128 #ifdef FLT_WITHOUT_X_PERIODICITY
0129 IF ( wSide .AND.
0130 & (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
0131 & .AND. ipart(ip,bi,bj).LT.ilo ) THEN
0132
0133 tend(ip,bi,bj) = flt_stopped
0134 ELSEIF ( ipart(ip,bi,bj).LT.ilo ) THEN
0135 #else /* FLT_WITHOUT_X_PERIODICITY */
d5477ff298 Jean*0136 IF ( ipart(ip,bi,bj).LT.ilo ) THEN
7c4c60e70f Jean*0137 #endif /* FLT_WITHOUT_X_PERIODICITY */
eacecc7041 Jean*0138 icountW=icountW+1
0139 IF ( icountW.LE.max_npart_exch ) THEN
0140
d5477ff298 Jean*0141 ic = (icountW-1)*imax
0142 iNew = ipart(ip,bi,bj) + DFLOAT(sNx)
eacecc7041 Jean*0143 fltbuf_sendW(ic+1,bi,bj) = npart(ip,bi,bj)
0144 fltbuf_sendW(ic+2,bi,bj) = tstart(ip,bi,bj)
d5477ff298 Jean*0145 fltbuf_sendW(ic+3,bi,bj) = iNew
0146 fltbuf_sendW(ic+4,bi,bj) = jpart(ip,bi,bj)
eacecc7041 Jean*0147 fltbuf_sendW(ic+5,bi,bj) = kpart(ip,bi,bj)
0148 fltbuf_sendW(ic+6,bi,bj) = kfloat(ip,bi,bj)
0149 fltbuf_sendW(ic+7,bi,bj) = iup(ip,bi,bj)
0150 fltbuf_sendW(ic+8,bi,bj) = itop(ip,bi,bj)
0151 fltbuf_sendW(ic+9,bi,bj) = tend(ip,bi,bj)
0152
382c316761 Jean*0153
0154 jl = jl + 1
0155 deleteList(jl) = ip
0156 npart(ip,bi,bj) = 0.
eacecc7041 Jean*0157
0158 ENDIF
0159 ENDIF
0160
0161 ENDDO
0162 IF ( icountE.GT.max_npart_exch ) THEN
0163 WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCHG:',
0164 & ' bi,bj=', bi, bj,
0165 & ' icountE=', icountE,
0166 & ' > max_npart_exch=', max_npart_exch
0167 CALL PRINT_ERROR( msgBuf, myThid )
0168 ENDIF
0169 IF ( icountW.GT.max_npart_exch ) THEN
0170 WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCHG:',
0171 & ' bi,bj=', bi, bj,
0172 & ' icountW=', icountW,
0173 & ' > max_npart_exch=', max_npart_exch
0174 CALL PRINT_ERROR( msgBuf, myThid )
0175 ENDIF
0176 IF ( icountE.GT.max_npart_exch
0177 & .OR. icountW.GT.max_npart_exch ) THEN
0178 STOP 'ABNORMAL END: S/R FLT_EXCHG'
0179 ENDIF
382c316761 Jean*0180 IF ( (icountE+icountW).GT.0 ) THEN
0181
0182 npNew = npart_tile(bi,bj) - (icountE+icountW)
0183 jl = 0
0184 DO jp = npNew+1,npart_tile(bi,bj)
0185 IF ( npart(jp,bi,bj).NE.0. _d 0 ) THEN
0186 jl = jl + 1
0187 ip = deleteList(jl)
0188
0189 npart (ip,bi,bj) = npart (jp,bi,bj)
0190 tstart(ip,bi,bj) = tstart(jp,bi,bj)
d5477ff298 Jean*0191 ipart (ip,bi,bj) = ipart (jp,bi,bj)
0192 jpart (ip,bi,bj) = jpart (jp,bi,bj)
382c316761 Jean*0193 kpart (ip,bi,bj) = kpart (jp,bi,bj)
0194 kfloat(ip,bi,bj) = kfloat(jp,bi,bj)
0195 iup (ip,bi,bj) = iup (jp,bi,bj)
0196 itop (ip,bi,bj) = itop (jp,bi,bj)
0197 tend (ip,bi,bj) = tend (jp,bi,bj)
0198 ENDIF
0199 ENDDO
0200 npart_tile(bi,bj) = npNew
0201 ENDIF
c806179eb4 Alis*0202
e47631944b Ed H*0203 ENDDO
eacecc7041 Jean*0204 ENDDO
c806179eb4 Alis*0205
121ecfb57a Jean*0206
e09457787a Jean*0207
0208 #ifdef DBUG_EXCH_VEC
0209 WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 0x', myIter
0210 #endif
48e4fc2750 Jean*0211 CALL EXCH_SEND_PUT_VEC_X_RL(
121ecfb57a Jean*0212 I fltbuf_sendE, fltbuf_sendW,
0213 O fltbuf_recvE, fltbuf_recvW,
eacecc7041 Jean*0214 I imax2, myThid )
e09457787a Jean*0215 #ifdef DBUG_EXCH_VEC
0216 WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 1x', myIter
0217 #endif
ef53b829d7 Jean*0218
48e4fc2750 Jean*0219 CALL EXCH_RECV_GET_VEC_X_RL(
121ecfb57a Jean*0220 U fltbuf_recvE, fltbuf_recvW,
eacecc7041 Jean*0221 I imax2, myThid )
e09457787a Jean*0222 #ifdef DBUG_EXCH_VEC
0223 WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 2x', myIter
0224 #endif
c806179eb4 Alis*0225
0226
0227
eacecc7041 Jean*0228 DO bj=myByLo(myThid),myByHi(myThid)
0229 DO bi=myBxLo(myThid),myBxHi(myThid)
0230
0231 DO ip=1,max_npart_exch
0232
0233 ic=(ip-1)*imax
0234 IF ( fltbuf_recvE(ic+1,bi,bj).NE.0. ) THEN
0235 npart_tile(bi,bj) = npart_tile(bi,bj) + 1
0236 IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
0237 jp = npart_tile(bi,bj)
0238 npart( jp,bi,bj) = fltbuf_recvE(ic+1,bi,bj)
0239 tstart(jp,bi,bj) = fltbuf_recvE(ic+2,bi,bj)
d5477ff298 Jean*0240 ipart( jp,bi,bj) = fltbuf_recvE(ic+3,bi,bj)
0241 jpart( jp,bi,bj) = fltbuf_recvE(ic+4,bi,bj)
eacecc7041 Jean*0242 kpart( jp,bi,bj) = fltbuf_recvE(ic+5,bi,bj)
0243 kfloat(jp,bi,bj) = fltbuf_recvE(ic+6,bi,bj)
0244 iup( jp,bi,bj) = fltbuf_recvE(ic+7,bi,bj)
0245 itop( jp,bi,bj) = fltbuf_recvE(ic+8,bi,bj)
0246 tend( jp,bi,bj) = fltbuf_recvE(ic+9,bi,bj)
0247 ENDIF
0248 ENDIF
0249
0250 ENDDO
0251 IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
0252 WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCHG:+E',
0253 & ' bi,bj=', bi, bj,
0254 & ' npart_tile=', npart_tile(bi,bj),
0255 & ' > max_npart_tile=', max_npart_tile
0256 CALL PRINT_ERROR( msgBuf, myThid )
0257 STOP 'ABNORMAL END: S/R FLT_EXCHG'
0258 ENDIF
0259
0260 DO ip=1,max_npart_exch
0261
0262 ic=(ip-1)*imax
0263 IF ( fltbuf_recvW(ic+1,bi,bj).NE.0. ) THEN
0264 npart_tile(bi,bj) = npart_tile(bi,bj) + 1
0265 IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
0266 jp = npart_tile(bi,bj)
0267 npart( jp,bi,bj) = fltbuf_recvW(ic+1,bi,bj)
0268 tstart(jp,bi,bj) = fltbuf_recvW(ic+2,bi,bj)
d5477ff298 Jean*0269 ipart( jp,bi,bj) = fltbuf_recvW(ic+3,bi,bj)
0270 jpart( jp,bi,bj) = fltbuf_recvW(ic+4,bi,bj)
eacecc7041 Jean*0271 kpart( jp,bi,bj) = fltbuf_recvW(ic+5,bi,bj)
0272 kfloat(jp,bi,bj) = fltbuf_recvW(ic+6,bi,bj)
0273 iup( jp,bi,bj) = fltbuf_recvW(ic+7,bi,bj)
0274 itop( jp,bi,bj) = fltbuf_recvW(ic+8,bi,bj)
0275 tend( jp,bi,bj) = fltbuf_recvW(ic+9,bi,bj)
0276 ENDIF
0277 ENDIF
0278
0279 ENDDO
0280 IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
0281 WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCHG:+W',
0282 & ' bi,bj=', bi, bj,
0283 & ' npart_tile=', npart_tile(bi,bj),
0284 & ' > max_npart_tile=', max_npart_tile
0285 CALL PRINT_ERROR( msgBuf, myThid )
0286 STOP 'ABNORMAL END: S/R FLT_EXCHG'
0287 ENDIF
0288
e47631944b Ed H*0289 ENDDO
eacecc7041 Jean*0290 ENDDO
e47631944b Ed H*0291
eacecc7041 Jean*0292
0293 ENDIF
e47631944b Ed H*0294
0295
c806179eb4 Alis*0296
0297
eacecc7041 Jean*0298
121ecfb57a Jean*0299
0300
0301 IF ( .TRUE. ) THEN
eacecc7041 Jean*0302
0303 DO bj=myByLo(myThid),myByHi(myThid)
0304 DO bi=myBxLo(myThid),myBxHi(myThid)
0305
0306
0307
0308 DO m=1,imax2
0309 fltbuf_sendE(m,bi,bj) = 0.
0310 fltbuf_sendW(m,bi,bj) = 0.
0311 fltbuf_recvE(m,bi,bj) = 0.
0312 fltbuf_recvW(m,bi,bj) = 0.
0313 ENDDO
0314
0315 icountN=0
0316 icountS=0
382c316761 Jean*0317 jl = 0
eacecc7041 Jean*0318
d5477ff298 Jean*0319 jlo = 0.5 _d 0
0320 jhi = 0.5 _d 0 + DFLOAT(sNy)
7c4c60e70f Jean*0321 #ifdef FLT_WITHOUT_Y_PERIODICITY
0322 sSide = myYGlobalLo+bj .LE.2
0323 nSide = myYGlobalLo+bj*sNy.GT.Ny
0324 #endif /* FLT_WITHOUT_Y_PERIODICITY */
eacecc7041 Jean*0325
0326 DO ip=1,npart_tile(bi,bj)
0327
7c4c60e70f Jean*0328 #ifdef FLT_WITHOUT_Y_PERIODICITY
0329 IF ( nSide .AND.
0330 & (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
0331 & .AND. jpart(ip,bi,bj).GE.jhi ) THEN
0332
0333 tend(ip,bi,bj) = flt_stopped
0334 ELSEIF ( jpart(ip,bi,bj).GE.jhi ) THEN
0335 #else /* FLT_WITHOUT_Y_PERIODICITY */
d5477ff298 Jean*0336 IF ( jpart(ip,bi,bj).GE.jhi ) THEN
7c4c60e70f Jean*0337 #endif /* FLT_WITHOUT_Y_PERIODICITY */
eacecc7041 Jean*0338 icountN=icountN+1
0339 IF ( icountN.LE.max_npart_exch ) THEN
0340
d5477ff298 Jean*0341 ic = (icountN-1)*imax
0342 jNew = jpart(ip,bi,bj) - DFLOAT(sNy)
eacecc7041 Jean*0343 fltbuf_sendE(ic+1,bi,bj) = npart(ip,bi,bj)
0344 fltbuf_sendE(ic+2,bi,bj) = tstart(ip,bi,bj)
d5477ff298 Jean*0345 fltbuf_sendE(ic+3,bi,bj) = ipart(ip,bi,bj)
0346 fltbuf_sendE(ic+4,bi,bj) = jNew
eacecc7041 Jean*0347 fltbuf_sendE(ic+5,bi,bj) = kpart(ip,bi,bj)
0348 fltbuf_sendE(ic+6,bi,bj) = kfloat(ip,bi,bj)
0349 fltbuf_sendE(ic+7,bi,bj) = iup(ip,bi,bj)
0350 fltbuf_sendE(ic+8,bi,bj) = itop(ip,bi,bj)
0351 fltbuf_sendE(ic+9,bi,bj) = tend(ip,bi,bj)
0352
382c316761 Jean*0353
0354 jl = jl + 1
0355 deleteList(jl) = ip
0356 npart(ip,bi,bj) = 0.
eacecc7041 Jean*0357
0358
0359
0360
d5477ff298 Jean*0361
eacecc7041 Jean*0362
0363 ENDIF
0364 ENDIF
0365
1a3e6b35f2 Jean*0366 #ifdef FLT_WITHOUT_Y_PERIODICITY
7c4c60e70f Jean*0367 IF ( sSide .AND.
0368 & (myTime.LE.tend(ip,bi,bj) .OR. tend(ip,bi,bj).EQ.-1.)
0369 & .AND. jpart(ip,bi,bj).LT.jlo ) THEN
0370
0371 tend(ip,bi,bj) = flt_stopped
0372 ELSEIF ( jpart(ip,bi,bj).LT.jlo ) THEN
1a3e6b35f2 Jean*0373 #else /* FLT_WITHOUT_Y_PERIODICITY */
d5477ff298 Jean*0374 IF ( jpart(ip,bi,bj).LT.jlo ) THEN
1a3e6b35f2 Jean*0375 #endif /* FLT_WITHOUT_Y_PERIODICITY */
eacecc7041 Jean*0376 icountS=icountS+1
0377 IF ( icountS.LE.max_npart_exch ) THEN
0378
d5477ff298 Jean*0379 ic = (icountS-1)*imax
0380 jNew = jpart(ip,bi,bj) + DFLOAT(sNy)
eacecc7041 Jean*0381 fltbuf_sendW(ic+1,bi,bj) = npart(ip,bi,bj)
0382 fltbuf_sendW(ic+2,bi,bj) = tstart(ip,bi,bj)
d5477ff298 Jean*0383 fltbuf_sendW(ic+3,bi,bj) = ipart(ip,bi,bj)
0384 fltbuf_sendW(ic+4,bi,bj) = jNew
eacecc7041 Jean*0385 fltbuf_sendW(ic+5,bi,bj) = kpart(ip,bi,bj)
0386 fltbuf_sendW(ic+6,bi,bj) = kfloat(ip,bi,bj)
0387 fltbuf_sendW(ic+7,bi,bj) = iup(ip,bi,bj)
0388 fltbuf_sendW(ic+8,bi,bj) = itop(ip,bi,bj)
0389 fltbuf_sendW(ic+9,bi,bj) = tend(ip,bi,bj)
0390
382c316761 Jean*0391
0392 jl = jl + 1
0393 deleteList(jl) = ip
0394 npart(ip,bi,bj) = 0.
eacecc7041 Jean*0395
0396
0397
0398
d5477ff298 Jean*0399
eacecc7041 Jean*0400
0401 ENDIF
0402 ENDIF
0403
0404 ENDDO
0405 IF ( icountN.GT.max_npart_exch ) THEN
0406 WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCHG:',
0407 & ' bi,bj=', bi, bj,
0408 & ' icountN=', icountN,
0409 & ' > max_npart_exch=', max_npart_exch
0410 CALL PRINT_ERROR( msgBuf, myThid )
0411 ENDIF
0412 IF ( icountS.GT.max_npart_exch ) THEN
0413 WRITE(msgBuf,'(2A,2I4,2(A,I8))') ' FLT_EXCHG:',
0414 & ' bi,bj=', bi, bj,
0415 & ' icountS=', icountS,
0416 & ' > max_npart_exch=', max_npart_exch
0417 CALL PRINT_ERROR( msgBuf, myThid )
0418 ENDIF
0419 IF ( icountN.GT.max_npart_exch
0420 & .OR. icountS.GT.max_npart_exch ) THEN
0421 STOP 'ABNORMAL END: S/R FLT_EXCHG'
0422 ENDIF
382c316761 Jean*0423 IF ( (icountN+icountS).GT.0 ) THEN
0424
0425 npNew = npart_tile(bi,bj) - (icountN+icountS)
0426 jl = 0
0427 DO jp = npNew+1,npart_tile(bi,bj)
0428 IF ( npart(jp,bi,bj).NE.0. _d 0 ) THEN
0429 jl = jl + 1
0430 ip = deleteList(jl)
0431
0432 npart (ip,bi,bj) = npart (jp,bi,bj)
0433 tstart(ip,bi,bj) = tstart(jp,bi,bj)
d5477ff298 Jean*0434 ipart (ip,bi,bj) = ipart (jp,bi,bj)
0435 jpart (ip,bi,bj) = jpart (jp,bi,bj)
382c316761 Jean*0436 kpart (ip,bi,bj) = kpart (jp,bi,bj)
0437 kfloat(ip,bi,bj) = kfloat(jp,bi,bj)
0438 iup (ip,bi,bj) = iup (jp,bi,bj)
0439 itop (ip,bi,bj) = itop (jp,bi,bj)
0440 tend (ip,bi,bj) = tend (jp,bi,bj)
0441 ENDIF
0442 ENDDO
0443 npart_tile(bi,bj) = npNew
0444 ENDIF
eacecc7041 Jean*0445
e47631944b Ed H*0446 ENDDO
eacecc7041 Jean*0447 ENDDO
c806179eb4 Alis*0448
121ecfb57a Jean*0449
e09457787a Jean*0450 #ifdef DBUG_EXCH_VEC
0451 WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 0y', myIter
0452 #endif
48e4fc2750 Jean*0453 CALL EXCH_SEND_PUT_VEC_Y_RL(
121ecfb57a Jean*0454 I fltbuf_sendE, fltbuf_sendW,
0455 O fltbuf_recvE, fltbuf_recvW,
eacecc7041 Jean*0456 I imax2, myThid )
e09457787a Jean*0457 #ifdef DBUG_EXCH_VEC
0458 WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 1y', myIter
0459 #endif
c806179eb4 Alis*0460
48e4fc2750 Jean*0461 CALL EXCH_RECV_GET_VEC_Y_RL(
121ecfb57a Jean*0462 U fltbuf_recvE, fltbuf_recvW,
eacecc7041 Jean*0463 I imax2, myThid )
e09457787a Jean*0464 #ifdef DBUG_EXCH_VEC
0465 WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 2y', myIter
0466
0467 #endif
c806179eb4 Alis*0468
0469
0470
eacecc7041 Jean*0471 DO bj=myByLo(myThid),myByHi(myThid)
0472 DO bi=myBxLo(myThid),myBxHi(myThid)
0473
0474 DO ip=1,max_npart_exch
0475
0476 ic=(ip-1)*imax
0477 IF ( fltbuf_recvE(ic+1,bi,bj).NE.0. ) THEN
0478 npart_tile(bi,bj) = npart_tile(bi,bj) + 1
0479 IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
0480 jp = npart_tile(bi,bj)
0481 npart( jp,bi,bj) = fltbuf_recvE(ic+1,bi,bj)
0482 tstart(jp,bi,bj) = fltbuf_recvE(ic+2,bi,bj)
d5477ff298 Jean*0483 ipart( jp,bi,bj) = fltbuf_recvE(ic+3,bi,bj)
0484 jpart( jp,bi,bj) = fltbuf_recvE(ic+4,bi,bj)
eacecc7041 Jean*0485 kpart( jp,bi,bj) = fltbuf_recvE(ic+5,bi,bj)
0486 kfloat(jp,bi,bj) = fltbuf_recvE(ic+6,bi,bj)
0487 iup( jp,bi,bj) = fltbuf_recvE(ic+7,bi,bj)
0488 itop( jp,bi,bj) = fltbuf_recvE(ic+8,bi,bj)
0489 tend( jp,bi,bj) = fltbuf_recvE(ic+9,bi,bj)
0490 ENDIF
0491 ENDIF
0492
0493 ENDDO
0494 IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
0495 WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCHG:+N',
0496 & ' bi,bj=', bi, bj,
0497 & ' npart_tile=', npart_tile(bi,bj),
0498 & ' > max_npart_tile=', max_npart_tile
0499 CALL PRINT_ERROR( msgBuf, myThid )
0500 STOP 'ABNORMAL END: S/R FLT_EXCHG'
0501 ENDIF
0502
0503 DO ip=1,max_npart_exch
0504
0505 ic=(ip-1)*imax
0506 IF ( fltbuf_recvW(ic+1,bi,bj).NE.0. ) THEN
0507 npart_tile(bi,bj) = npart_tile(bi,bj) + 1
0508 IF ( npart_tile(bi,bj).LE.max_npart_tile ) THEN
0509 jp = npart_tile(bi,bj)
0510 npart( jp,bi,bj) = fltbuf_recvW(ic+1,bi,bj)
0511 tstart(jp,bi,bj) = fltbuf_recvW(ic+2,bi,bj)
d5477ff298 Jean*0512 ipart( jp,bi,bj) = fltbuf_recvW(ic+3,bi,bj)
0513 jpart( jp,bi,bj) = fltbuf_recvW(ic+4,bi,bj)
eacecc7041 Jean*0514 kpart( jp,bi,bj) = fltbuf_recvW(ic+5,bi,bj)
0515 kfloat(jp,bi,bj) = fltbuf_recvW(ic+6,bi,bj)
0516 iup( jp,bi,bj) = fltbuf_recvW(ic+7,bi,bj)
0517 itop( jp,bi,bj) = fltbuf_recvW(ic+8,bi,bj)
0518 tend( jp,bi,bj) = fltbuf_recvW(ic+9,bi,bj)
0519 ENDIF
0520 ENDIF
0521
0522 ENDDO
0523 IF ( npart_tile(bi,bj).GT.max_npart_tile ) THEN
0524 WRITE(msgBuf,'(2A,2I4,2(A,I8))') 'FLT_EXCHG:+S',
0525 & ' bi,bj=', bi, bj,
0526 & ' npart_tile=', npart_tile(bi,bj),
0527 & ' > max_npart_tile=', max_npart_tile
0528 CALL PRINT_ERROR( msgBuf, myThid )
0529 STOP 'ABNORMAL END: S/R FLT_EXCHG'
0530 ENDIF
0531
e47631944b Ed H*0532 ENDDO
eacecc7041 Jean*0533 ENDDO
e47631944b Ed H*0534
eacecc7041 Jean*0535
0536 ENDIF
c806179eb4 Alis*0537
eacecc7041 Jean*0538 RETURN
0539 END