/[MITgcm]/MITgcm/pkg/flt/flt_exchg.F
ViewVC logotype

Diff of /MITgcm/pkg/flt/flt_exchg.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by adcroft, Thu Sep 13 17:43:55 2001 UTC revision 1.2 by edhill, Tue Sep 7 16:19:30 2004 UTC
# Line 1  Line 1 
1  C $Header$  C /u/gcmpack/MITgcm/pkg/flt/flt_exchg.F,v 1.1 2001/09/13 17:43:55 adcroft Exp
2  C $Name$  C checkpoint52h_pre
3    
4  #include "FLT_CPPOPTIONS.h"  #include "FLT_CPPOPTIONS.h"
5    
# Line 13  c     ================================== Line 13  c     ==================================
13  c     SUBROUTINE flt_exchg  c     SUBROUTINE flt_exchg
14  c     ==================================================================  c     ==================================================================
15  c  c
16  c     o  c     o Exchange particles between tiles.
17    c
18    c     started: Arne Biastoch
19    c
20    c     changed: Antti Westerlund antti.westerlund@helsinki.fi 2004.06.10
21  c  c
22  c     ==================================================================  c     ==================================================================
23  c     SUBROUTINE flt_exchg  c     SUBROUTINE flt_exchg
# Line 55  c     buffer for sending/receiving varia Line 59  c     buffer for sending/receiving varia
59        _RL npart_dist        _RL npart_dist
60  c     == end of interface ==  c     == end of interface ==
61    
62    caw Check if there are eastern/western tiles
63          if(Nx .ne. sNx) then
64    
65  C--   Choose floats that have to exchanged with eastern and western tiles  C--   Choose floats that have to exchanged with eastern and western tiles
66  C     and pack to arrays  C     and pack to arrays
67    
68    
69        DO bj=myByLo(myThid),myByHi(myThid)           DO bj=myByLo(myThid),myByHi(myThid)
70         DO bi=myBxLo(myThid),myBxHi(myThid)              DO bi=myBxLo(myThid),myBxHi(myThid)
71                
72  c initialize buffers  c initialize buffers
73    
74            do m=1,imax2                 do m=1,imax2
75               fltbuf_sendE(m,bi,bj) = 0.                    fltbuf_sendE(m,bi,bj) = 0.
76               fltbuf_sendW(m,bi,bj) = 0.                    fltbuf_sendW(m,bi,bj) = 0.
77               fltbuf_recvE(m,bi,bj) = 0.                    fltbuf_recvE(m,bi,bj) = 0.
78               fltbuf_recvW(m,bi,bj) = 0.                    fltbuf_recvW(m,bi,bj) = 0.
79            enddo                 enddo
80    
81            icountE=0                 icountE=0
82            icountW=0                 icountW=0
83    
84            iG = myXGlobalLo + (bi-1)*sNx                 iG = myXGlobalLo + (bi-1)*sNx
85            xlo = xc(1,  1,  bi,bj) - delX(iG)                 xlo = xc(1,  1,  bi,bj) - delX(iG)
86            xhi = xc(sNx,1,bi,bj)   + delX(iG+sNx-1)                 xhi = xc(sNx,1,bi,bj)   + delX(iG+sNx-1)
87  c  c
88            do ip=1,npart_tile(bi,bj)                 do ip=1,npart_tile(bi,bj)
89  c  c
90               if (xpart(ip,bi,bj) .ge. xhi) then                    if (xpart(ip,bi,bj) .ge. xhi) then
91                  icountE=icountE+1                       icountE=icountE+1
92                  if (icountE .gt. max_npart_exch)                       if (icountE .gt. max_npart_exch) stop
93       &          stop ' max_npart_exch too low. stop in flt_exchg'       &                    ' max_npart_exch too low. stop in flt_exchg'
94    
95                  ic=(icountE-1)*imax                       ic=(icountE-1)*imax
96                  fltbuf_sendE(ic+1,bi,bj) =   npart(ip,bi,bj)                       fltbuf_sendE(ic+1,bi,bj) =   npart(ip,bi,bj)
97                  fltbuf_sendE(ic+2,bi,bj) =  tstart(ip,bi,bj)                       fltbuf_sendE(ic+2,bi,bj) =  tstart(ip,bi,bj)
98                  fltbuf_sendE(ic+3,bi,bj) =   xpart(ip,bi,bj)                       fltbuf_sendE(ic+3,bi,bj) =   xpart(ip,bi,bj)
99                  fltbuf_sendE(ic+4,bi,bj) =   ypart(ip,bi,bj)                       fltbuf_sendE(ic+4,bi,bj) =   ypart(ip,bi,bj)
100                  fltbuf_sendE(ic+5,bi,bj) =   kpart(ip,bi,bj)                       fltbuf_sendE(ic+5,bi,bj) =   kpart(ip,bi,bj)
101                  fltbuf_sendE(ic+6,bi,bj) =  kfloat(ip,bi,bj)                       fltbuf_sendE(ic+6,bi,bj) =  kfloat(ip,bi,bj)
102                  fltbuf_sendE(ic+7,bi,bj) =     iup(ip,bi,bj)                       fltbuf_sendE(ic+7,bi,bj) =     iup(ip,bi,bj)
103                  fltbuf_sendE(ic+8,bi,bj) =    itop(ip,bi,bj)                       fltbuf_sendE(ic+8,bi,bj) =    itop(ip,bi,bj)
104                  fltbuf_sendE(ic+9,bi,bj) =    tend(ip,bi,bj)                       fltbuf_sendE(ic+9,bi,bj) =    tend(ip,bi,bj)
105                        
106                    npart(ip,bi,bj) =   npart(npart_tile(bi,bj),bi,bj)                       npart(ip,bi,bj) =   npart(npart_tile(bi,bj),bi,bj)
107                   tstart(ip,bi,bj) =  tstart(npart_tile(bi,bj),bi,bj)                       tstart(ip,bi,bj) =  tstart(npart_tile(bi,bj),bi,bj)
108                  xpart(ip,bi,bj)   =   xpart(npart_tile(bi,bj),bi,bj)                       xpart(ip,bi,bj)  =   xpart(npart_tile(bi,bj),bi,bj)
109                  ypart(ip,bi,bj)   =   ypart(npart_tile(bi,bj),bi,bj)                       ypart(ip,bi,bj)  =   ypart(npart_tile(bi,bj),bi,bj)
110                  kpart(ip,bi,bj)   =   kpart(npart_tile(bi,bj),bi,bj)                       kpart(ip,bi,bj)  =   kpart(npart_tile(bi,bj),bi,bj)
111                  kfloat(ip,bi,bj)  =  kfloat(npart_tile(bi,bj),bi,bj)                       kfloat(ip,bi,bj) =  kfloat(npart_tile(bi,bj),bi,bj)
112                  iup(ip,bi,bj)     =     iup(npart_tile(bi,bj),bi,bj)                       iup(ip,bi,bj)    =     iup(npart_tile(bi,bj),bi,bj)
113                  itop(ip,bi,bj)    =    itop(npart_tile(bi,bj),bi,bj)                       itop(ip,bi,bj)   =    itop(npart_tile(bi,bj),bi,bj)
114                  tend(ip,bi,bj)    =    tend(npart_tile(bi,bj),bi,bj)                       tend(ip,bi,bj)   =    tend(npart_tile(bi,bj),bi,bj)
115    
116                  npart_tile(bi,bj) = npart_tile(bi,bj) - 1                       npart_tile(bi,bj) = npart_tile(bi,bj) - 1
117    
118               endif                    endif
119    
120               if (xpart(ip,bi,bj) .le. xlo) then                    if (xpart(ip,bi,bj) .le. xlo) then
121                  icountW=icountW+1                       icountW=icountW+1
122                  if (icountW .gt. max_npart_exch)                       if (icountW .gt. max_npart_exch) stop
123       &          stop ' max_npart_exch too low. stop in flt_exchg'       &                    ' max_npart_exch too low. stop in flt_exchg'
124    
125                  ic=(icountW-1)*imax                       ic=(icountW-1)*imax
126                  fltbuf_sendW(ic+1,bi,bj) =   npart(ip,bi,bj)                       fltbuf_sendW(ic+1,bi,bj) =   npart(ip,bi,bj)
127                  fltbuf_sendW(ic+2,bi,bj) =  tstart(ip,bi,bj)                       fltbuf_sendW(ic+2,bi,bj) =  tstart(ip,bi,bj)
128                  fltbuf_sendW(ic+3,bi,bj) =   xpart(ip,bi,bj)                       fltbuf_sendW(ic+3,bi,bj) =   xpart(ip,bi,bj)
129                  fltbuf_sendW(ic+4,bi,bj) =   ypart(ip,bi,bj)                       fltbuf_sendW(ic+4,bi,bj) =   ypart(ip,bi,bj)
130                  fltbuf_sendW(ic+5,bi,bj) =   kpart(ip,bi,bj)                       fltbuf_sendW(ic+5,bi,bj) =   kpart(ip,bi,bj)
131                  fltbuf_sendW(ic+6,bi,bj) =  kfloat(ip,bi,bj)                       fltbuf_sendW(ic+6,bi,bj) =  kfloat(ip,bi,bj)
132                  fltbuf_sendW(ic+7,bi,bj) =     iup(ip,bi,bj)                       fltbuf_sendW(ic+7,bi,bj) =     iup(ip,bi,bj)
133                  fltbuf_sendW(ic+8,bi,bj) =    itop(ip,bi,bj)                       fltbuf_sendW(ic+8,bi,bj) =    itop(ip,bi,bj)
134                  fltbuf_sendW(ic+9,bi,bj) =    tend(ip,bi,bj)                       fltbuf_sendW(ic+9,bi,bj) =    tend(ip,bi,bj)
135                        
136                    npart(ip,bi,bj) =   npart(npart_tile(bi,bj),bi,bj)                       npart(ip,bi,bj)  =   npart(npart_tile(bi,bj),bi,bj)
137                   tstart(ip,bi,bj) =  tstart(npart_tile(bi,bj),bi,bj)                       tstart(ip,bi,bj) =  tstart(npart_tile(bi,bj),bi,bj)
138                  xpart(ip,bi,bj)   =   xpart(npart_tile(bi,bj),bi,bj)                       xpart(ip,bi,bj)  =   xpart(npart_tile(bi,bj),bi,bj)
139                  ypart(ip,bi,bj)   =   ypart(npart_tile(bi,bj),bi,bj)                       ypart(ip,bi,bj)  =   ypart(npart_tile(bi,bj),bi,bj)
140                  kpart(ip,bi,bj)   =   kpart(npart_tile(bi,bj),bi,bj)                       kpart(ip,bi,bj)  =   kpart(npart_tile(bi,bj),bi,bj)
141                  kfloat(ip,bi,bj)  =  kfloat(npart_tile(bi,bj),bi,bj)                       kfloat(ip,bi,bj) =  kfloat(npart_tile(bi,bj),bi,bj)
142                  iup(ip,bi,bj)     =     iup(npart_tile(bi,bj),bi,bj)                       iup(ip,bi,bj)    =     iup(npart_tile(bi,bj),bi,bj)
143                  itop(ip,bi,bj)    =    itop(npart_tile(bi,bj),bi,bj)                       itop(ip,bi,bj)   =    itop(npart_tile(bi,bj),bi,bj)
144                  tend(ip,bi,bj)    =    tend(npart_tile(bi,bj),bi,bj)                       tend(ip,bi,bj)   =    tend(npart_tile(bi,bj),bi,bj)
145    
146                  npart_tile(bi,bj) = npart_tile(bi,bj) - 1                       npart_tile(bi,bj) = npart_tile(bi,bj) - 1
147                        
148               endif                    endif
149                      
150            enddo                 enddo
151                ENDDO
152             ENDDO
        ENDDO  
       ENDDO  
