249
250
253
255# ifdef DISTRIBUTE
257# endif
258
259
260
261 integer, intent(in) :: ng, tile, model
262 integer, intent(in) :: LBi, UBi, LBj, UBj
263 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
264
265 integer, intent(in) :: nnew
266
267# ifdef ASSUMED_SHAPE
268 real(r8), intent(in) :: DU_avg2(LBi:,LBj:)
269 real(r8), intent(in) :: DV_avg2(LBi:,LBj:)
270 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
271 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
272# ifdef WEC
273 real(r8), intent(in) :: u_stokes(LBi:,LBj:,:)
274 real(r8), intent(in) :: v_stokes(LBi:,LBj:,:)
275# endif
276 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
277 real(r8), intent(in) :: om_v(LBi:,LBj:)
278 real(r8), intent(in) :: on_u(LBi:,LBj:)
279
280 real(r8), intent(inout) :: Huon(LBi:,LBj:,:)
281 real(r8), intent(inout) :: Hvom(LBi:,LBj:,:)
282# else
283 real(r8), intent(in) :: DU_avg2(LBi:UBi,LBj:UBj)
284 real(r8), intent(in) :: DV_avg2(LBi:UBi,LBj:UBj)
285 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
286 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
287# ifdef WEC
288 real(r8), intent(in) :: u_stokes(LBi:UBi,LBj:UBj,N(Ng))
289 real(r8), intent(in) :: v_stokes(LBi:UBi,LBj:UBj,N(ng))
290# endif
291 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
292 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
293 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
294
295 real(r8), intent(inout) :: Huon(LBi:UBi,LBj:UBj,N(ng))
296 real(r8), intent(inout) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
297# endif
298
299
300
301 integer :: i, j, k
302
303 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC
304 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
305
306# include "set_bounds.h"
307
308
309
310
311
312
313
314
315
316 DO j=jstrt,jendt
317 DO i=istrp,iendt
318 dc(i,0)=0.0_r8
319 fc(i,0)=0.0_r8
320 END DO
322 DO i=istrp,iendt
323 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i-1,j,k))*on_u(i,j)
324 dc(i,0)=dc(i,0)+dc(i,k)
325 END DO
326 END DO
328 DO i=istrp,iendt
329 huon(i,j,k)=0.5_r8*(huon(i,j,k)+u(i,j,k,nnew)*dc(i,k))
330# ifdef WEC
331 huon(i,j,k)=huon(i,j,k)+0.5_r8*u_stokes(i,j,k)*dc(i,k)
332# endif
333 fc(i,0)=fc(i,0)+huon(i,j,k)
334 END DO
335 END DO
336
337
338
339 DO i=istrp,iendt
340 dc(i,0)=1.0_r8/dc(i,0)
341 fc(i,0)=dc(i,0)*(fc(i,0)-du_avg2(i,j))
342 END DO
344 DO i=istrp,iendt
345 huon(i,j,k)=huon(i,j,k)-dc(i,k)*fc(i,0)
346 END DO
347 END DO
348
349
350
351 IF (j.ge.jstrp) THEN
352 DO i=istrt,iendt
353 dc(i,0)=0.0_r8
354 fc(i,0)=0.0_r8
355 END DO
357 DO i=istrt,iendt
358 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i,j-1,k))*om_v(i,j)
359 dc(i,0)=dc(i,0)+dc(i,k)
360 END DO
361 END DO
363 DO i=istrt,iendt
364 hvom(i,j,k)=0.5_r8*(hvom(i,j,k)+v(i,j,k,nnew)*dc(i,k))
365# ifdef WEC
366 hvom(i,j,k)=hvom(i,j,k)+0.5_r8*v_stokes(i,j,k)*dc(i,k)
367# endif
368 fc(i,0)=fc(i,0)+hvom(i,j,k)
369 END DO
370 END DO
371
372
373
374 DO i=istrt,iendt
375 dc(i,0)=1.0_r8/dc(i,0)
376 fc(i,0)=dc(i,0)*(fc(i,0)-dv_avg2(i,j))
377 END DO
379 DO i=istrt,iendt
380 hvom(i,j,k)=hvom(i,j,k)-dc(i,k)*fc(i,0)
381 END DO
382 END DO
383 ENDIF
384 END DO
385
386
387
390 & lbi, ubi, lbj, ubj, 1,
n(ng), &
391 & huon)
393 & lbi, ubi, lbj, ubj, 1,
n(ng), &
394 & hvom)
395 END IF
396
397# ifdef DISTRIBUTE
399 & lbi, ubi, lbj, ubj, 1,
n(ng), &
402 & huon, hvom)
403# endif
404
405 RETURN
subroutine exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
subroutine exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
integer, dimension(:), allocatable n
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)