153    
154  C--   "Put" east and west edges.  C--   "Put" east and west edges.
155         CALL EXCH_RL_SEND_PUT_VEC_X( fltbuf_sendE, fltbuf_sendW,           CALL EXCH_RL_SEND_PUT_VEC_X( fltbuf_sendE, fltbuf_sendW,
156       I             imax2, myThid )       I        imax2, myThid )
157  C--   Receive east/west arrays before exchanging north/south arrays  C--   Receive east/west arrays
158         CALL EXCH_RL_RECV_GET_VEC_X( fltbuf_recvE, fltbuf_recvW,           CALL EXCH_RL_RECV_GET_VEC_X( fltbuf_recvE, fltbuf_recvW,
159       I             imax2, myThid )       I        imax2, myThid )
160    
161  C--   Unpack arrays on new tiles  C--   Unpack arrays on new tiles
162    
163        DO bj=myByLo(myThid),myByHi(myThid)           DO bj=myByLo(myThid),myByHi(myThid)
164         DO bi=myBxLo(myThid),myBxHi(myThid)              DO bi=myBxLo(myThid),myBxHi(myThid)
165                        
166            do ip=1,max_npart_exch                 do ip=1,max_npart_exch
167  c  c
168               ic=(ip-1)*imax                    ic=(ip-1)*imax
169               if (fltbuf_recvE(ic+1,bi,bj) .eq. 0.) goto 100                    if (fltbuf_recvE(ic+1,bi,bj) .eq. 0.) goto 100
170               npart_tile(bi,bj) = npart_tile(bi,bj) + 1                    npart_tile(bi,bj) = npart_tile(bi,bj) + 1
171               if (npart_tile(bi,bj) .gt. max_npart_tile)                    if (npart_tile(bi,bj) .gt. max_npart_tile)
172       &       stop ' max_npart_tile too low. stop in flt_exchg'       &                 stop ' max_npart_tile too low. stop in flt_exchg'
173    
174                 npart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+1,bi,bj)                    npart(npart_tile(bi,bj),bi,bj) =
175                tstart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+2,bi,bj)       &                 fltbuf_recvE(ic+1,bi,bj)
176                 xpart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+3,bi,bj)                    tstart(npart_tile(bi,bj),bi,bj) =
177                 ypart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+4,bi,bj)       &                 fltbuf_recvE(ic+2,bi,bj)
178                 kpart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+5,bi,bj)                    xpart(npart_tile(bi,bj),bi,bj) =
179                kfloat(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+6,bi,bj)       &                 fltbuf_recvE(ic+3,bi,bj)
180                   iup(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+7,bi,bj)                    ypart(npart_tile(bi,bj),bi,bj) =
181                  itop(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+8,bi,bj)       &                 fltbuf_recvE(ic+4,bi,bj)
182                  tend(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+9,bi,bj)                    kpart(npart_tile(bi,bj),bi,bj) =
183         &                 fltbuf_recvE(ic+5,bi,bj)
184                      kfloat(npart_tile(bi,bj),bi,bj) =
185         &                 fltbuf_recvE(ic+6,bi,bj)
186                      iup(npart_tile(bi,bj),bi,bj) =
187         &                 fltbuf_recvE(ic+7,bi,bj)
188                      itop(npart_tile(bi,bj),bi,bj) =
189         &                 fltbuf_recvE(ic+8,bi,bj)
190                      tend(npart_tile(bi,bj),bi,bj) =
191         &                 fltbuf_recvE(ic+9,bi,bj)
192    
193            enddo                 enddo
194   100      continue   100           continue
195    
196            do ip=1,max_npart_exch                 do ip=1,max_npart_exch
197  c  c
198               ic=(ip-1)*imax                    ic=(ip-1)*imax
199               if (fltbuf_recvW(ic+1,bi,bj) .eq. 0.) goto 200                    if (fltbuf_recvW(ic+1,bi,bj) .eq. 0.) goto 200
200               npart_tile(bi,bj) = npart_tile(bi,bj) + 1                    npart_tile(bi,bj) = npart_tile(bi,bj) + 1
201               if (npart_tile(bi,bj) .gt. max_npart_tile)                    if (npart_tile(bi,bj) .gt. max_npart_tile)
202       &       stop ' max_npart_tile too low. stop in flt_exchg'       &                 stop ' max_npart_tile too low. stop in flt_exchg'
203    
204                 npart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+1,bi,bj)                    npart(npart_tile(bi,bj),bi,bj) =
205                tstart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+2,bi,bj)       &                 fltbuf_recvW(ic+1,bi,bj)
206                 xpart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+3,bi,bj)                    tstart(npart_tile(bi,bj),bi,bj) =
207                 ypart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+4,bi,bj)       &                 fltbuf_recvW(ic+2,bi,bj)
208                 kpart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+5,bi,bj)                    xpart(npart_tile(bi,bj),bi,bj) =
209                kfloat(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+6,bi,bj)       &                 fltbuf_recvW(ic+3,bi,bj)
210                   iup(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+7,bi,bj)                    ypart(npart_tile(bi,bj),bi,bj) =
211                  itop(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+8,bi,bj)       &                 fltbuf_recvW(ic+4,bi,bj)
212                  itop(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+8,bi,bj)                    kpart(npart_tile(bi,bj),bi,bj) =
213                  tend(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+9,bi,bj)       &                 fltbuf_recvW(ic+5,bi,bj)
214                      kfloat(npart_tile(bi,bj),bi,bj) =
215         &                 fltbuf_recvW(ic+6,bi,bj)
216                      iup(npart_tile(bi,bj),bi,bj) =
217         &                 fltbuf_recvW(ic+7,bi,bj)
218                      itop(npart_tile(bi,bj),bi,bj) =
219         &                 fltbuf_recvW(ic+8,bi,bj)
220                      itop(npart_tile(bi,bj),bi,bj) =
221         &                 fltbuf_recvW(ic+8,bi,bj)
222                      tend(npart_tile(bi,bj),bi,bj) =
223         &                 fltbuf_recvW(ic+9,bi,bj)
224    
225                   enddo
226     200           continue
227    
228            enddo              ENDDO
229   200      continue           ENDDO
230    
231         ENDDO  caw end tile check
232        ENDDO        endif
233    
234  C--   Choose floats that have to exchanged with eastern and western tiles  C--   Choose floats that have to exchanged with northern and southern tiles
235  C     and pack to arrays  C     and pack to arrays
236    
237    caw Check if there are northern/southern tiles
238          if(Ny .ne. sNy) then
239    
240        DO bj=myByLo(myThid),myByHi(myThid)           DO bj=myByLo(myThid),myByHi(myThid)
241         DO bi=myBxLo(myThid),myBxHi(myThid)              DO bi=myBxLo(myThid),myBxHi(myThid)
242                
243  c initialize buffers  c initialize buffers
244    
245            do m=1,imax2                 do m=1,imax2
246                fltbuf_sendE(m,bi,bj) = 0.                    fltbuf_sendE(m,bi,bj) = 0.
247                fltbuf_sendW(m,bi,bj) = 0.                    fltbuf_sendW(m,bi,bj) = 0.
248                fltbuf_recvE(m,bi,bj) = 0.                    fltbuf_recvE(m,bi,bj) = 0.
249                fltbuf_recvW(m,bi,bj) = 0.                    fltbuf_recvW(m,bi,bj) = 0.
250            enddo                 enddo
251    
252            icountN=0                 icountN=0
253            icountS=0                 icountS=0
254    
255            jG = myYGlobalLo + (bj-1)*sNy                 jG = myYGlobalLo + (bj-1)*sNy
256            ylo = yc(1,  1,  bi,bj) - delY(jG)                 ylo = yc(1,  1,  bi,bj) - delY(jG)
257            yhi = yc(1,sNy,bi,bj)   + delY(jG+sNy-1)                 yhi = yc(1,sNy,bi,bj)   + delY(jG+sNy-1)
258    
259            do ip=1,npart_tile(bi,bj)                 do ip=1,npart_tile(bi,bj)
260    
261               if (ypart(ip,bi,bj) .ge. yhi) then                    if (ypart(ip,bi,bj) .ge. yhi) then
262                  icountN=icountN+1                       icountN=icountN+1
263                  if (icountN .gt. max_npart_exch)                       if (icountN .gt. max_npart_exch) stop
264       &          stop ' max_npart_exch too low. stop in flt_exchg'       &                    ' max_npart_exch too low. stop in flt_exchg'
265    
266                  ic=(icountN-1)*imax                       ic=(icountN-1)*imax
267                  fltbuf_sendE(ic+1,bi,bj) =   npart(ip,bi,bj)                       fltbuf_sendE(ic+1,bi,bj) =   npart(ip,bi,bj)
268                  fltbuf_sendE(ic+2,bi,bj) =  tstart(ip,bi,bj)                       fltbuf_sendE(ic+2,bi,bj) =  tstart(ip,bi,bj)
269                  fltbuf_sendE(ic+3,bi,bj) =   xpart(ip,bi,bj)                       fltbuf_sendE(ic+3,bi,bj) =   xpart(ip,bi,bj)
270                  fltbuf_sendE(ic+4,bi,bj) =   ypart(ip,bi,bj)                       fltbuf_sendE(ic+4,bi,bj) =   ypart(ip,bi,bj)
271                  fltbuf_sendE(ic+5,bi,bj) =   kpart(ip,bi,bj)                       fltbuf_sendE(ic+5,bi,bj) =   kpart(ip,bi,bj)
272                  fltbuf_sendE(ic+6,bi,bj) =  kfloat(ip,bi,bj)                       fltbuf_sendE(ic+6,bi,bj) =  kfloat(ip,bi,bj)
273                  fltbuf_sendE(ic+7,bi,bj) =     iup(ip,bi,bj)                       fltbuf_sendE(ic+7,bi,bj) =     iup(ip,bi,bj)
274                  fltbuf_sendE(ic+8,bi,bj) =    itop(ip,bi,bj)                       fltbuf_sendE(ic+8,bi,bj) =    itop(ip,bi,bj)
275                  fltbuf_sendE(ic+9,bi,bj) =    tend(ip,bi,bj)                       fltbuf_sendE(ic+9,bi,bj) =    tend(ip,bi,bj)
276    
277                    npart(ip,bi,bj) =   npart(npart_tile(bi,bj),bi,bj)                       npart(ip,bi,bj) =  npart(npart_tile(bi,bj),bi,bj)
278                   tstart(ip,bi,bj) =  tstart(npart_tile(bi,bj),bi,bj)                       tstart(ip,bi,bj) = tstart(npart_tile(bi,bj),bi,bj)
279                  xpart(ip,bi,bj)   =   xpart(npart_tile(bi,bj),bi,bj)                       xpart(ip,bi,bj) =  xpart(npart_tile(bi,bj),bi,bj)
280                  ypart(ip,bi,bj)   =   ypart(npart_tile(bi,bj),bi,bj)                       ypart(ip,bi,bj) =  ypart(npart_tile(bi,bj),bi,bj)
281                  kpart(ip,bi,bj)   =   kpart(npart_tile(bi,bj),bi,bj)                       kpart(ip,bi,bj) =  kpart(npart_tile(bi,bj),bi,bj)
282                  kfloat(ip,bi,bj)  =  kfloat(npart_tile(bi,bj),bi,bj)                       kfloat(ip,bi,bj) = kfloat(npart_tile(bi,bj),bi,bj)
283                  iup(ip,bi,bj)     =     iup(npart_tile(bi,bj),bi,bj)                       iup(ip,bi,bj)   =  iup(npart_tile(bi,bj),bi,bj)
284                  itop(ip,bi,bj)    =    itop(npart_tile(bi,bj),bi,bj)                       itop(ip,bi,bj)  =  itop(npart_tile(bi,bj),bi,bj)
285                  tend(ip,bi,bj)    =    tend(npart_tile(bi,bj),bi,bj)                       tend(ip,bi,bj)  =  tend(npart_tile(bi,bj),bi,bj)
286    
287                  npart_tile(bi,bj) = npart_tile(bi,bj) - 1                       npart_tile(bi,bj) = npart_tile(bi,bj) - 1
288               endif                    endif
289    
290               if (ypart(ip,bi,bj) .le. ylo) then                    if (ypart(ip,bi,bj) .le. ylo) then
291                  icountS=icountS+1                       icountS=icountS+1
292                  if (icountS .gt. max_npart_exch)                       if (icountS .gt. max_npart_exch) stop
293       &          stop ' max_npart_exch too low. stop in flt_exchg'       &                    ' max_npart_exch too low. stop in flt_exchg'
294    
295                  ic=(icountS-1)*imax                       ic=(icountS-1)*imax
296                  fltbuf_sendW(ic+1,bi,bj) =   npart(ip,bi,bj)                       fltbuf_sendW(ic+1,bi,bj) =   npart(ip,bi,bj)
297                  fltbuf_sendW(ic+2,bi,bj) =  tstart(ip,bi,bj)                       fltbuf_sendW(ic+2,bi,bj) =  tstart(ip,bi,bj)
298                  fltbuf_sendW(ic+3,bi,bj) =   xpart(ip,bi,bj)                       fltbuf_sendW(ic+3,bi,bj) =   xpart(ip,bi,bj)
299                  fltbuf_sendW(ic+4,bi,bj) =   ypart(ip,bi,bj)                       fltbuf_sendW(ic+4,bi,bj) =   ypart(ip,bi,bj)
300                  fltbuf_sendW(ic+5,bi,bj) =   kpart(ip,bi,bj)                       fltbuf_sendW(ic+5,bi,bj) =   kpart(ip,bi,bj)
301                  fltbuf_sendW(ic+6,bi,bj) =  kfloat(ip,bi,bj)                       fltbuf_sendW(ic+6,bi,bj) =  kfloat(ip,bi,bj)
302                  fltbuf_sendW(ic+7,bi,bj) =     iup(ip,bi,bj)                       fltbuf_sendW(ic+7,bi,bj) =     iup(ip,bi,bj)
303                  fltbuf_sendW(ic+8,bi,bj) =    itop(ip,bi,bj)                       fltbuf_sendW(ic+8,bi,bj) =    itop(ip,bi,bj)
304                  fltbuf_sendW(ic+9,bi,bj) =    tend(ip,bi,bj)                       fltbuf_sendW(ic+9,bi,bj) =    tend(ip,bi,bj)
305    
306                    npart(ip,bi,bj) =   npart(npart_tile(bi,bj),bi,bj)                       npart(ip,bi,bj) =   npart(npart_tile(bi,bj),bi,bj)
307                   tstart(ip,bi,bj) =  tstart(npart_tile(bi,bj),bi,bj)                       tstart(ip,bi,bj) =  tstart(npart_tile(bi,bj),bi,bj)
308                  xpart(ip,bi,bj)   =   xpart(npart_tile(bi,bj),bi,bj)                       xpart(ip,bi,bj) =   xpart(npart_tile(bi,bj),bi,bj)
309                  ypart(ip,bi,bj)   =   ypart(npart_tile(bi,bj),bi,bj)                       ypart(ip,bi,bj) =   ypart(npart_tile(bi,bj),bi,bj)
310                  kpart(ip,bi,bj)   =   kpart(npart_tile(bi,bj),bi,bj)                       kpart(ip,bi,bj) =   kpart(npart_tile(bi,bj),bi,bj)
311                  kfloat(ip,bi,bj)  =  kfloat(npart_tile(bi,bj),bi,bj)                       kfloat(ip,bi,bj) =  kfloat(npart_tile(bi,bj),bi,bj)
312                  iup(ip,bi,bj)     =     iup(npart_tile(bi,bj),bi,bj)                       iup(ip,bi,bj)   =   iup(npart_tile(bi,bj),bi,bj)
313                  itop(ip,bi,bj)    =    itop(npart_tile(bi,bj),bi,bj)                       itop(ip,bi,bj)  =   itop(npart_tile(bi,bj),bi,bj)
314                  tend(ip,bi,bj)    =    tend(npart_tile(bi,bj),bi,bj)                       tend(ip,bi,bj)  =   tend(npart_tile(bi,bj),bi,bj)
315    
316                  npart_tile(bi,bj) = npart_tile(bi,bj) - 1                       npart_tile(bi,bj) = npart_tile(bi,bj) - 1
317               endif                    endif
318    
319            enddo                 enddo
320    
321         ENDDO              ENDDO
322        ENDDO           ENDDO
323    
324  C     "Put" north and south arrays.  C     "Put" north and south arrays.
325         CALL EXCH_RL_SEND_PUT_VEC_Y( fltbuf_sendE, fltbuf_sendW,           CALL EXCH_RL_SEND_PUT_VEC_Y( fltbuf_sendE, fltbuf_sendW,
326       I             imax2, myThid )       I        imax2, myThid )
327    
328  C     Receive north and south arrays  C     Receive north and south arrays
329         CALL EXCH_RL_RECV_GET_VEC_Y( fltbuf_recvE, fltbuf_recvW,           CALL EXCH_RL_RECV_GET_VEC_Y( fltbuf_recvE, fltbuf_recvW,
330       I             imax2, myThid )       I        imax2, myThid )
331    
332  C--   Unpack arrays on new tiles  C--   Unpack arrays on new tiles
333    
334        DO bj=myByLo(myThid),myByHi(myThid)           DO bj=myByLo(myThid),myByHi(myThid)
335         DO bi=myBxLo(myThid),myBxHi(myThid)              DO bi=myBxLo(myThid),myBxHi(myThid)
336                
337            do ip=1,max_npart_exch                 do ip=1,max_npart_exch
338  c  c
339               ic=(ip-1)*imax                    ic=(ip-1)*imax
340               if (fltbuf_recvE(ic+1,bi,bj) .eq. 0.) goto 300                    if (fltbuf_recvE(ic+1,bi,bj) .eq. 0.) goto 300
341               npart_tile(bi,bj) = npart_tile(bi,bj) + 1                    npart_tile(bi,bj) = npart_tile(bi,bj) + 1
342               if (npart_tile(bi,bj) .gt. max_npart_tile)                    if (npart_tile(bi,bj) .gt. max_npart_tile)
343       &       stop ' max_npart_tile too low. stop in flt_exchg'       &                 stop ' max_npart_tile too low. stop in flt_exchg'
344    
345                 npart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+1,bi,bj)                    npart(npart_tile(bi,bj),bi,bj) =  
346                tstart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+2,bi,bj)       &                 fltbuf_recvE(ic+1,bi,bj)
347                 xpart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+3,bi,bj)                    tstart(npart_tile(bi,bj),bi,bj) =  
348                 ypart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+4,bi,bj)       &                 fltbuf_recvE(ic+2,bi,bj)
349                 kpart(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+5,bi,bj)                    xpart(npart_tile(bi,bj),bi,bj) =  
350                kfloat(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+6,bi,bj)       &                 fltbuf_recvE(ic+3,bi,bj)
351                   iup(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+7,bi,bj)                    ypart(npart_tile(bi,bj),bi,bj) =  
352                  itop(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+8,bi,bj)       &                 fltbuf_recvE(ic+4,bi,bj)
353                  tend(npart_tile(bi,bj),bi,bj) = fltbuf_recvE(ic+9,bi,bj)                    kpart(npart_tile(bi,bj),bi,bj) =  
354         &                 fltbuf_recvE(ic+5,bi,bj)
355                      kfloat(npart_tile(bi,bj),bi,bj) =  
356         &                 fltbuf_recvE(ic+6,bi,bj)
357                      iup(npart_tile(bi,bj),bi,bj) =  
358         &                 fltbuf_recvE(ic+7,bi,bj)
359                      itop(npart_tile(bi,bj),bi,bj) =  
360         &                 fltbuf_recvE(ic+8,bi,bj)
361                      tend(npart_tile(bi,bj),bi,bj) =  
362         &                 fltbuf_recvE(ic+9,bi,bj)
363    
364            enddo                 enddo
365   300      continue   300           continue
366    
367            do ip=1,max_npart_exch                 do ip=1,max_npart_exch
368  c  c
369               ic=(ip-1)*imax                    ic=(ip-1)*imax
370               if (fltbuf_recvW(ic+1,bi,bj) .eq. 0.) goto 400                    if (fltbuf_recvW(ic+1,bi,bj) .eq. 0.) goto 400
371               npart_tile(bi,bj) = npart_tile(bi,bj) + 1                    npart_tile(bi,bj) = npart_tile(bi,bj) + 1
372               if (npart_tile(bi,bj) .gt. max_npart_tile)                    if (npart_tile(bi,bj) .gt. max_npart_tile)
373       &       stop ' max_npart_tile too low. stop in flt_exchg'       &                 stop ' max_npart_tile too low. stop in flt_exchg'
374    
375                 npart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+1,bi,bj)                    npart(npart_tile(bi,bj),bi,bj) =  
376                tstart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+2,bi,bj)       &                 fltbuf_recvW(ic+1,bi,bj)
377                 xpart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+3,bi,bj)                    tstart(npart_tile(bi,bj),bi,bj) =  
378                 ypart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+4,bi,bj)       &                 fltbuf_recvW(ic+2,bi,bj)
379                 kpart(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+5,bi,bj)                    xpart(npart_tile(bi,bj),bi,bj) =  
380                kfloat(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+6,bi,bj)       &                 fltbuf_recvW(ic+3,bi,bj)
381                   iup(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+7,bi,bj)                    ypart(npart_tile(bi,bj),bi,bj) =  
382                  itop(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+8,bi,bj)       &                 fltbuf_recvW(ic+4,bi,bj)
383                  tend(npart_tile(bi,bj),bi,bj) = fltbuf_recvW(ic+9,bi,bj)                    kpart(npart_tile(bi,bj),bi,bj) =  
384         &                 fltbuf_recvW(ic+5,bi,bj)
385            enddo                    kfloat(npart_tile(bi,bj),bi,bj) =  
386   400      continue       &                 fltbuf_recvW(ic+6,bi,bj)
387                      iup(npart_tile(bi,bj),bi,bj) =  
388         &                 fltbuf_recvW(ic+7,bi,bj)
389                      itop(npart_tile(bi,bj),bi,bj) =  
390         &                 fltbuf_recvW(ic+8,bi,bj)
391                      tend(npart_tile(bi,bj),bi,bj) =  
392         &                 fltbuf_recvW(ic+9,bi,bj)
393    
394                   enddo
395     400           continue
396                  
397                ENDDO
398             ENDDO
399    
400         ENDDO  caw end tile check
401        ENDDO        endif
402    
403        return        return
404        end        end
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22