ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
set_avg_mod Module Reference

Functions/Subroutines

subroutine, public set_avg (ng, tile)
 
subroutine set_avg_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nout, kout)
 
subroutine set_detide_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, ntc, kout, nout, cosomega, sinomega, cosw_avg, cosw_sum, sinw_avg, sinw_sum, coswcosw, sinwsinw, sinwcosw)
 

Function/Subroutine Documentation

◆ set_avg()

subroutine, public set_avg_mod::set_avg ( integer, intent(in) ng,
integer, intent(in) tile )

Definition at line 33 of file set_avg.F.

34!***********************************************************************
35!
36 USE mod_param
37# ifdef WET_DRY
38 USE mod_grid
39# endif
40 USE mod_stepping
41# if defined AVERAGES_DETIDE && (defined SSH_TIDES || defined UV_TIDES)
42 USE mod_tides
43# endif
44!
45# if defined ICE_MODEL && defined SOLVE3D
46 USE ice_set_avg_mod, ONLY : ice_set_avg_tile
47# endif
48# ifdef WET_DRY
49 USE set_masks_mod, ONLY : set_avg_masks
50# endif
51!
52! Imported variable declarations.
53!
54 integer, intent(in) :: ng, tile
55!
56! Local variable declarations.
57!
58 character (len=*), parameter :: MyFile = &
59 & __FILE__
60!
61# include "tile.h"
62!
63# ifdef PROFILE
64 CALL wclock_on (ng, inlm, 5, __line__, myfile)
65# endif
66 CALL set_avg_tile (ng, tile, &
67 & lbi, ubi, lbj, ubj, &
68 & imins, imaxs, jmins, jmaxs, &
69# ifdef SOLVE3D
70 & nout, &
71# endif
72 & kout)
73
74# if defined AVERAGES_DETIDE && (defined SSH_TIDES || defined UV_TIDES)
75 CALL set_detide_tile (ng, tile, &
76 & lbi, ubi, lbj, ubj, &
77 & imins, imaxs, jmins, jmaxs, &
78 & ntc(ng), kout, &
79# ifdef SOLVE3D
80 & nout, &
81# endif
82 & tides(ng) % CosOmega, &
83 & tides(ng) % SinOmega, &
84 & tides(ng) % CosW_avg, &
85 & tides(ng) % CosW_sum, &
86 & tides(ng) % SinW_avg, &
87 & tides(ng) % SinW_sum, &
88 & tides(ng) % CosWCosW, &
89 & tides(ng) % SinWSinW, &
90 & tides(ng) % SinWCosW)
91# endif
92
93# ifdef WET_DRY
94 CALL set_avg_masks (ng, tile, inlm, &
95 & lbi, ubi, lbj, ubj, &
96 & imins, imaxs, jmins, jmaxs, &
97 & grid(ng) % pmask_avg, &
98 & grid(ng) % rmask_avg, &
99 & grid(ng) % umask_avg, &
100 & grid(ng) % vmask_avg)
101# endif
102
103# if defined ICE_MODEL && defined SOLVE3D
104 CALL ice_set_avg_tile (ng, tile, inlm, &
105 & lbi, ubi, lbj, ubj, &
106 & imins, imaxs, jmins, jmaxs, &
107 & iout)
108# endif
109
110# ifdef PROFILE
111 CALL wclock_off (ng, inlm, 5, __line__, myfile)
112# endif
113!
114 RETURN
ice_set_avg_mod
Definition ice_set_avg.F:2
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_param
Definition mod_param.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_stepping
Definition mod_stepping.F:2
mod_stepping::ntc
integer, dimension(:), allocatable ntc
Definition mod_stepping.F:110
mod_tides
Definition mod_tides.F:2
mod_tides::tides
type(t_tides), dimension(:), allocatable tides
Definition mod_tides.F:133
set_masks_mod
Definition set_masks.F:2
set_masks_mod::set_avg_masks
subroutine, public set_avg_masks(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, pmask_avg, rmask_avg, umask_avg, vmask_avg)
Definition set_masks.F:417
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3

References mod_grid::grid, mod_param::inlm, mod_stepping::ntc, set_masks_mod::set_avg_masks(), set_avg_tile(), set_detide_tile(), mod_tides::tides, wclock_off(), and wclock_on().

Referenced by main3d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ set_avg_tile()

subroutine set_avg_mod::set_avg_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nout,
integer, intent(in) kout )
private

Definition at line 118 of file set_avg.F.

125!***********************************************************************
126!
127 USE mod_param
128 USE mod_ncparam
129 USE mod_average
130# if defined FORWARD_WRITE && defined SOLVE3D
131 USE mod_coupling
132# endif
133 USE mod_forces
134 USE mod_grid
135# ifdef SOLVE3D
136 USE mod_mixing
137# endif
138 USE mod_ocean
139 USE mod_scalars
140# if defined BBL_MODEL
141 USE mod_bbl
142# endif
143# if defined SEDIMENT && defined BEDLOAD
144 USE mod_sedbed
145 USE mod_sediment
146# endif
147!
148 USE exchange_2d_mod
149# ifdef SOLVE3D
150 USE exchange_3d_mod
151# endif
152# ifdef DISTRIBUTE
153 USE mp_exchange_mod, ONLY : mp_exchange2d
154# ifdef SOLVE3D
155 USE mp_exchange_mod, ONLY : mp_exchange3d
156# endif
157# endif
158 USE uv_rotate_mod, ONLY : uv_rotate2d
159# ifdef SOLVE3D
160 USE uv_rotate_mod, ONLY : uv_rotate3d
161# endif
162 USE vorticity_mod, ONLY : vorticity_tile
163!
164 implicit none
165!
166! Imported variable declarations.
167!
168 integer, intent(in) :: ng, tile
169 integer, intent(in) :: LBi, UBi, LBj, UBj
170 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
171 integer, intent(in) :: Kout
172# ifdef SOLVE3D
173 integer, intent(in) :: Nout
174# endif
175!
176!
177! Local variable declarations.
178!
179 integer :: i, it, j, k
180
181 real(r8) :: fac
182
183 real(r8) :: pfac(IminS:ImaxS,JminS:JmaxS)
184 real(r8) :: rfac(IminS:ImaxS,JminS:JmaxS)
185 real(r8) :: ufac(IminS:ImaxS,JminS:JmaxS)
186 real(r8) :: vfac(IminS:ImaxS,JminS:JmaxS)
187
188# ifdef SOLVE3D
189 real(r8) :: potvor(LBi:UBi,LBj:UBj,N(ng))
190 real(r8) :: relvor(LBi:UBi,LBj:UBj,N(ng))
191# endif
192 real(r8) :: potvor_bar(LBi:UBi,LBj:UBj)
193 real(r8) :: relvor_bar(LBi:UBi,LBj:UBj)
194# ifdef BBL_MODEL
195 real(r8), allocatable :: wrk(:,:)
196# endif
197
198# include "set_bounds.h"
199!
200!-----------------------------------------------------------------------
201! Return if time-averaging window is zero.
202!-----------------------------------------------------------------------
203!
204 IF (navg(ng).eq.0) RETURN
205!
206!-----------------------------------------------------------------------
207! Compute vorticity fields.
208!-----------------------------------------------------------------------
209!
210 IF (aout(id2dpv,ng).or.aout(id2drv,ng).or. &
211 & aout(id3dpv,ng).or.aout(id3drv,ng)) THEN
212 CALL vorticity_tile (ng, tile, &
213 & lbi, ubi, lbj, ubj, &
214 & imins, imaxs, jmins, jmaxs, &
215# ifdef SOLVE3D
216 & kout, nout, &
217# else
218 & kout, &
219# endif
220# ifdef MASKING
221 & grid(ng) % pmask, &
222 & grid(ng) % umask, &
223 & grid(ng) % vmask, &
224# endif
225 & grid(ng) % fomn, &
226 & grid(ng) % h, &
227 & grid(ng) % om_u, &
228 & grid(ng) % on_v, &
229 & grid(ng) % pm, &
230 & grid(ng) % pn, &
231# ifdef SOLVE3D
232 & grid(ng) % z_r, &
233 & ocean(ng) % pden, &
234 & ocean(ng) % u, &
235 & ocean(ng) % v, &
236# endif
237 & ocean(ng) % ubar, &
238 & ocean(ng) % vbar, &
239 & ocean(ng) % zeta, &
240# ifdef SOLVE3D
241 & potvor, relvor, &
242# endif
243 & potvor_bar, relvor_bar)
244 END IF
245!
246!-----------------------------------------------------------------------
247! Initialize time-averaged arrays when appropriate. Notice that
248! fields are initilized twice during re-start. However, the time-
249! averaged fields are computed correctly.
250!-----------------------------------------------------------------------
251!
252 IF (((iic(ng).gt.ntsavg(ng)).and. &
253 & (mod(iic(ng)-1,navg(ng)).eq.1)).or. &
254 & ((iic(ng).ge.ntsavg(ng)).and.(navg(ng).eq.1)).or. &
255 & ((nrrec(ng).gt.0).and.(iic(ng).eq.ntstart(ng)))) THEN
256
257# ifdef WET_DRY
258!
259! If wetting and drying, initialize time dependent counters for wet
260! points. The time averaged field at each point is only accumulated
261! over wet points since its multiplied by the appropriate mask.
262!
263 DO j=jstr,jendr
264 DO i=istr,iendr
265 grid(ng)%pmask_avg(i,j)=max(0.0_r8, &
266 & min(grid(ng)%pmask_full(i,j), &
267 & 1.0_r8))
268 END DO
269 END DO
270 DO j=jstrr,jendr
271 DO i=istrr,iendr
272 grid(ng)%rmask_avg(i,j)=max(0.0_r8, &
273 & min(grid(ng)%rmask_full(i,j), &
274 & 1.0_r8))
275 END DO
276 END DO
277 DO j=jstrr,jendr
278 DO i=istr,iendr
279 grid(ng)%umask_avg(i,j)=max(0.0_r8, &
280 & min(grid(ng)%umask_full(i,j), &
281 & 1.0_r8))
282 END DO
283 END DO
284 DO j=jstr,jendr
285 DO i=istrr,iendr
286 grid(ng)%vmask_avg(i,j)=max(0.0_r8, &
287 & min(grid(ng)%vmask_full(i,j), &
288 & 1.0_r8))
289 END DO
290 END DO
291# endif
292!
293! Initialize state variables.
294!
295 IF (aout(idfsur,ng)) THEN
296 DO j=jstrr,jendr
297 DO i=istrr,iendr
298 average(ng)%avgzeta(i,j)=ocean(ng)%zeta(i,j,kout)
299# ifdef WET_DRY
300 average(ng)%avgzeta(i,j)=average(ng)%avgzeta(i,j)* &
301 & grid(ng)%rmask_full(i,j)
302# endif
303 END DO
304 END DO
305 END IF
306
307 IF (aout(idubar,ng)) THEN
308 DO j=jstrr,jendr
309 DO i=istr,iendr
310 average(ng)%avgu2d(i,j)=ocean(ng)%ubar(i,j,kout)
311# ifdef WET_DRY
312 average(ng)%avgu2d(i,j)=average(ng)%avgu2d(i,j)* &
313 & grid(ng)%umask_full(i,j)
314# endif
315 END DO
316 END DO
317 END IF
318 IF (aout(idvbar,ng)) THEN
319 DO j=jstr,jendr
320 DO i=istrr,iendr
321 average(ng)%avgv2d(i,j)=ocean(ng)%vbar(i,j,kout)
322# ifdef WET_DRY
323 average(ng)%avgv2d(i,j)=average(ng)%avgv2d(i,j)* &
324 & grid(ng)%vmask_full(i,j)
325# endif
326 END DO
327 END DO
328 END IF
329
330 IF (aout(idu2de,ng).and.aout(idv2dn,ng)) THEN
331 CALL uv_rotate2d (ng, tile, .false., .false., &
332 & lbi, ubi, lbj, ubj, &
333 & grid(ng) % CosAngler, &
334 & grid(ng) % SinAngler, &
335# ifdef MASKING
336 & grid(ng)%rmask_full, &
337# endif
338 & ocean(ng) % ubar(:,:,kout), &
339 & ocean(ng) % vbar(:,:,kout), &
340 & average(ng)%avgu2dE, &
341 & average(ng)%avgv2dN)
342 END IF
343
344# ifdef SOLVE3D
345 IF (aout(iduvel,ng)) THEN
346 DO k=1,n(ng)
347 DO j=jstrr,jendr
348 DO i=istr,iendr
349 average(ng)%avgu3d(i,j,k)=ocean(ng)%u(i,j,k,nout)
350# ifdef WET_DRY
351 average(ng)%avgu3d(i,j,k)=average(ng)%avgu3d(i,j,k)* &
352 & grid(ng)%umask_full(i,j)
353# endif
354 END DO
355 END DO
356 END DO
357 END IF
358 IF (aout(idvvel,ng)) THEN
359 DO k=1,n(ng)
360 DO j=jstr,jendr
361 DO i=istrr,iendr
362 average(ng)%avgv3d(i,j,k)=ocean(ng)%v(i,j,k,nout)
363# ifdef WET_DRY
364 average(ng)%avgv3d(i,j,k)=average(ng)%avgv3d(i,j,k)* &
365 & grid(ng)%vmask_full(i,j)
366# endif
367 END DO
368 END DO
369 END DO
370 END IF
371
372 IF (aout(idu3de,ng)) THEN
373 DO k=1,n(ng)
374 DO j=jstrr,jendr
375 DO i=istrr,iendr
376 average(ng)%avgu3dE(i,j,k)=ocean(ng)%ua(i,j,k)
377# ifdef WET_DRY
378 average(ng)%avgu3dE(i,j,k)=average(ng)%avgu3dE(i,j,k)* &
379 & grid(ng)%vmask_full(i,j)
380# endif
381 END DO
382 END DO
383 END DO
384 END IF
385 IF (aout(idv3dn,ng)) THEN
386 DO k=1,n(ng)
387 DO j=jstrr,jendr
388 DO i=istrr,iendr
389 average(ng)%avgv3dN(i,j,k)=ocean(ng)%va(i,j,k)
390# ifdef WET_DRY
391 average(ng)%avgv3dN(i,j,k)=average(ng)%avgv3dN(i,j,k)* &
392 & grid(ng)%vmask_full(i,j)
393# endif
394 END DO
395 END DO
396 END DO
397 END IF
398
399 IF (aout(idovel,ng)) THEN
400 DO k=0,n(ng)
401 DO j=jstrr,jendr
402 DO i=istrr,iendr
403 average(ng)%avgw3d(i,j,k)=ocean(ng)%W(i,j,k)* &
404 & grid(ng)%pm(i,j)* &
405 & grid(ng)%pn(i,j)
406# ifdef WET_DRY
407 average(ng)%avgw3d(i,j,k)=average(ng)%avgw3d(i,j,k)* &
408 & grid(ng)%rmask_full(i,j)
409# endif
410 END DO
411 END DO
412 END DO
413 END IF
414 IF (aout(idwvel,ng)) THEN
415 DO k=0,n(ng)
416 DO j=jstrr,jendr
417 DO i=istrr,iendr
418 average(ng)%avgwvel(i,j,k)=ocean(ng)%wvel(i,j,k)
419# ifdef WET_DRY
420 average(ng)%avgwvel(i,j,k)=average(ng)%avgwvel(i,j,k)* &
421 & grid(ng)%rmask_full(i,j)
422# endif
423 END DO
424 END DO
425 END DO
426 END IF
427
428 IF (aout(iddano,ng)) THEN
429 DO k=1,n(ng)
430 DO j=jstrr,jendr
431 DO i=istrr,iendr
432 average(ng)%avgrho(i,j,k)=ocean(ng)%rho(i,j,k)
433# ifdef WET_DRY
434 average(ng)%avgrho(i,j,k)=average(ng)%avgrho(i,j,k)* &
435 & grid(ng)%rmask_full(i,j)
436# endif
437 END DO
438 END DO
439 END DO
440 END IF
441 DO it=1,nt(ng)
442 IF (aout(idtvar(it),ng)) THEN
443 DO k=1,n(ng)
444 DO j=jstrr,jendr
445 DO i=istrr,iendr
446 average(ng)%avgt(i,j,k,it)=ocean(ng)%t(i,j,k,nout,it)
447# ifdef WET_DRY
448 average(ng)%avgt(i,j,k,it)=average(ng)%avgt(i,j,k,it)*&
449 & grid(ng)%rmask_full(i,j)
450# endif
451 END DO
452 END DO
453 END DO
454 END IF
455 END DO
456
457# if defined SEDIMENT && defined BEDLOAD
458 DO it=1,nst
459 IF (aout(idubld(it),ng)) THEN
460 DO j=jstrr,jendr
461 DO i=istr,iendr
462 sedbed(ng)%avgbedldu(i,j,it)=sedbed(ng)%bedldu(i,j,it)
463# ifdef WET_DRY
464 sedbed(ng)%avgbedldu(i,j,it)=sedbed(ng)%bedldu(i,j,it)* &
465 & grid(ng)%umask_full(i,j)
466# endif
467 END DO
468 END DO
469 END IF
470
471 IF (aout(idvbld(it),ng)) THEN
472 DO j=jstr,jendr
473 DO i=istrr,iendr
474 sedbed(ng)%avgbedldv(i,j,it)=sedbed(ng)%bedldv(i,j,it)
475# ifdef WET_DRY
476 sedbed(ng)%avgbedldv(i,j,it)=sedbed(ng)%bedldv(i,j,it)* &
477 & grid(ng)%vmask_full(i,j)
478# endif
479 END DO
480 END DO
481 END IF
482 END DO
483# endif
484
485# if defined LMD_MIXING || defined MY25_MIXING || defined GLS_MIXING
486 IF (aout(idvvis,ng)) THEN
487 DO k=0,n(ng)
488 DO j=jstrr,jendr
489 DO i=istrr,iendr
490 average(ng)%avgAKv(i,j,k)=mixing(ng)%Akv(i,j,k)
491# ifdef WET_DRY
492 average(ng)%avgAKv(i,j,k)=average(ng)%avgAKv(i,j,k)* &
493 & grid(ng)%rmask_full(i,j)
494# endif
495 END DO
496 END DO
497 END DO
498 END IF
499 IF (aout(idtdif,ng)) THEN
500 DO k=0,n(ng)
501 DO j=jstrr,jendr
502 DO i=istrr,iendr
503 average(ng)%avgAKt(i,j,k)=mixing(ng)%Akt(i,j,k,itemp)
504# ifdef WET_DRY
505 average(ng)%avgAKt(i,j,k)=average(ng)%avgAKt(i,j,k)* &
506 & grid(ng)%rmask_full(i,j)
507# endif
508 END DO
509 END DO
510 END DO
511 END IF
512# ifdef SALINITY
513 IF (aout(idsdif,ng)) THEN
514 DO k=0,n(ng)
515 DO j=jstrr,jendr
516 DO i=istrr,iendr
517 average(ng)%avgAKs(i,j,k)=mixing(ng)%Akt(i,j,k,isalt)
518# ifdef WET_DRY
519 average(ng)%avgAKs(i,j,k)=average(ng)%avgAKs(i,j,k)* &
520 & grid(ng)%rmask_full(i,j)
521# endif
522 END DO
523 END DO
524 END DO
525 END IF
526# endif
527# endif
528# ifdef LMD_SKPP
529 IF (aout(idhsbl,ng)) THEN
530 DO j=jstrr,jendr
531 DO i=istrr,iendr
532 average(ng)%avghsbl(i,j)=mixing(ng)%hsbl(i,j)
533# ifdef WET_DRY
534 average(ng)%avghsbl(i,j)=average(ng)%avghsbl(i,j)* &
535 & grid(ng)%rmask_full(i,j)
536# endif
537 END DO
538 END DO
539 END IF
540# endif
541# ifdef LMD_BKPP
542 IF (aout(idhbbl,ng)) THEN
543 DO j=jstrr,jendr
544 DO i=istrr,iendr
545 average(ng)%avghbbl(i,j)=mixing(ng)%hbbl(i,j)
546# ifdef WET_DRY
547 average(ng)%avghbbl(i,j)=average(ng)%avghbbl(i,j)* &
548 & grid(ng)%rmask_full(i,j)
549# endif
550 END DO
551 END DO
552 END IF
553# endif
554# endif
555
556# if defined FORWARD_WRITE && defined SOLVE3D
557!
558! Initialize 2D/3D coupling terms.
559!
560 IF (aout(idufx1,ng)) THEN
561 DO j=jstrr,jendr
562 DO i=istr,iendr
563 average(ng)%avgDU_avg1(i,j)=coupling(ng)%DU_avg1(i,j)
564# ifdef WET_DRY
565 average(ng)%avgDU_avg1(i,j)=average(ng)%avgDU_avg1(i,j)* &
566 & grid(ng)%umask_full(i,j)
567# endif
568 END DO
569 END DO
570 END IF
571 IF (aout(idufx2,ng)) THEN
572 DO j=jstrr,jendr
573 DO i=istr,iendr
574 average(ng)%avgDU_avg2(i,j)=coupling(ng)%DU_avg2(i,j)
575# ifdef WET_DRY
576 average(ng)%avgDU_avg2(i,j)=average(ng)%avgDU_avg2(i,j)* &
577 & grid(ng)%umask_full(i,j)
578# endif
579 END DO
580 END DO
581 END IF
582
583 IF (aout(idvfx1,ng)) THEN
584 DO j=jstr,jendr
585 DO i=istrr,iendr
586 average(ng)%avgDV_avg1(i,j)=coupling(ng)%DV_avg1(i,j)
587# ifdef WET_DRY
588 average(ng)%avgDV_avg1(i,j)=average(ng)%avgDV_avg1(i,j)* &
589 & grid(ng)%vmask_full(i,j)
590# endif
591 END DO
592 END DO
593 END IF
594 IF (aout(idvfx2,ng)) THEN
595 DO j=jstr,jendr
596 DO i=istrr,iendr
597 average(ng)%avgDV_avg2(i,j)=coupling(ng)%DV_avg2(i,j)
598# ifdef WET_DRY
599 average(ng)%avgDV_avg2(i,j)=average(ng)%avgDV_avg2(i,j)* &
600 & grid(ng)%vmask_full(i,j)
601# endif
602 END DO
603 END DO
604 END IF
605# endif
606!
607! Initialize surface and bottom fluxes.
608!
609 IF (aout(idusms,ng)) THEN
610 DO j=jstrr,jendr
611 DO i=istr,iendr
612 average(ng)%avgsus(i,j)=forces(ng)%sustr(i,j)
613# ifdef WET_DRY
614 average(ng)%avgsus(i,j)=average(ng)%avgsus(i,j)* &
615 & grid(ng)%umask_full(i,j)
616# endif
617 END DO
618 END DO
619 END IF
620 IF (aout(idvsms,ng)) THEN
621 DO j=jstr,jendr
622 DO i=istrr,iendr
623 average(ng)%avgsvs(i,j)=forces(ng)%svstr(i,j)
624# ifdef WET_DRY
625 average(ng)%avgsvs(i,j)=average(ng)%avgsvs(i,j)* &
626 & grid(ng)%vmask_full(i,j)
627# endif
628 END DO
629 END DO
630 END IF
631
632 IF (aout(idubms,ng)) THEN
633 DO j=jstrr,jendr
634 DO i=istr,iendr
635 average(ng)%avgbus(i,j)=forces(ng)%bustr(i,j)
636# ifdef WET_DRY
637 average(ng)%avgbus(i,j)=average(ng)%avgbus(i,j)* &
638 & grid(ng)%umask_full(i,j)
639# endif
640 END DO
641 END DO
642 END IF
643 IF (aout(idvbms,ng)) THEN
644 DO j=jstr,jendr
645 DO i=istrr,iendr
646 average(ng)%avgbvs(i,j)=forces(ng)%bvstr(i,j)
647# ifdef WET_DRY
648 average(ng)%avgbvs(i,j)=average(ng)%avgbvs(i,j)* &
649 & grid(ng)%vmask_full(i,j)
650# endif
651 END DO
652 END DO
653 END IF
654# ifdef BBL_MODEL
655 IF (aout(idubrs,ng)) THEN
656 DO j=jstrr,jendr
657 DO i=istr,iendr
658 average(ng)%avgUbrs(i,j)=bbl(ng)%bustrc(i,j)
659# ifdef WET_DRY
660 average(ng)%avgUbrs(i,j)=average(ng)%avgUbrs(i,j)* &
661 & grid(ng)%umask_full(i,j)
662# endif
663 END DO
664 END DO
665 END IF
666 IF (aout(idvbrs,ng)) THEN
667 DO j=jstrr,jendr
668 DO i=istr,iendr
669 average(ng)%avgVbrs(i,j)=bbl(ng)%bvstrc(i,j)
670# ifdef WET_DRY
671 average(ng)%avgVbrs(i,j)=average(ng)%avgVbrs(i,j)* &
672 & grid(ng)%umask_full(i,j)
673# endif
674 END DO
675 END DO
676 END IF
677 IF (aout(idubws,ng)) THEN
678 DO j=jstrr,jendr
679 DO i=istr,iendr
680 average(ng)%avgUbws(i,j)=bbl(ng)%bustrw(i,j)
681# ifdef WET_DRY
682 average(ng)%avgUbws(i,j)=average(ng)%avgUbws(i,j)* &
683 & grid(ng)%umask_full(i,j)
684# endif
685 END DO
686 END DO
687 END IF
688 IF (aout(idvbws,ng)) THEN
689 DO j=jstrr,jendr
690 DO i=istr,iendr
691 average(ng)%avgVbws(i,j)=bbl(ng)%bvstrw(i,j)
692# ifdef WET_DRY
693 average(ng)%avgVbws(i,j)=average(ng)%avgVbws(i,j)* &
694 & grid(ng)%umask_full(i,j)
695# endif
696 END DO
697 END DO
698 END IF
699 IF (aout(idubcs,ng)) THEN
700 DO j=jstrr,jendr
701 DO i=istr,iendr
702 average(ng)%avgUbcs(i,j)=bbl(ng)%bustrcwmax(i,j)
703# ifdef WET_DRY
704 average(ng)%avgUbcs(i,j)=average(ng)%avgUbcs(i,j)* &
705 & grid(ng)%umask_full(i,j)
706# endif
707 END DO
708 END DO
709 END IF
710 IF (aout(idvbcs,ng)) THEN
711 DO j=jstrr,jendr
712 DO i=istr,iendr
713 average(ng)%avgVbcs(i,j)=bbl(ng)%bvstrcwmax(i,j)
714# ifdef WET_DRY
715 average(ng)%avgVbcs(i,j)=average(ng)%avgVbcs(i,j)* &
716 & grid(ng)%umask_full(i,j)
717# endif
718 END DO
719 END DO
720 END IF
721 IF (aout(iduvwc,ng)) THEN
722 allocate (wrk(lbi:ubi,lbj:ubj))
723 wrk(lbi:ubi,lbj:ubj)=0.0_r8
724 wrk=sqrt(bbl(ng)%bustrcwmax*bbl(ng)%bustrcwmax+ &
725 & bbl(ng)%bvstrcwmax*bbl(ng)%bvstrcwmax+1.0e-10_r8)
726 DO j=jstrr,jendr
727 DO i=istr,iendr
728 average(ng)%avgUVwc(i,j)=wrk(i,j)
729# ifdef WET_DRY
730 average(ng)%avgUVwc(i,j)=average(ng)%avgUVwc(i,j)* &
731 & grid(ng)%umask_full(i,j)
732# endif
733 END DO
734 END DO
735 deallocate(wrk)
736 END IF
737 IF (aout(idubot,ng)) THEN
738 DO j=jstrr,jendr
739 DO i=istr,iendr
740 average(ng)%avgUbot(i,j)=bbl(ng)%Ubot(i,j)
741# ifdef WET_DRY
742 average(ng)%avgUbot(i,j)=average(ng)%avgUbot(i,j)* &
743 & grid(ng)%umask_full(i,j)
744# endif
745 END DO
746 END DO
747 END IF
748 IF (aout(idvbot,ng)) THEN
749 DO j=jstrr,jendr
750 DO i=istr,iendr
751 average(ng)%avgVbot(i,j)=bbl(ng)%Vbot(i,j)
752# ifdef WET_DRY
753 average(ng)%avgVbot(i,j)=average(ng)%avgVbot(i,j)* &
754 & grid(ng)%umask_full(i,j)
755# endif
756 END DO
757 END DO
758 END IF
759 IF (aout(idubur,ng)) THEN
760 DO j=jstrr,jendr
761 DO i=istr,iendr
762 average(ng)%avgUbur(i,j)=bbl(ng)%Ur(i,j)
763# ifdef WET_DRY
764 average(ng)%avgUbur(i,j)=average(ng)%avgUbur(i,j)* &
765 & grid(ng)%umask_full(i,j)
766# endif
767 END DO
768 END DO
769 END IF
770 IF (aout(idvbvr,ng)) THEN
771 DO j=jstrr,jendr
772 DO i=istr,iendr
773 average(ng)%avgVbvr(i,j)=bbl(ng)%Vr(i,j)
774# ifdef WET_DRY
775 average(ng)%avgVbvr(i,j)=average(ng)%avgVbvr(i,j)* &
776 & grid(ng)%umask_full(i,j)
777# endif
778 END DO
779 END DO
780 END IF
781# endif
782# ifdef SOLVE3D
783# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
784 IF (aout(idpair,ng)) THEN
785 DO j=jstrr,jendr
786 DO i=istrr,iendr
787 average(ng)%avgPair(i,j)=forces(ng)%Pair(i,j)
788# ifdef WET_DRY
789 average(ng)%avgPair(i,j)=average(ng)%avgPair(i,j)* &
790 & grid(ng)%rmask_full(i,j)
791# endif
792 END DO
793 END DO
794 END IF
795# endif
796# if defined BULK_FLUXES
797 IF (aout(idtair,ng)) THEN
798 DO j=jstrr,jendr
799 DO i=istrr,iendr
800 average(ng)%avgTair(i,j)=forces(ng)%Tair(i,j)
801# ifdef WET_DRY
802 average(ng)%avgTair(i,j)=average(ng)%avgTair(i,j)* &
803 & grid(ng)%rmask_full(i,j)
804# endif
805 END DO
806 END DO
807 END IF
808# endif
809# if defined BULK_FLUXES || defined ECOSIM
810 IF (aout(iduair,ng)) THEN
811 DO j=jstrr,jendr
812 DO i=istrr,iendr
813 average(ng)%avgUwind(i,j)=forces(ng)%Uwind(i,j)
814# ifdef WET_DRY
815 average(ng)%avgUwind(i,j)=average(ng)%avgUwind(i,j)* &
816 & grid(ng)%rmask_full(i,j)
817# endif
818 END DO
819 END DO
820 END IF
821
822 IF (aout(idvair,ng)) THEN
823 DO j=jstrr,jendr
824 DO i=istrr,iendr
825 average(ng)%avgVwind(i,j)=forces(ng)%Vwind(i,j)
826# ifdef WET_DRY
827 average(ng)%avgVwind(i,j)=average(ng)%avgVwind(i,j)* &
828 & grid(ng)%rmask_full(i,j)
829# endif
830 END DO
831 END DO
832 END IF
833
834 IF (aout(iduaie,ng).and.aout(idvain,ng)) THEN
835 CALL uv_rotate2d (ng, tile, .false., .false., &
836 & lbi, ubi, lbj, ubj, &
837 & grid(ng) % CosAngler, &
838 & grid(ng) % SinAngler, &
839# ifdef MASKING
840 & grid(ng)%rmask_full, &
841# endif
842 & forces(ng) % Uwind, &
843 & forces(ng) % Vwind, &
844 & average(ng)%avgUwindE, &
845 & average(ng)%avgVwindN)
846 END IF
847# endif
848
849 IF (aout(idtsur(itemp),ng)) THEN
850 DO j=jstrr,jendr
851 DO i=istrr,iendr
852 average(ng)%avgstf(i,j)=forces(ng)%stflx(i,j,itemp)
853# ifdef WET_DRY
854 average(ng)%avgstf(i,j)=average(ng)%avgstf(i,j)* &
855 & grid(ng)%rmask_full(i,j)
856# endif
857 END DO
858 END DO
859 END IF
860# ifdef SALINITY
861 IF (aout(idtsur(isalt),ng)) THEN
862 DO j=jstrr,jendr
863 DO i=istrr,iendr
864 average(ng)%avgswf(i,j)=forces(ng)%stflx(i,j,isalt)
865# ifdef WET_DRY
866 average(ng)%avgswf(i,j)=average(ng)%avgswf(i,j)* &
867 & grid(ng)%rmask_full(i,j)
868# endif
869 END DO
870 END DO
871 END IF
872# endif
873# ifdef SHORTWAVE
874 IF (aout(idsrad,ng)) THEN
875 DO j=jstrr,jendr
876 DO i=istrr,iendr
877 average(ng)%avgsrf(i,j)=forces(ng)%srflx(i,j)
878# ifdef WET_DRY
879 average(ng)%avgsrf(i,j)=average(ng)%avgsrf(i,j)* &
880 & grid(ng)%rmask_full(i,j)
881# endif
882 END DO
883 END DO
884 END IF
885# endif
886
887# if defined BULK_FLUXES || defined FRC_COUPLING
888 IF (aout(idlhea,ng)) THEN
889 DO j=jstrr,jendr
890 DO i=istrr,iendr
891 average(ng)%avglhf(i,j)=forces(ng)%lhflx(i,j)
892# ifdef WET_DRY
893 average(ng)%avglhf(i,j)=average(ng)%avglhf(i,j)* &
894 & grid(ng)%rmask_full(i,j)
895# endif
896 END DO
897 END DO
898 END IF
899
900 IF (aout(idlrad,ng)) THEN
901 DO j=jstrr,jendr
902 DO i=istrr,iendr
903 average(ng)%avglrf(i,j)=forces(ng)%lrflx(i,j)
904# ifdef WET_DRY
905 average(ng)%avglrf(i,j)=average(ng)%avglrf(i,j)* &
906 & grid(ng)%rmask_full(i,j)
907# endif
908 END DO
909 END DO
910 END IF
911
912 IF (aout(idshea,ng)) THEN
913 DO j=jstrr,jendr
914 DO i=istrr,iendr
915 average(ng)%avgshf(i,j)=forces(ng)%shflx(i,j)
916# ifdef WET_DRY
917 average(ng)%avgshf(i,j)=average(ng)%avgshf(i,j)* &
918 & grid(ng)%rmask_full(i,j)
919# endif
920 END DO
921 END DO
922 END IF
923# endif
924
925# if defined BULK_FLUXES && defined EMINUSP
926 IF (aout(idevap,ng)) THEN
927 DO j=jstrr,jendr
928 DO i=istrr,iendr
929 average(ng)%avgevap(i,j)=forces(ng)%evap(i,j)
930# ifdef WET_DRY
931 average(ng)%avgevap(i,j)=average(ng)%avgevap(i,j)* &
932 & grid(ng)%rmask_full(i,j)
933# endif
934 END DO
935 END DO
936 END IF
937
938 IF (aout(idrain,ng)) THEN
939 DO j=jstrr,jendr
940 DO i=istrr,iendr
941 average(ng)%avgrain(i,j)=forces(ng)%rain(i,j)
942# ifdef WET_DRY
943 average(ng)%avgrain(i,j)=average(ng)%avgrain(i,j)* &
944 & grid(ng)%rmask_full(i,j)
945# endif
946 END DO
947 END DO
948 END IF
949# endif
950# endif
951# ifdef WEC
952!
953! Initialize Waves Effect on Currents fields.
954!
955 IF (aout(idu2sd,ng)) THEN
956 DO j=jstrr,jendr
957 DO i=istr,iendr
958 average(ng)%avgu2Sd(i,j)=ocean(ng)%ubar_stokes(i,j)
959# ifdef WET_DRY
960 average(ng)%avgu2Sd(i,j)=average(ng)%avgu2Sd(i,j)* &
961 & grid(ng)%umask_full(i,j)
962# endif
963 END DO
964 END DO
965 END IF
966 IF (aout(idv2sd,ng)) THEN
967 DO j=jstr,jendr
968 DO i=istrr,iendr
969 average(ng)%avgv2Sd(i,j)=ocean(ng)%vbar_stokes(i,j)
970# ifdef WET_DRY
971 average(ng)%avgv2Sd(i,j)=average(ng)%avgv2Sd(i,j)* &
972 & grid(ng)%vmask_full(i,j)
973# endif
974 END DO
975 END DO
976 END IF
977
978 IF (aout(idu2rs,ng)) THEN
979 DO j=jstrr,jendr
980 DO i=istr,iendr
981 average(ng)%avgu2rs(i,j)=mixing(ng)%rustr2d(i,j)
982# ifdef WET_DRY
983 average(ng)%avgu2rs(i,j)=average(ng)%avgu2rs(i,j)* &
984 & grid(ng)%umask_full(i,j)
985# endif
986 END DO
987 END DO
988 END IF
989 IF (aout(idv2rs,ng)) THEN
990 DO j=jstr,jendr
991 DO i=istrr,iendr
992 average(ng)%avgv2rs(i,j)=mixing(ng)%rvstr2d(i,j)
993# ifdef WET_DRY
994 average(ng)%avgv2rs(i,j)=average(ng)%avgv2rs(i,j)* &
995 & grid(ng)%vmask_full(i,j)
996# endif
997 END DO
998 END DO
999 END IF
1000# endif
1001# ifdef SOLVE3D
1002# ifdef WEC
1003 IF (aout(idu3sd,ng)) THEN
1004 DO k=1,n(ng)
1005 DO j=jstrr,jendr
1006 DO i=istr,iendr
1007 average(ng)%avgu3Sd(i,j,k)=ocean(ng)%u_stokes(i,j,k)
1008# ifdef WET_DRY
1009 average(ng)%avgu3Sd(i,j,k)=average(ng)%avgu3Sd(i,j,k)* &
1010 & grid(ng)%umask_full(i,j)
1011# endif
1012 END DO
1013 END DO
1014 END DO
1015 END IF
1016 IF (aout(idv3sd,ng)) THEN
1017 DO k=1,n(ng)
1018 DO j=jstr,jendr
1019 DO i=istrr,iendr
1020 average(ng)%avgv3Sd(i,j,k)=ocean(ng)%v_stokes(i,j,k)
1021# ifdef WET_DRY
1022 average(ng)%avgv3Sd(i,j,k)=average(ng)%avgv3Sd(i,j,k)* &
1023 & grid(ng)%vmask_full(i,j)
1024# endif
1025 END DO
1026 END DO
1027 END DO
1028 END IF
1029 IF (aout(idw3sd,ng)) THEN
1030 DO k=1,n(ng)
1031 DO j=jstr,jendr
1032 DO i=istrr,iendr
1033 average(ng)%avgw3Sd(i,j,k)=ocean(ng)%W_stokes(i,j,k)
1034# ifdef WET_DRY
1035 average(ng)%avgw3Sd(i,j,k)=average(ng)%avgw3Sd(i,j,k)* &
1036 & grid(ng)%vmask_full(i,j)
1037# endif
1038 END DO
1039 END DO
1040 END DO
1041 END IF
1042 IF (aout(idw3st,ng)) THEN
1043 DO k=1,n(ng)
1044 DO j=jstr,jendr
1045 DO i=istrr,iendr
1046 average(ng)%avgw3St(i,j,k)=ocean(ng)%wstvel(i,j,k)
1047# ifdef WET_DRY
1048 average(ng)%avgw3St(i,j,k)=average(ng)%avgw3St(i,j,k)* &
1049 & grid(ng)%vmask_full(i,j)
1050# endif
1051 END DO
1052 END DO
1053 END DO
1054 END IF
1055 IF (aout(idu3rs,ng)) THEN
1056 DO k=1,n(ng)
1057 DO j=jstrr,jendr
1058 DO i=istr,iendr
1059 average(ng)%avgu3rs(i,j,k)=mixing(ng)%rustr3d(i,j,k)
1060# ifdef WET_DRY
1061 average(ng)%avgu3rs(i,j,k)=average(ng)%avgu3rs(i,j,k)* &
1062 & grid(ng)%umask_full(i,j)
1063# endif
1064 END DO
1065 END DO
1066 END DO
1067 END IF
1068 IF (aout(idv3rs,ng)) THEN
1069 DO k=1,n(ng)
1070 DO j=jstr,jendr
1071 DO i=istrr,iendr
1072 average(ng)%avgv3rs(i,j,k)=mixing(ng)%rvstr3d(i,j,k)
1073# ifdef WET_DRY
1074 average(ng)%avgv3rs(i,j,k)=average(ng)%avgv3rs(i,j,k)* &
1075 & grid(ng)%vmask_full(i,j)
1076# endif
1077 END DO
1078 END DO
1079 END DO
1080 END IF
1081# endif
1082# ifdef WEC_VF
1083 IF (aout(idwztw,ng)) THEN
1084 DO j=jstrr,jendr
1085 DO i=istrr,iendr
1086 average(ng)%avgWztw(i,j)=ocean(ng)%zetaw(i,j)
1087# ifdef WET_DRY
1088 average(ng)%avgWztw(i,j)=average(ng)%avgWztw(i,j)* &
1089 & grid(ng)%rmask_full(i,j)
1090# endif
1091 END DO
1092 END DO
1093 END IF
1094 IF (aout(idwqsp,ng)) THEN
1095 DO j=jstrr,jendr
1096 DO i=istrr,iendr
1097 average(ng)%avgwqsp(i,j)=ocean(ng)%qsp(i,j)
1098# ifdef WET_DRY
1099 average(ng)%avgwqsp(i,j)=average(ng)%avgwqsp(i,j)* &
1100 & grid(ng)%rmask_full(i,j)
1101# endif
1102 END DO
1103 END DO
1104 END IF
1105 IF (aout(idwbeh,ng)) THEN
1106 DO j=jstrr,jendr
1107 DO i=istrr,iendr
1108 average(ng)%avgwbeh(i,j)=ocean(ng)%bh(i,j)
1109# ifdef WET_DRY
1110 average(ng)%avgwbeh(i,j)=average(ng)%avgwbeh(i,j)* &
1111 & grid(ng)%rmask_full(i,j)
1112# endif
1113 END DO
1114 END DO
1115 END IF
1116# endif
1117# endif
1118# ifdef WAVES_HEIGHT
1119 IF (aout(idwamp,ng)) THEN
1120 DO j=jstrr,jendr
1121 DO i=istrr,iendr
1122 average(ng)%avgWamp(i,j)=forces(ng)%Hwave(i,j)
1123# ifdef WET_DRY
1124 average(ng)%avgWamp(i,j)=average(ng)%avgWamp(i,j)* &
1125 & grid(ng)%rmask_full(i,j)
1126# endif
1127 END DO
1128 END DO
1129 END IF
1130 IF (aout(idwam2,ng)) THEN
1131 DO j=jstrr,jendr
1132 DO i=istrr,iendr
1133 average(ng)%avgWam2(i,j)=forces(ng)%Hwave(i,j)* &
1134 & forces(ng)%Hwave(i,j)
1135# ifdef WET_DRY
1136 average(ng)%avgWam2(i,j)=average(ng)%avgWam2(i,j)* &
1137 & grid(ng)%rmask_full(i,j)
1138# endif
1139 END DO
1140 END DO
1141 END IF
1142# endif
1143# ifdef WAVES_LENGTH
1144 IF (aout(idwlen,ng)) THEN
1145 DO j=jstrr,jendr
1146 DO i=istrr,iendr
1147 average(ng)%avgWlen(i,j)=forces(ng)%Lwave(i,j)
1148# ifdef WET_DRY
1149 average(ng)%avgWlen(i,j)=average(ng)%avgWlen(i,j)* &
1150 & grid(ng)%rmask_full(i,j)
1151# endif
1152 END DO
1153 END DO
1154 END IF
1155# endif
1156# ifdef WAVES_LENGTHP
1157 IF (aout(idwlep,ng)) THEN
1158 DO j=jstrr,jendr
1159 DO i=istrr,iendr
1160 average(ng)%avgWlep(i,j)=forces(ng)%Lwavep(i,j)
1161# ifdef WET_DRY
1162 average(ng)%avgWlep(i,j)=average(ng)%avgWlep(i,j)* &
1163 & grid(ng)%rmask_full(i,j)
1164# endif
1165 END DO
1166 END DO
1167 END IF
1168# endif
1169# ifdef WAVES_DIR
1170 IF (aout(idwdir,ng)) THEN
1171 DO j=jstrr,jendr
1172 DO i=istrr,iendr
1173 average(ng)%avgWdir(i,j)=forces(ng)%Dwave(i,j)
1174# ifdef WET_DRY
1175 average(ng)%avgWdir(i,j)=average(ng)%avgWdir(i,j)* &
1176 & grid(ng)%rmask_full(i,j)
1177# endif
1178 END DO
1179 END DO
1180 END IF
1181# endif
1182# ifdef WAVES_DIRP
1183 IF (aout(idwdip,ng)) THEN
1184 DO j=jstrr,jendr
1185 DO i=istrr,iendr
1186 average(ng)%avgWdip(i,j)=forces(ng)%Dwavep(i,j)
1187# ifdef WET_DRY
1188 average(ng)%avgWdip(i,j)=average(ng)%avgWdip(i,j)* &
1189 & grid(ng)%rmask_full(i,j)
1190# endif
1191 END DO
1192 END DO
1193 END IF
1194# endif
1195# ifdef WAVES_TOP_PERIOD
1196 IF (aout(idwptp,ng)) THEN
1197 DO j=jstrr,jendr
1198 DO i=istrr,iendr
1199 average(ng)%avgWptp(i,j)=forces(ng)%Pwave_top(i,j)
1200# ifdef WET_DRY
1201 average(ng)%avgWptp(i,j)=average(ng)%avgWptp(i,j)* &
1202 & grid(ng)%rmask_full(i,j)
1203# endif
1204 END DO
1205 END DO
1206 END IF
1207# endif
1208# ifdef WAVES_BOT_PERIOD
1209 IF (aout(idwpbt,ng)) THEN
1210 DO j=jstrr,jendr
1211 DO i=istrr,iendr
1212 average(ng)%avgWpbt(i,j)=forces(ng)%Pwave_bot(i,j)
1213# ifdef WET_DRY
1214 average(ng)%avgWpbt(i,j)=average(ng)%avgWpbt(i,j)* &
1215 & grid(ng)%rmask_full(i,j)
1216# endif
1217 END DO
1218 END DO
1219 END IF
1220# endif
1221# ifdef BBL_MODEL
1222 IF (aout(idworb,ng)) THEN
1223 DO j=jstrr,jendr
1224 DO i=istrr,iendr
1225 average(ng)%avgWorb(i,j)=forces(ng)%Uwave_rms(i,j)
1226# ifdef WET_DRY
1227 average(ng)%avgWorb(i,j)=average(ng)%avgWorb(i,j)* &
1228 & grid(ng)%rmask_full(i,j)
1229# endif
1230 END DO
1231 END DO
1232 END IF
1233# endif
1234# if defined WAV_COUPLING || (defined WEC_VF && defined BOTTOM_STREAMING)
1235 IF (aout(idwdif,ng)) THEN
1236 DO j=jstrr,jendr
1237 DO i=istrr,iendr
1238 average(ng)%avgWdif(i,j)=forces(ng)%Dissip_fric(i,j)
1239# ifdef WET_DRY
1240 average(ng)%avgWdif(i,j)=average(ng)%avgWdif(i,j)* &
1241 & grid(ng)%rmask_full(i,j)
1242# endif
1243 END DO
1244 END DO
1245 END IF
1246# endif
1247# if defined WAV_COUPLING || defined TKE_WAVEDISS || \
1248 defined wdiss_thorguza || defined wdiss_churthor
1249 IF (aout(idwdib,ng)) THEN
1250 DO j=jstrr,jendr
1251 DO i=istrr,iendr
1252 average(ng)%avgWdib(i,j)=forces(ng)%Dissip_break(i,j)
1253# ifdef WET_DRY
1254 average(ng)%avgWdib(i,j)=average(ng)%avgWdib(i,j)* &
1255 & grid(ng)%rmask_full(i,j)
1256# endif
1257 END DO
1258 END DO
1259 END IF
1260 IF (aout(idwdiw,ng)) THEN
1261 DO j=jstrr,jendr
1262 DO i=istrr,iendr
1263 average(ng)%avgWdiw(i,j)=forces(ng)%Dissip_wcap(i,j)
1264# ifdef WET_DRY
1265 average(ng)%avgWdiw(i,j)=average(ng)%avgWdiw(i,j)* &
1266 & grid(ng)%rmask_full(i,j)
1267# endif
1268 END DO
1269 END DO
1270 END IF
1271# endif
1272# ifdef ROLLER_SVENDSEN
1273 IF (aout(idwbrk,ng)) THEN
1274 DO j=jstrr,jendr
1275 DO i=istrr,iendr
1276 average(ng)%avgWbrk(i,j)=forces(ng)%Wave_break(i,j)
1277# ifdef WET_DRY
1278 average(ng)%avgWbrk(i,j)=average(ng)%avgWbrk(i,j)* &
1279 & grid(ng)%rmask_full(i,j)
1280# endif
1281 END DO
1282 END DO
1283 END IF
1284# endif
1285# ifdef WEC_ROLLER
1286 IF (aout(idwdis,ng)) THEN
1287 DO j=jstrr,jendr
1288 DO i=istrr,iendr
1289 average(ng)%avgWdis(i,j)=forces(ng)%Dissip_roller(i,j)
1290# ifdef WET_DRY
1291 average(ng)%avgWdis(i,j)=average(ng)%avgWdis(i,j)* &
1292 & grid(ng)%rmask_full(i,j)
1293# endif
1294 END DO
1295 END DO
1296 END IF
1297 IF (aout(idwrol,ng)) THEN
1298 DO j=jstrr,jendr
1299 DO i=istrr,iendr
1300 average(ng)%avgWrol(i,j)=forces(ng)%rollA(i,j)
1301# ifdef WET_DRY
1302 average(ng)%avgWrol(i,j)=average(ng)%avgWrol(i,j)* &
1303 & grid(ng)%rmask_full(i,j)
1304# endif
1305 END DO
1306 END DO
1307 END IF
1308# endif
1309# ifdef UV_KIRBY
1310 IF (aout(iduwav,ng)) THEN
1311 DO j=jstrr,jendr
1312 DO i=istrr,iendr
1313 average(ng)%avgUwav(i,j)=ocean(ng)%uWave(i,j)
1314# ifdef WET_DRY
1315 average(ng)%avgUwav(i,j)=average(ng)%avgUwav(i,j)* &
1316 & grid(ng)%rmask_full(i,j)
1317# endif
1318 END DO
1319 END DO
1320 END IF
1321 IF (aout(idvwav,ng)) THEN
1322 DO j=jstrr,jendr
1323 DO i=istrr,iendr
1324 average(ng)%avgVwav(i,j)=ocean(ng)%vWave(i,j)
1325# ifdef WET_DRY
1326 average(ng)%avgVwav(i,j)=average(ng)%avgVwav(i,j)* &
1327 & grid(ng)%rmask_full(i,j)
1328# endif
1329 END DO
1330 END DO
1331 END IF
1332# endif
1333!
1334! Initialize vorticity fields.
1335!
1336 IF (aout(id2dpv,ng)) THEN
1337 DO j=jstr,jend
1338 DO i=istr,iend
1339 average(ng)%avgpvor2d(i,j)=potvor_bar(i,j)
1340# ifdef WET_DRY
1341 average(ng)%avgpvor2d(i,j)=average(ng)%avgpvor2d(i,j)* &
1342 & grid(ng)%pmask_full(i,j)
1343# endif
1344 END DO
1345 END DO
1346 END IF
1347 IF (aout(id2drv,ng)) THEN
1348 DO j=jstr,jend
1349 DO i=istr,iend
1350 average(ng)%avgrvor2d(i,j)=relvor_bar(i,j)
1351# ifdef WET_DRY
1352 average(ng)%avgrvor2d(i,j)=average(ng)%avgrvor2d(i,j)* &
1353 & grid(ng)%pmask_full(i,j)
1354# endif
1355 END DO
1356 END DO
1357 END IF
1358# ifdef SOLVE3D
1359 IF (aout(id3dpv,ng)) THEN
1360 DO k=1,n(ng)
1361 DO j=jstr,jend
1362 DO i=istr,iend
1363 average(ng)%avgpvor3d(i,j,k)=potvor(i,j,k)
1364# ifdef WET_DRY
1365 average(ng)%avgpvor3d(i,j,k)=average(ng)%avgpvor3d(i,j, &
1366 & k)* &
1367 & grid(ng)%pmask_full(i,j)
1368# endif
1369 END DO
1370 END DO
1371 END DO
1372 END IF
1373 IF (aout(id3drv,ng)) THEN
1374 DO k=1,n(ng)
1375 DO j=jstr,jend
1376 DO i=istr,iend
1377 average(ng)%avgrvor3d(i,j,k)=relvor(i,j,k)
1378# ifdef WET_DRY
1379 average(ng)%avgrvor3d(i,j,k)=average(ng)%avgrvor3d(i,j, &
1380 & k)* &
1381 & grid(ng)%pmask_full(i,j)
1382# endif
1383 END DO
1384 END DO
1385 END DO
1386 END IF
1387# endif
1388!
1389! Initialize quadratic fields.
1390!
1391 IF (aout(idzzav,ng)) THEN
1392 DO j=jstrr,jendr
1393 DO i=istrr,iendr
1394 average(ng)%avgZZ(i,j)=ocean(ng)%zeta(i,j,kout)* &
1395 & ocean(ng)%zeta(i,j,kout)
1396# ifdef WET_DRY
1397 average(ng)%avgZZ(i,j)=average(ng)%avgZZ(i,j)* &
1398 & grid(ng)%rmask_full(i,j)
1399# endif
1400 END DO
1401 END DO
1402 END IF
1403 IF (aout(idu2av,ng)) THEN
1404 DO j=jstrr,jendr
1405 DO i=istr,iendr
1406 average(ng)%avgU2(i,j)=ocean(ng)%ubar(i,j,kout)* &
1407 & ocean(ng)%ubar(i,j,kout)
1408# ifdef WET_DRY
1409 average(ng)%avgU2(i,j)=average(ng)%avgU2(i,j)* &
1410 & grid(ng)%umask_full(i,j)
1411# endif
1412 END DO
1413 END DO
1414 END IF
1415 IF (aout(idv2av,ng)) THEN
1416 DO j=jstr,jendr
1417 DO i=istrr,iendr
1418 average(ng)%avgV2(i,j)=ocean(ng)%vbar(i,j,kout)* &
1419 & ocean(ng)%vbar(i,j,kout)
1420# ifdef WET_DRY
1421 average(ng)%avgV2(i,j)=average(ng)%avgV2(i,j)* &
1422 & grid(ng)%vmask_full(i,j)
1423# endif
1424 END DO
1425 END DO
1426 END IF
1427
1428# ifdef SOLVE3D
1429 IF (aout(iduuav,ng)) THEN
1430 DO k=1,n(ng)
1431 DO j=jstrr,jendr
1432 DO i=istr,iendr
1433 average(ng)%avgUU(i,j,k)=ocean(ng)%u(i,j,k,nout)* &
1434 & ocean(ng)%u(i,j,k,nout)
1435# ifdef WET_DRY
1436 average(ng)%avgUU(i,j,k)=average(ng)%avgUU(i,j,k)* &
1437 & grid(ng)%umask_full(i,j)
1438# endif
1439 END DO
1440 END DO
1441 END DO
1442 END IF
1443 IF (aout(idvvav,ng)) THEN
1444 DO k=1,n(ng)
1445 DO j=jstr,jendr
1446 DO i=istrr,iendr
1447 average(ng)%avgVV(i,j,k)=ocean(ng)%v(i,j,k,nout)* &
1448 & ocean(ng)%v(i,j,k,nout)
1449# ifdef WET_DRY
1450 average(ng)%avgVV(i,j,k)=average(ng)%avgVV(i,j,k)* &
1451 & grid(ng)%vmask_full(i,j)
1452# endif
1453 END DO
1454 END DO
1455 END DO
1456 END IF
1457 IF (aout(iduvav,ng)) THEN
1458 DO k=1,n(ng)
1459 DO j=jstr,jend
1460 DO i=istr,iend
1461 average(ng)%avgUV(i,j,k)=0.25_r8* &
1462 & (ocean(ng)%u(i ,j ,k,nout)+ &
1463 & ocean(ng)%u(i+1,j ,k,nout))* &
1464 & (ocean(ng)%v(i ,j ,k,nout)+ &
1465 & ocean(ng)%v(i ,j+1,k,nout))
1466# ifdef WET_DRY
1467 average(ng)%avgUV(i,j,k)=average(ng)%avgUV(i,j,k)* &
1468 & grid(ng)%rmask_full(i,j)
1469# endif
1470 END DO
1471 END DO
1472 END DO
1473 END IF
1474
1475 IF (aout(idhuav,ng)) THEN
1476 DO k=1,n(ng)
1477 DO j=jstrr,jendr
1478 DO i=istr,iendr
1479 average(ng)%avgHuon(i,j,k)=grid(ng)%Huon(i,j,k)
1480# ifdef WET_DRY
1481 average(ng)%avgHuon(i,j,k)=average(ng)%avgHuon(i,j,k)* &
1482 & grid(ng)%umask_full(i,j)
1483# endif
1484 END DO
1485 END DO
1486 END DO
1487 END IF
1488 IF (aout(idhvav,ng)) THEN
1489 DO k=1,n(ng)
1490 DO j=jstr,jendr
1491 DO i=istrr,iendr
1492 average(ng)%avgHvom(i,j,k)=grid(ng)%Hvom(i,j,k)
1493# ifdef WET_DRY
1494 average(ng)%avgHvom(i,j,k)=average(ng)%avgHvom(i,j,k)* &
1495 & grid(ng)%vmask_full(i,j)
1496# endif
1497 END DO
1498 END DO
1499 END DO
1500 END IF
1501
1502 DO it=1,nt(ng)
1503 IF (aout(idttav(it),ng)) THEN
1504 DO k=1,n(ng)
1505 DO j=jstrr,jendr
1506 DO i=istrr,iendr
1507 average(ng)%avgTT(i,j,k,it)=ocean(ng)%t(i,j,k, &
1508 & nout,it)* &
1509 & ocean(ng)%t(i,j,k, &
1510 & nout,it)
1511# ifdef WET_DRY
1512 average(ng)%avgTT(i,j,k,it)=average(ng)%avgTT(i,j,k, &
1513 & it)* &
1514 & grid(ng)%rmask_full(i,j)
1515# endif
1516 END DO
1517 END DO
1518 END DO
1519 END IF
1520 IF (aout(idutav(it),ng)) THEN
1521 DO k=1,n(ng)
1522 DO j=jstrr,jendr
1523 DO i=istr,iend
1524 average(ng)%avgUT(i,j,k,it)=0.5_r8* &
1525 & ocean(ng)%u(i,j,k,nout)* &
1526 & (ocean(ng)%t(i-1,j,k, &
1527 & nout,it)+ &
1528 & ocean(ng)%t(i ,j,k, &
1529 & nout,it))
1530# ifdef WET_DRY
1531 average(ng)%avgUT(i,j,k,it)=average(ng)%avgUT(i,j,k, &
1532 & it)* &
1533 & grid(ng)%umask_full(i,j)
1534# endif
1535 END DO
1536 END DO
1537 END DO
1538 END IF
1539 IF (aout(idvtav(it),ng)) THEN
1540 DO k=1,n(ng)
1541 DO j=jstr,jend
1542 DO i=istrr,iendr
1543 average(ng)%avgVT(i,j,k,it)=0.5_r8* &
1544 & ocean(ng)%v(i,j,k,nout)* &
1545 & (ocean(ng)%t(i,j-1,k, &
1546 & nout,it)+ &
1547 & ocean(ng)%t(i,j ,k, &
1548 & nout,it))
1549# ifdef WET_DRY
1550 average(ng)%avgVT(i,j,k,it)=average(ng)%avgVT(i,j,k, &
1551 & it)* &
1552 & grid(ng)%vmask_full(i,j)
1553# endif
1554 END DO
1555 END DO
1556 END DO
1557 END IF
1558
1559 IF (aout(ihutav(it),ng)) THEN
1560 DO k=1,n(ng)
1561 DO j=jstrr,jendr
1562 DO i=istr,iend
1563 average(ng)%avgHuonT(i,j,k,it)=0.5_r8* &
1564 & grid(ng)%Huon(i,j,k)* &
1565 & (ocean(ng)%t(i-1,j,k, &
1566 & nout,it)+ &
1567 & ocean(ng)%t(i ,j,k, &
1568 & nout,it))
1569# ifdef WET_DRY
1570 average(ng)%avgHuonT(i,j,k,it)=average(ng)%avgHuonT &
1571 & (i,j,k,it)* &
1572 & grid(ng)%umask_full(i, &
1573 & j)
1574# endif
1575 END DO
1576 END DO
1577 END DO
1578 END IF
1579 IF (aout(ihvtav(it),ng)) THEN
1580 DO k=1,n(ng)
1581 DO j=jstr,jend
1582 DO i=istrr,iendr
1583 average(ng)%avgHvomT(i,j,k,it)=0.5_r8* &
1584 & grid(ng)%Hvom(i,j,k)* &
1585 & (ocean(ng)%t(i,j-1,k, &
1586 & nout,it)+ &
1587 & ocean(ng)%t(i,j ,k, &
1588 & nout,it))
1589# ifdef WET_DRY
1590 average(ng)%avgHvomT(i,j,k,it)=average(ng)%avgHvomT &
1591 & (i,j,k,it)* &
1592 & grid(ng)%vmask_full(i, &
1593 & j)
1594# endif
1595 END DO
1596 END DO
1597 END DO
1598 END IF
1599 END DO
1600# endif
1601!
1602!-----------------------------------------------------------------------
1603! Accumulate time-averaged fields.
1604!-----------------------------------------------------------------------
1605!
1606 ELSE IF (iic(ng).gt.ntsavg(ng)) THEN
1607
1608# ifdef WET_DRY
1609!
1610! If wetting and drying, accumulate wet points counters.
1611! points. The time averaged field at each point is only accumulated
1612! over wet points since its multiplied by the appropriate mask.
1613!
1614 DO j=jstr,jendr
1615 DO i=istr,iendr
1616 grid(ng)%pmask_avg(i,j)=grid(ng)%pmask_avg(i,j)+ &
1617 & max(0.0_r8, &
1618 & min(grid(ng)%pmask_full(i,j), &
1619 & 1.0_r8))
1620 END DO
1621 END DO
1622 DO j=jstrr,jendr
1623 DO i=istrr,iendr
1624 grid(ng)%rmask_avg(i,j)=grid(ng)%rmask_avg(i,j)+ &
1625 & max(0.0_r8, &
1626 & min(grid(ng)%rmask_full(i,j), &
1627 & 1.0_r8))
1628 END DO
1629 END DO
1630 DO j=jstrr,jendr
1631 DO i=istr,iendr
1632 grid(ng)%umask_avg(i,j)=grid(ng)%umask_avg(i,j)+ &
1633 & max(0.0_r8, &
1634 & min(grid(ng)%umask_full(i,j), &
1635 & 1.0_r8))
1636 END DO
1637 END DO
1638 DO j=jstr,jendr
1639 DO i=istrr,iendr
1640 grid(ng)%vmask_avg(i,j)=grid(ng)%vmask_avg(i,j)+ &
1641 & max(0.0_r8, &
1642 & min(grid(ng)%vmask_full(i,j), &
1643 & 1.0_r8))
1644 END DO
1645 END DO
1646# endif
1647!
1648! Accumulate state variables.
1649!
1650 IF (aout(idfsur,ng)) THEN
1651 DO j=jstrr,jendr
1652 DO i=istrr,iendr
1653 average(ng)%avgzeta(i,j)=average(ng)%avgzeta(i,j)+ &
1654# ifdef WET_DRY
1655 & grid(ng)%rmask_full(i,j)* &
1656# endif
1657 & ocean(ng)%zeta(i,j,kout)
1658 END DO
1659 END DO
1660 END IF
1661
1662 IF (aout(idubar,ng)) THEN
1663 DO j=jstrr,jendr
1664 DO i=istr,iendr
1665 average(ng)%avgu2d(i,j)=average(ng)%avgu2d(i,j)+ &
1666# ifdef WET_DRY
1667 & grid(ng)%umask_full(i,j)* &
1668# endif
1669 & ocean(ng)%ubar(i,j,kout)
1670 END DO
1671 END DO
1672 END IF
1673 IF (aout(idvbar,ng)) THEN
1674 DO j=jstr,jendr
1675 DO i=istrr,iendr
1676 average(ng)%avgv2d(i,j)=average(ng)%avgv2d(i,j)+ &
1677# ifdef WET_DRY
1678 & grid(ng)%vmask_full(i,j)* &
1679# endif
1680 & ocean(ng)%vbar(i,j,kout)
1681 END DO
1682 END DO
1683 END IF
1684
1685 IF (aout(idu2de,ng).and.aout(idv2dn,ng)) THEN
1686 CALL uv_rotate2d (ng, tile, .true., .false., &
1687 & lbi, ubi, lbj, ubj, &
1688 & grid(ng) % CosAngler, &
1689 & grid(ng) % SinAngler, &
1690# ifdef MASKING
1691 & grid(ng)%rmask_full, &
1692# endif
1693 & ocean(ng) % ubar(:,:,kout), &
1694 & ocean(ng) % vbar(:,:,kout), &
1695 & average(ng)%avgu2dE, &
1696 & average(ng)%avgv2dN)
1697 END IF
1698
1699# ifdef SOLVE3D
1700 IF (aout(iduvel,ng)) THEN
1701 DO k=1,n(ng)
1702 DO j=jstrr,jendr
1703 DO i=istr,iendr
1704 average(ng)%avgu3d(i,j,k)=average(ng)%avgu3d(i,j,k)+ &
1705# ifdef WET_DRY
1706 & grid(ng)%umask_full(i,j)* &
1707# endif
1708 & ocean(ng)%u(i,j,k,nout)
1709 END DO
1710 END DO
1711 END DO
1712 END IF
1713 IF (aout(idvvel,ng)) THEN
1714 DO k=1,n(ng)
1715 DO j=jstr,jendr
1716 DO i=istrr,iendr
1717 average(ng)%avgv3d(i,j,k)=average(ng)%avgv3d(i,j,k)+ &
1718# ifdef WET_DRY
1719 & grid(ng)%vmask_full(i,j)* &
1720# endif
1721 & ocean(ng)%v(i,j,k,nout)
1722 END DO
1723 END DO
1724 END DO
1725 END IF
1726
1727 IF (aout(idu3de,ng)) THEN
1728 DO k=1,n(ng)
1729 DO j=jstrr,jendr
1730 DO i=istrr,iendr
1731 average(ng)%avgu3dE(i,j,k)=average(ng)%avgu3dE(i,j,k)+ &
1732# ifdef WET_DRY
1733 & grid(ng)%umask_full(i,j)* &
1734# endif
1735 & ocean(ng)%ua(i,j,k)
1736 END DO
1737 END DO
1738 END DO
1739 END IF
1740 IF (aout(idv3dn,ng)) THEN
1741 DO k=1,n(ng)
1742 DO j=jstrr,jendr
1743 DO i=istrr,iendr
1744 average(ng)%avgv3dN(i,j,k)=average(ng)%avgv3dN(i,j,k)+ &
1745# ifdef WET_DRY
1746 & grid(ng)%vmask_full(i,j)* &
1747# endif
1748 & ocean(ng)%va(i,j,k)
1749 END DO
1750 END DO
1751 END DO
1752 END IF
1753
1754 IF (aout(idovel,ng)) THEN
1755 DO k=0,n(ng)
1756 DO j=jstrr,jendr
1757 DO i=istrr,iendr
1758 average(ng)%avgw3d(i,j,k)=average(ng)%avgw3d(i,j,k)+ &
1759# ifdef WET_DRY
1760 & grid(ng)%rmask_full(i,j)* &
1761# endif
1762 & ocean(ng)%W(i,j,k)* &
1763 & grid(ng)%pm(i,j)* &
1764 & grid(ng)%pn(i,j)
1765 END DO
1766 END DO
1767 END DO
1768 END IF
1769 IF (aout(idwvel,ng)) THEN
1770 DO k=0,n(ng)
1771 DO j=jstrr,jendr
1772 DO i=istrr,iendr
1773 average(ng)%avgwvel(i,j,k)=average(ng)%avgwvel(i,j,k)+ &
1774# ifdef WET_DRY
1775 & grid(ng)%rmask_full(i,j)* &
1776# endif
1777 & ocean(ng)%wvel(i,j,k)
1778 END DO
1779 END DO
1780 END DO
1781 END IF
1782
1783 IF (aout(iddano,ng)) THEN
1784 DO k=1,n(ng)
1785 DO j=jstrr,jendr
1786 DO i=istrr,iendr
1787 average(ng)%avgrho(i,j,k)=average(ng)%avgrho(i,j,k)+ &
1788# ifdef WET_DRY
1789 & grid(ng)%rmask_full(i,j)* &
1790# endif
1791 & ocean(ng)%rho(i,j,k)
1792 END DO
1793 END DO
1794 END DO
1795 END IF
1796 DO it=1,nt(ng)
1797 IF (aout(idtvar(it),ng)) THEN
1798 DO k=1,n(ng)
1799 DO j=jstrr,jendr
1800 DO i=istrr,iendr
1801 average(ng)%avgt(i,j,k,it)=average(ng)%avgt(i,j,k,it)+&
1802# ifdef WET_DRY
1803 & grid(ng)%rmask_full(i,j)* &
1804# endif
1805 & ocean(ng)%t(i,j,k,nout,it)
1806 END DO
1807 END DO
1808 END DO
1809 END IF
1810 END DO
1811
1812# if defined SEDIMENT && defined BEDLOAD
1813 DO it=1,nst
1814 IF (aout(idubld(it),ng)) THEN
1815 DO j=jstrr,jendr
1816 DO i=istr,iendr
1817 sedbed(ng)%avgbedldu(i,j,it)=sedbed(ng)%avgbedldu(i,j, &
1818 & it)+ &
1819# ifdef WET_DRY
1820 & grid(ng)%umask_full(i,j)* &
1821# endif
1822 & sedbed(ng)%bedldu(i,j,it)
1823 END DO
1824 END DO
1825 END IF
1826
1827 IF (aout(idvbld(it),ng)) THEN
1828 DO j=jstr,jendr
1829 DO i=istrr,iendr
1830 sedbed(ng)%avgbedldv(i,j,it)=sedbed(ng)%avgbedldv(i,j, &
1831 & it)+ &
1832# ifdef WET_DRY
1833 & grid(ng)%vmask_full(i,j)* &
1834# endif
1835 & sedbed(ng)%bedldv(i,j,it)
1836 END DO
1837 END DO
1838 END IF
1839 END DO
1840# endif
1841
1842# if defined LMD_MIXING || defined MY25_MIXING || defined GLS_MIXING
1843 IF (aout(idvvis,ng)) THEN
1844 DO k=0,n(ng)
1845 DO j=jstrr,jendr
1846 DO i=istrr,iendr
1847 average(ng)%avgAKv(i,j,k)=average(ng)%avgAKv(i,j,k)+ &
1848# ifdef WET_DRY
1849 & grid(ng)%rmask_full(i,j)* &
1850# endif
1851 & mixing(ng)%Akv(i,j,k)
1852 END DO
1853 END DO
1854 END DO
1855 END IF
1856 IF (aout(idtdif,ng)) THEN
1857 DO k=0,n(ng)
1858 DO j=jstrr,jendr
1859 DO i=istrr,iendr
1860 average(ng)%avgAKt(i,j,k)=average(ng)%avgAKt(i,j,k)+ &
1861# ifdef WET_DRY
1862 & grid(ng)%rmask_full(i,j)* &
1863# endif
1864 & mixing(ng)%Akt(i,j,k,itemp)
1865 END DO
1866 END DO
1867 END DO
1868 END IF
1869# ifdef SALINITY
1870 IF (aout(idsdif,ng)) THEN
1871 DO k=0,n(ng)
1872 DO j=jstrr,jendr
1873 DO i=istrr,iendr
1874 average(ng)%avgAKs(i,j,k)=average(ng)%avgAKs(i,j,k)+ &
1875# ifdef WET_DRY
1876 & grid(ng)%rmask_full(i,j)* &
1877# endif
1878 & mixing(ng)%Akt(i,j,k,isalt)
1879 END DO
1880 END DO
1881 END DO
1882 END IF
1883# endif
1884# endif
1885# ifdef LMD_SKPP
1886 IF (aout(idhsbl,ng)) THEN
1887 DO j=jstrr,jendr
1888 DO i=istrr,iendr
1889 average(ng)%avghsbl(i,j)=average(ng)%avghsbl(i,j)+ &
1890# ifdef WET_DRY
1891 & grid(ng)%rmask_full(i,j)* &
1892# endif
1893 & mixing(ng)%hsbl(i,j)
1894 END DO
1895 END DO
1896 END IF
1897# endif
1898# ifdef LMD_BKPP
1899 IF (aout(idhbbl,ng)) THEN
1900 DO j=jstrr,jendr
1901 DO i=istrr,iendr
1902 average(ng)%avghbbl(i,j)=average(ng)%avghbbl(i,j)+ &
1903# ifdef WET_DRY
1904 & grid(ng)%rmask_full(i,j)* &
1905# endif
1906 & mixing(ng)%hbbl(i,j)
1907 END DO
1908 END DO
1909 END IF
1910# endif
1911# endif
1912
1913# if defined FORWARD_WRITE && defined SOLVE3D
1914!
1915! Accumulate 2D/3D coupling terms.
1916!
1917 IF (aout(idufx1,ng)) THEN
1918 DO j=jstrr,jendr
1919 DO i=istr,iendr
1920 average(ng)%avgDU_avg1(i,j)=average(ng)%avgDU_avg1(i,j)+ &
1921# ifdef WET_DRY
1922 & grid(ng)%umask_full(i,j)* &
1923# endif
1924 & coupling(ng)%DU_avg1(i,j)
1925 END DO
1926 END DO
1927 END IF
1928 IF (aout(idufx2,ng)) THEN
1929 DO j=jstrr,jendr
1930 DO i=istr,iendr
1931 average(ng)%avgDU_avg2(i,j)=average(ng)%avgDU_avg2(i,j)+ &
1932# ifdef WET_DRY
1933 & grid(ng)%umask_full(i,j)* &
1934# endif
1935 & coupling(ng)%DU_avg2(i,j)
1936 END DO
1937 END DO
1938 END IF
1939
1940 IF (aout(idvfx1,ng)) THEN
1941 DO j=jstr,jendr
1942 DO i=istrr,iendr
1943 average(ng)%avgDV_avg1(i,j)=average(ng)%avgDV_avg1(i,j)+ &
1944# ifdef WET_DRY
1945 & grid(ng)%vmask_full(i,j)* &
1946# endif
1947 & coupling(ng)%DV_avg1(i,j)
1948 END DO
1949 END DO
1950 END IF
1951 IF (aout(idvfx2,ng)) THEN
1952 DO j=jstr,jendr
1953 DO i=istrr,iendr
1954 average(ng)%avgDV_avg2(i,j)=average(ng)%avgDV_avg2(i,j)+ &
1955# ifdef WET_DRY
1956 & grid(ng)%vmask_full(i,j)* &
1957# endif
1958 & coupling(ng)%DV_avg2(i,j)
1959 END DO
1960 END DO
1961 END IF
1962# endif
1963!
1964! Accumulate surface and bottom fluxes.
1965!
1966 IF (aout(idusms,ng)) THEN
1967 DO j=jstrr,jendr
1968 DO i=istr,iendr
1969 average(ng)%avgsus(i,j)=average(ng)%avgsus(i,j)+ &
1970# ifdef WET_DRY
1971 & grid(ng)%umask_full(i,j)* &
1972# endif
1973 & forces(ng)%sustr(i,j)
1974 END DO
1975 END DO
1976 END IF
1977 IF (aout(idvsms,ng)) THEN
1978 DO j=jstr,jendr
1979 DO i=istrr,iendr
1980 average(ng)%avgsvs(i,j)=average(ng)%avgsvs(i,j)+ &
1981# ifdef WET_DRY
1982 & grid(ng)%vmask_full(i,j)* &
1983# endif
1984 & forces(ng)%svstr(i,j)
1985 END DO
1986 END DO
1987 END IF
1988
1989 IF (aout(idubms,ng)) THEN
1990 DO j=jstrr,jendr
1991 DO i=istr,iendr
1992 average(ng)%avgbus(i,j)=average(ng)%avgbus(i,j)+ &
1993# ifdef WET_DRY
1994 & grid(ng)%umask_full(i,j)* &
1995# endif
1996 & forces(ng)%bustr(i,j)
1997 END DO
1998 END DO
1999 END IF
2000 IF (aout(idvbms,ng)) THEN
2001 DO j=jstr,jendr
2002 DO i=istrr,iendr
2003 average(ng)%avgbvs(i,j)=average(ng)%avgbvs(i,j)+ &
2004# ifdef WET_DRY
2005 & grid(ng)%vmask_full(i,j)* &
2006# endif
2007 & forces(ng)%bvstr(i,j)
2008 END DO
2009 END DO
2010 END IF
2011# ifdef BBL
2012 IF (aout(idubrs,ng)) THEN
2013 DO j=jstrr,jendr
2014 DO i=istrr,iendr
2015 average(ng)%avgUbrs(i,j)=average(ng)%avgUbrs(i,j)+ &
2016# ifdef WET_DRY
2017 & grid(ng)%rmask_full(i,j)* &
2018# endif
2019 & forces(ng)%bustrc(i,j)
2020 END DO
2021 END DO
2022 END IF
2023 IF (aout(idvbrs,ng)) THEN
2024 DO j=jstrr,jendr
2025 DO i=istrr,iendr
2026 average(ng)%avgVbrs(i,j)=average(ng)%avgVbrs(i,j)+ &
2027# ifdef WET_DRY
2028 & grid(ng)%rmask_full(i,j)* &
2029# endif
2030 & forces(ng)%bvstrc(i,j)
2031 END DO
2032 END DO
2033 END IF
2034 IF (aout(idubws,ng)) THEN
2035 DO j=jstrr,jendr
2036 DO i=istrr,iendr
2037 average(ng)%avgUbws(i,j)=average(ng)%avgUbws(i,j)+ &
2038# ifdef WET_DRY
2039 & grid(ng)%rmask_full(i,j)* &
2040# endif
2041 & forces(ng)%bustrw(i,j)
2042 END DO
2043 END DO
2044 END IF
2045 IF (aout(idvbws,ng)) THEN
2046 DO j=jstrr,jendr
2047 DO i=istrr,iendr
2048 average(ng)%avgVbws(i,j)=average(ng)%avgVbws(i,j)+ &
2049# ifdef WET_DRY
2050 & grid(ng)%rmask_full(i,j)* &
2051# endif
2052 & forces(ng)%bvstrw(i,j)
2053 END DO
2054 END DO
2055 END IF
2056 IF (aout(idubcs,ng)) THEN
2057 DO j=jstrr,jendr
2058 DO i=istrr,iendr
2059 average(ng)%avgUbcs(i,j)=average(ng)%avgUbcs(i,j)+ &
2060# ifdef WET_DRY
2061 & grid(ng)%rmask_full(i,j)* &
2062# endif
2063 & forces(ng)%bustrcwmax(i,j)
2064 END DO
2065 END DO
2066 END IF
2067 IF (aout(idvbcs,ng)) THEN
2068 DO j=jstrr,jendr
2069 DO i=istrr,iendr
2070 average(ng)%avgVbcs(i,j)=average(ng)%avgVbcs(i,j)+ &
2071# ifdef WET_DRY
2072 & grid(ng)%rmask_full(i,j)* &
2073# endif
2074 & forces(ng)%bvstrcwmax(i,j)
2075 END DO
2076 END DO
2077 END IF
2078 IF (aout(iduvwc,ng)) THEN
2079 allocate (wrk(lbi:ubi,lbj:ubj))
2080 wrk(lbi:ubi,lbj:ubj)=0.0_r8
2081 wrk=sqrt(bbl(ng)%bustrcwmax*bbl(ng)%bustrcwmax+ &
2082 & bbl(ng)%bvstrcwmax*bbl(ng)%bvstrcwmax+1.0e-10_r8)
2083 DO j=jstrr,jendr
2084 DO i=istrr,iendr
2085 average(ng)%avgUVwc(i,j)=average(ng)%avgUVwc(i,j)+ &
2086# ifdef WET_DRY
2087 & grid(ng)%rmask_full(i,j)* &
2088# endif
2089 & wrk(i,j)
2090 END DO
2091 END DO
2092 deallocate(wrk)
2093 END IF
2094 IF (aout(idubot,ng)) THEN
2095 DO j=jstrr,jendr
2096 DO i=istrr,iendr
2097 average(ng)%avgUbot(i,j)=average(ng)%avgUbot(i,j)+ &
2098# ifdef WET_DRY
2099 & grid(ng)%rmask_full(i,j)* &
2100# endif
2101 & bbl(ng)%Ubot(i,j)
2102 END DO
2103 END DO
2104 END IF
2105 IF (aout(idvbot,ng)) THEN
2106 DO j=jstrr,jendr
2107 DO i=istrr,iendr
2108 average(ng)%avgVbot(i,j)=average(ng)%avgVbot(i,j)+ &
2109# ifdef WET_DRY
2110 & grid(ng)%rmask_full(i,j)* &
2111# endif
2112 & bbl(ng)%Vbot(i,j)
2113 END DO
2114 END DO
2115 END IF
2116 IF (aout(idubur,ng)) THEN
2117 DO j=jstrr,jendr
2118 DO i=istrr,iendr
2119 average(ng)%avgUbur(i,j)=average(ng)%avgUbur(i,j)+ &
2120# ifdef WET_DRY
2121 & grid(ng)%rmask_full(i,j)* &
2122# endif
2123 & bbl(ng)%Ubur(i,j)
2124 END DO
2125 END DO
2126 END IF
2127 IF (aout(idvbvr,ng)) THEN
2128 DO j=jstrr,jendr
2129 DO i=istrr,iendr
2130 average(ng)%avgVbvr(i,j)=average(ng)%avgVbvr(i,j)+ &
2131# ifdef WET_DRY
2132 & grid(ng)%rmask_full(i,j)* &
2133# endif
2134 & bbl(ng)%Vbur(i,j)
2135 END DO
2136 END DO
2137 END IF
2138# endif
2139# ifdef SOLVE3D
2140
2141# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
2142 IF (aout(idpair,ng)) THEN
2143 DO j=jstrr,jendr
2144 DO i=istrr,iendr
2145 average(ng)%avgPair(i,j)=average(ng)%avgPair(i,j)+ &
2146# ifdef WET_DRY
2147 & grid(ng)%rmask_full(i,j)* &
2148# endif
2149 & forces(ng)%Pair(i,j)
2150 END DO
2151 END DO
2152 END IF
2153# endif
2154# if defined BULK_FLUXES
2155 IF (aout(idtair,ng)) THEN
2156 DO j=jstrr,jendr
2157 DO i=istrr,iendr
2158 average(ng)%avgTair(i,j)=average(ng)%avgTair(i,j)+ &
2159# ifdef WET_DRY
2160 & grid(ng)%rmask_full(i,j)* &
2161# endif
2162 & forces(ng)%Tair(i,j)
2163 END DO
2164 END DO
2165 END IF
2166# endif
2167# if defined BULK_FLUXES || defined ECOSIM
2168 IF (aout(iduair,ng)) THEN
2169 DO j=jstrr,jendr
2170 DO i=istrr,iendr
2171 average(ng)%avgUwind(i,j)=average(ng)%avgUwind(i,j)+ &
2172# ifdef WET_DRY
2173 & grid(ng)%rmask_full(i,j)* &
2174# endif
2175 & forces(ng)%Uwind(i,j)
2176 END DO
2177 END DO
2178 END IF
2179
2180 IF (aout(idvair,ng)) THEN
2181 DO j=jstrr,jendr
2182 DO i=istrr,iendr
2183 average(ng)%avgVwind(i,j)=average(ng)%avgVwind(i,j)+ &
2184# ifdef WET_DRY
2185 & grid(ng)%rmask_full(i,j)* &
2186# endif
2187 & forces(ng)%Vwind(i,j)
2188 END DO
2189 END DO
2190 END IF
2191
2192 IF (aout(iduaie,ng).and.aout(idvain,ng)) THEN
2193 CALL uv_rotate2d (ng, tile, .true., .false., &
2194 & lbi, ubi, lbj, ubj, &
2195 & grid(ng) % CosAngler, &
2196 & grid(ng) % SinAngler, &
2197# ifdef MASKING
2198 & grid(ng)%rmask_full, &
2199# endif
2200 & forces(ng) % Uwind, &
2201 & forces(ng) % Vwind, &
2202 & average(ng)%avgUwindE, &
2203 & average(ng)%avgVwindN)
2204 END IF
2205# endif
2206
2207 IF (aout(idtsur(itemp),ng)) THEN
2208 DO j=jstrr,jendr
2209 DO i=istrr,iendr
2210 average(ng)%avgstf(i,j)=average(ng)%avgstf(i,j)+ &
2211# ifdef WET_DRY
2212 & grid(ng)%rmask_full(i,j)* &
2213# endif
2214 & forces(ng)%stflx(i,j,itemp)
2215 END DO
2216 END DO
2217 END IF
2218# ifdef SALINITY
2219 IF (aout(idtsur(isalt),ng)) THEN
2220 DO j=jstrr,jendr
2221 DO i=istrr,iendr
2222 average(ng)%avgswf(i,j)=average(ng)%avgswf(i,j)+ &
2223# ifdef WET_DRY
2224 & grid(ng)%rmask_full(i,j)* &
2225# endif
2226 & forces(ng)%stflx(i,j,isalt)
2227 END DO
2228 END DO
2229 END IF
2230# endif
2231# ifdef SHORTWAVE
2232 IF (aout(idsrad,ng)) THEN
2233 DO j=jstrr,jendr
2234 DO i=istrr,iendr
2235 average(ng)%avgsrf(i,j)=average(ng)%avgsrf(i,j)+ &
2236# ifdef WET_DRY
2237 & grid(ng)%rmask_full(i,j)* &
2238# endif
2239 & forces(ng)%srflx(i,j)
2240 END DO
2241 END DO
2242 END IF
2243# endif
2244
2245# if defined BULK_FLUXES || defined FRC_COUPLING
2246 IF (aout(idlhea,ng)) THEN
2247 DO j=jstrr,jendr
2248 DO i=istrr,iendr
2249 average(ng)%avglhf(i,j)=average(ng)%avglhf(i,j)+ &
2250# ifdef WET_DRY
2251 & grid(ng)%rmask_full(i,j)* &
2252# endif
2253 & forces(ng)%lhflx(i,j)
2254 END DO
2255 END DO
2256 END IF
2257
2258 IF (aout(idshea,ng)) THEN
2259 DO j=jstrr,jendr
2260 DO i=istrr,iendr
2261 average(ng)%avgshf(i,j)=average(ng)%avgshf(i,j)+ &
2262# ifdef WET_DRY
2263 & grid(ng)%rmask_full(i,j)* &
2264# endif
2265 & forces(ng)%shflx(i,j)
2266 END DO
2267 END DO
2268 END IF
2269
2270 IF (aout(idlrad,ng)) THEN
2271 DO j=jstrr,jendr
2272 DO i=istrr,iendr
2273 average(ng)%avglrf(i,j)=average(ng)%avglrf(i,j)+ &
2274# ifdef WET_DRY
2275 & grid(ng)%rmask_full(i,j)* &
2276# endif
2277 & forces(ng)%lrflx(i,j)
2278 END DO
2279 END DO
2280 END IF
2281# endif
2282
2283# if defined BULK_FLUXES && defined EMINUSP
2284 IF (aout(idevap,ng)) THEN
2285 DO j=jstrr,jendr
2286 DO i=istrr,iendr
2287 average(ng)%avgevap(i,j)=average(ng)%avgevap(i,j)+ &
2288# ifdef WET_DRY
2289 & grid(ng)%rmask_full(i,j)* &
2290# endif
2291 & forces(ng)%evap(i,j)
2292 END DO
2293 END DO
2294 END IF
2295
2296 IF (aout(idrain,ng)) THEN
2297 DO j=jstrr,jendr
2298 DO i=istrr,iendr
2299 average(ng)%avgrain(i,j)=average(ng)%avgrain(i,j)+ &
2300# ifdef WET_DRY
2301 & grid(ng)%rmask_full(i,j)* &
2302# endif
2303 & forces(ng)%rain(i,j)
2304 END DO
2305 END DO
2306 END IF
2307# endif
2308# endif
2309# ifdef WEC
2310 IF (aout(idu2sd,ng)) THEN
2311 DO j=jstrr,jendr
2312 DO i=istr,iendr
2313 average(ng)%avgu2Sd(i,j)=average(ng)%avgu2Sd(i,j)+ &
2314# ifdef WET_DRY
2315 & grid(ng)%umask_full(i,j)* &
2316# endif
2317 & ocean(ng)%ubar_stokes(i,j)
2318 END DO
2319 END DO
2320 END IF
2321 IF (aout(idv2sd,ng)) THEN
2322 DO j=jstr,jendr
2323 DO i=istrr,iendr
2324 average(ng)%avgv2Sd(i,j)=average(ng)%avgv2Sd(i,j)+ &
2325# ifdef WET_DRY
2326 & grid(ng)%vmask_full(i,j)* &
2327# endif
2328 & ocean(ng)%vbar_stokes(i,j)
2329 END DO
2330 END DO
2331 END IF
2332
2333 IF (aout(idu2rs,ng)) THEN
2334 DO j=jstrr,jendr
2335 DO i=istr,iendr
2336 average(ng)%avgu2rs(i,j)=average(ng)%avgu2rs(i,j)+ &
2337# ifdef WET_DRY
2338 & grid(ng)%umask_full(i,j)* &
2339# endif
2340 & mixing(ng)%rustr2d(i,j)
2341 END DO
2342 END DO
2343 END IF
2344 IF (aout(idv2rs,ng)) THEN
2345 DO j=jstr,jendr
2346 DO i=istrr,iendr
2347 average(ng)%avgv2rs(i,j)=average(ng)%avgv2rs(i,j)+ &
2348# ifdef WET_DRY
2349 & grid(ng)%vmask_full(i,j)* &
2350# endif
2351 & mixing(ng)%rvstr2d(i,j)
2352 END DO
2353 END DO
2354 END IF
2355# endif
2356# ifdef WEC
2357 IF (aout(idu3sd,ng)) THEN
2358 DO k=1,n(ng)
2359 DO j=jstrr,jendr
2360 DO i=istr,iendr
2361 average(ng)%avgu3Sd(i,j,k)=average(ng)%avgu3Sd(i,j,k)+ &
2362# ifdef WET_DRY
2363 & grid(ng)%umask_full(i,j)* &
2364# endif
2365 & ocean(ng)%u_stokes(i,j,k)
2366 END DO
2367 END DO
2368 END DO
2369 END IF
2370 IF (aout(idv3sd,ng)) THEN
2371 DO k=1,n(ng)
2372 DO j=jstr,jendr
2373 DO i=istrr,iendr
2374 average(ng)%avgv3Sd(i,j,k)=average(ng)%avgv3Sd(i,j,k)+ &
2375# ifdef WET_DRY
2376 & grid(ng)%vmask_full(i,j)* &
2377# endif
2378 & ocean(ng)%v_stokes(i,j,k)
2379 END DO
2380 END DO
2381 END DO
2382 END IF
2383 IF (aout(idw3sd,ng)) THEN
2384 DO k=1,n(ng)
2385 DO j=jstrr,jendr
2386 DO i=istrr,iendr
2387 average(ng)%avgw3Sd(i,j,k)=average(ng)%avgw3Sd(i,j,k)+ &
2388# ifdef WET_DRY
2389 & grid(ng)%rmask_full(i,j)* &
2390# endif
2391 & ocean(ng)%W_stokes(i,j,k)
2392 END DO
2393 END DO
2394 END DO
2395 END IF
2396 IF (aout(idw3st,ng)) THEN
2397 DO k=1,n(ng)
2398 DO j=jstrr,jendr
2399 DO i=istrr,iendr
2400 average(ng)%avgw3St(i,j,k)=average(ng)%avgw3St(i,j,k)+ &
2401# ifdef WET_DRY
2402 & grid(ng)%rmask_full(i,j)* &
2403# endif
2404 & ocean(ng)%wstvel(i,j,k)
2405 END DO
2406 END DO
2407 END DO
2408 END IF
2409 IF (aout(idu3rs,ng)) THEN
2410 DO k=1,n(ng)
2411 DO j=jstrr,jendr
2412 DO i=istr,iendr
2413 average(ng)%avgu3rs(i,j,k)=average(ng)%avgu3rs(i,j,k)+ &
2414# ifdef WET_DRY
2415 & grid(ng)%umask_full(i,j)* &
2416# endif
2417 & mixing(ng)%rustr3d(i,j,k)
2418 END DO
2419 END DO
2420 END DO
2421 END IF
2422 IF (aout(idv3rs,ng)) THEN
2423 DO k=1,n(ng)
2424 DO j=jstr,jendr
2425 DO i=istrr,iendr
2426 average(ng)%avgv3rs(i,j,k)=average(ng)%avgv3rs(i,j,k)+ &
2427# ifdef WET_DRY
2428 & grid(ng)%vmask_full(i,j)* &
2429# endif
2430 & mixing(ng)%rvstr3d(i,j,k)
2431 END DO
2432 END DO
2433 END DO
2434 END IF
2435# endif
2436# ifdef WEC_VF
2437 IF (aout(idwztw,ng)) THEN
2438 DO j=jstrr,jendr
2439 DO i=istrr,iendr
2440 average(ng)%avgWztw(i,j)=average(ng)%avgWztw(i,j)+ &
2441# ifdef WET_DRY
2442 & grid(ng)%rmask_full(i,j)* &
2443# endif
2444 & ocean(ng)%zetaw(i,j)
2445 END DO
2446 END DO
2447 END IF
2448 IF (aout(idwqsp,ng)) THEN
2449 DO j=jstrr,jendr
2450 DO i=istrr,iendr
2451 average(ng)%avgWqsp(i,j)=average(ng)%avgWqsp(i,j)+ &
2452# ifdef WET_DRY
2453 & grid(ng)%rmask_full(i,j)* &
2454# endif
2455 & ocean(ng)%qsp(i,j)
2456 END DO
2457 END DO
2458 END IF
2459 IF (aout(idwbeh,ng)) THEN
2460 DO j=jstrr,jendr
2461 DO i=istrr,iendr
2462 average(ng)%avgWbeh(i,j)=average(ng)%avgWbeh(i,j)+ &
2463# ifdef WET_DRY
2464 & grid(ng)%rmask_full(i,j)* &
2465# endif
2466 & ocean(ng)%bh(i,j)
2467 END DO
2468 END DO
2469 END IF
2470# endif
2471# ifdef WAVES_HEIGHT
2472 IF (aout(idwamp,ng)) THEN
2473 DO j=jstrr,jendr
2474 DO i=istrr,iendr
2475 average(ng)%avgWamp(i,j)=average(ng)%avgWamp(i,j)+ &
2476# ifdef WET_DRY
2477 & grid(ng)%rmask_full(i,j)* &
2478# endif
2479 & forces(ng)%Hwave(i,j)
2480 END DO
2481 END DO
2482 END IF
2483 IF (aout(idwam2,ng)) THEN
2484 DO j=jstrr,jendr
2485 DO i=istrr,iendr
2486 average(ng)%avgWam2(i,j)=average(ng)%avgWam2(i,j)+ &
2487# ifdef WET_DRY
2488 & grid(ng)%rmask_full(i,j)* &
2489# endif
2490 & forces(ng)%Hwave(i,j)* &
2491 & forces(ng)%Hwave(i,j)
2492 END DO
2493 END DO
2494 END IF
2495# endif
2496# ifdef WAVES_LENGTH
2497 IF (aout(idwlen,ng)) THEN
2498 DO j=jstrr,jendr
2499 DO i=istrr,iendr
2500 average(ng)%avgWlen(i,j)=average(ng)%avgWlen(i,j)+ &
2501# ifdef WET_DRY
2502 & grid(ng)%rmask_full(i,j)* &
2503# endif
2504 & forces(ng)%Lwave(i,j)
2505 END DO
2506 END DO
2507 END IF
2508# endif
2509# ifdef WAVES_LENGTHP
2510 IF (aout(idwlep,ng)) THEN
2511 DO j=jstrr,jendr
2512 DO i=istrr,iendr
2513 average(ng)%avgWlep(i,j)=average(ng)%avgWlep(i,j)+ &
2514# ifdef WET_DRY
2515 & grid(ng)%rmask_full(i,j)* &
2516# endif
2517 & forces(ng)%Lwavep(i,j)
2518 END DO
2519 END DO
2520 END IF
2521# endif
2522# ifdef WAVES_DIR
2523 IF (aout(idwdir,ng)) THEN
2524 DO j=jstrr,jendr
2525 DO i=istrr,iendr
2526 average(ng)%avgWdir(i,j)=average(ng)%avgWdir(i,j)+ &
2527# ifdef WET_DRY
2528 & grid(ng)%rmask_full(i,j)* &
2529# endif
2530 & forces(ng)%Dwave(i,j)
2531 END DO
2532 END DO
2533 END IF
2534# endif
2535# ifdef WAVES_DIRP
2536 IF (aout(idwdip,ng)) THEN
2537 DO j=jstrr,jendr
2538 DO i=istrr,iendr
2539 average(ng)%avgWdip(i,j)=average(ng)%avgWdip(i,j)+ &
2540# ifdef WET_DRY
2541 & grid(ng)%rmask_full(i,j)* &
2542# endif
2543 & forces(ng)%Dwavep(i,j)
2544 END DO
2545 END DO
2546 END IF
2547# endif
2548# ifdef WAVES_TOP_PERIOD
2549 IF (aout(idwptp,ng)) THEN
2550 DO j=jstrr,jendr
2551 DO i=istrr,iendr
2552 average(ng)%avgWptp(i,j)=average(ng)%avgWptp(i,j)+ &
2553# ifdef WET_DRY
2554 & grid(ng)%rmask_full(i,j)* &
2555# endif
2556 & forces(ng)%Pwave_top(i,j)
2557 END DO
2558 END DO
2559 END IF
2560# endif
2561# ifdef WAVES_BOT_PERIOD
2562 IF (aout(idwpbt,ng)) THEN
2563 DO j=jstrr,jendr
2564 DO i=istrr,iendr
2565 average(ng)%avgWpbt(i,j)=average(ng)%avgWpbt(i,j)+ &
2566# ifdef WET_DRY
2567 & grid(ng)%rmask_full(i,j)* &
2568# endif
2569 & forces(ng)%Pwave_bot(i,j)
2570 END DO
2571 END DO
2572 END IF
2573# endif
2574# ifdef BBL_MODEL
2575 IF (aout(idworb,ng)) THEN
2576 DO j=jstrr,jendr
2577 DO i=istrr,iendr
2578 average(ng)%avgWorb(i,j)=average(ng)%avgWorb(i,j)+ &
2579# ifdef WET_DRY
2580 & grid(ng)%rmask_full(i,j)* &
2581# endif
2582 & forces(ng)%Uwave_rms(i,j)
2583 END DO
2584 END DO
2585 END IF
2586# endif
2587# if defined WAV_COUPLING || (defined WEC_VF && defined BOTTOM_STREAMING)
2588 IF (aout(idwdif,ng)) THEN
2589 DO j=jstrr,jendr
2590 DO i=istrr,iendr
2591 average(ng)%avgWdif(i,j)=average(ng)%avgWdif(i,j)+ &
2592# ifdef WET_DRY
2593 & grid(ng)%rmask_full(i,j)* &
2594# endif
2595 & forces(ng)%Dissip_fric(i,j)
2596 END DO
2597 END DO
2598 END IF
2599# endif
2600# if defined WAV_COUPLING || defined TKE_WAVEDISS || \
2601 defined wdiss_thorguza || defined wdiss_churthor
2602 IF (aout(idwdib,ng)) THEN
2603 DO j=jstrr,jendr
2604 DO i=istrr,iendr
2605 average(ng)%avgWdib(i,j)=average(ng)%avgWdib(i,j)+ &
2606# ifdef WET_DRY
2607 & grid(ng)%rmask_full(i,j)* &
2608# endif
2609 & forces(ng)%Dissip_break(i,j)
2610 END DO
2611 END DO
2612 END IF
2613 IF (aout(idwdiw,ng)) THEN
2614 DO j=jstrr,jendr
2615 DO i=istrr,iendr
2616 average(ng)%avgWdiw(i,j)=average(ng)%avgWdiw(i,j)+ &
2617# ifdef WET_DRY
2618 & grid(ng)%rmask_full(i,j)* &
2619# endif
2620 & forces(ng)%Dissip_wcap(i,j)
2621 END DO
2622 END DO
2623 END IF
2624# endif
2625# ifdef ROLLER_SVENDSEN
2626 IF (aout(idwbrk,ng)) THEN
2627 DO j=jstrr,jendr
2628 DO i=istrr,iendr
2629 average(ng)%avgWbrk(i,j)=average(ng)%avgWbrk(i,j)+ &
2630# ifdef WET_DRY
2631 & grid(ng)%rmask_full(i,j)* &
2632# endif
2633 & forces(ng)%Wave_break(i,j)
2634 END DO
2635 END DO
2636 END IF
2637# endif
2638# ifdef WEC_ROLLER
2639 IF (aout(idwdis,ng)) THEN
2640 DO j=jstrr,jendr
2641 DO i=istrr,iendr
2642 average(ng)%avgWdis(i,j)=average(ng)%avgWdis(i,j)+ &
2643# ifdef WET_DRY
2644 & grid(ng)%rmask_full(i,j)* &
2645# endif
2646 & forces(ng)%Dissip_roller(i,j)
2647 END DO
2648 END DO
2649 END IF
2650 IF (aout(idwrol,ng)) THEN
2651 DO j=jstrr,jendr
2652 DO i=istrr,iendr
2653 average(ng)%avgWrol(i,j)=average(ng)%avgWrol(i,j)+ &
2654# ifdef WET_DRY
2655 & grid(ng)%rmask_full(i,j)* &
2656# endif
2657 & forces(ng)%rollA(i,j)
2658 END DO
2659 END DO
2660 END IF
2661# endif
2662# ifdef UV_KIRBY
2663 IF (aout(iduwav,ng)) THEN
2664 DO j=jstrr,jendr
2665 DO i=istrr,iendr
2666 average(ng)%avgUwav(i,j)=average(ng)%avgUwav(i,j)+ &
2667# ifdef WET_DRY
2668 & grid(ng)%rmask_full(i,j)* &
2669# endif
2670 & ocean(ng)%uWave(i,j)
2671 END DO
2672 END DO
2673 END IF
2674 IF (aout(idvwav,ng)) THEN
2675 DO j=jstrr,jendr
2676 DO i=istrr,iendr
2677 average(ng)%avgVwav(i,j)=average(ng)%avgVwav(i,j)+ &
2678# ifdef WET_DRY
2679 & grid(ng)%rmask_full(i,j)* &
2680# endif
2681 & ocean(ng)%vWave(i,j)
2682 END DO
2683 END DO
2684 END IF
2685# endif
2686!
2687! Accumulate vorticity fields.
2688!
2689 IF (aout(id2dpv,ng)) THEN
2690 DO j=jstr,jend
2691 DO i=istr,iend
2692 average(ng)%avgpvor2d(i,j)=average(ng)%avgpvor2d(i,j)+ &
2693# ifdef WET_DRY
2694 & grid(ng)%pmask_full(i,j)* &
2695# endif
2696 & potvor_bar(i,j)
2697 END DO
2698 END DO
2699 END IF
2700 IF (aout(id2drv,ng)) THEN
2701 DO j=jstr,jend
2702 DO i=istr,iend
2703 average(ng)%avgrvor2d(i,j)=average(ng)%avgrvor2d(i,j)+ &
2704# ifdef WET_DRY
2705 & grid(ng)%pmask_full(i,j)* &
2706# endif
2707 & relvor_bar(i,j)
2708 END DO
2709 END DO
2710 END IF
2711# ifdef SOLVE3D
2712 IF (aout(id3dpv,ng)) THEN
2713 DO k=1,n(ng)
2714 DO j=jstr,jend
2715 DO i=istr,iend
2716 average(ng)%avgpvor3d(i,j,k)=average(ng)%avgpvor3d(i,j, &
2717 & k)+ &
2718# ifdef WET_DRY
2719 & grid(ng)%pmask_full(i,j)* &
2720# endif
2721 & potvor(i,j,k)
2722 END DO
2723 END DO
2724 END DO
2725 END IF
2726 IF (aout(id3drv,ng)) THEN
2727 DO k=1,n(ng)
2728 DO j=jstr,jend
2729 DO i=istr,iend
2730 average(ng)%avgrvor3d(i,j,k)=average(ng)%avgrvor3d(i,j, &
2731 & k)+ &
2732# ifdef WET_DRY
2733 & grid(ng)%pmask_full(i,j)* &
2734# endif
2735 & relvor(i,j,k)
2736 END DO
2737 END DO
2738 END DO
2739 END IF
2740# endif
2741!
2742! Accumulate quadratic fields.
2743!
2744 IF (aout(idzzav,ng)) THEN
2745 DO j=jstrr,jendr
2746 DO i=istrr,iendr
2747 average(ng)%avgZZ(i,j)=average(ng)%avgZZ(i,j)+ &
2748# ifdef WET_DRY
2749 & grid(ng)%rmask_full(i,j)* &
2750# endif
2751 & ocean(ng)%zeta(i,j,kout)* &
2752 & ocean(ng)%zeta(i,j,kout)
2753 END DO
2754 END DO
2755 END IF
2756 IF (aout(idu2av,ng)) THEN
2757 DO j=jstrr,jendr
2758 DO i=istr,iendr
2759 average(ng)%avgU2(i,j)=average(ng)%avgU2(i,j)+ &
2760# ifdef WET_DRY
2761 & grid(ng)%umask_full(i,j)* &
2762# endif
2763 & ocean(ng)%ubar(i,j,kout)* &
2764 & ocean(ng)%ubar(i,j,kout)
2765 END DO
2766 END DO
2767 END IF
2768 IF (aout(idv2av,ng)) THEN
2769 DO j=jstr,jendr
2770 DO i=istrr,iendr
2771 average(ng)%avgV2(i,j)=average(ng)%avgV2(i,j)+ &
2772# ifdef WET_DRY
2773 & grid(ng)%vmask_full(i,j)* &
2774# endif
2775 & ocean(ng)%vbar(i,j,kout)* &
2776 & ocean(ng)%vbar(i,j,kout)
2777 END DO
2778 END DO
2779 END IF
2780
2781# ifdef SOLVE3D
2782 IF (aout(iduuav,ng)) THEN
2783 DO k=1,n(ng)
2784 DO j=jstrr,jendr
2785 DO i=istr,iendr
2786 average(ng)%avgUU(i,j,k)=average(ng)%avgUU(i,j,k)+ &
2787# ifdef WET_DRY
2788 & grid(ng)%umask_full(i,j)* &
2789# endif
2790 & ocean(ng)%u(i,j,k,nout)* &
2791 & ocean(ng)%u(i,j,k,nout)
2792 END DO
2793 END DO
2794 END DO
2795 END IF
2796 IF (aout(idvvav,ng)) THEN
2797 DO k=1,n(ng)
2798 DO j=jstr,jendr
2799 DO i=istrr,iendr
2800 average(ng)%avgVV(i,j,k)=average(ng)%avgVV(i,j,k)+ &
2801# ifdef WET_DRY
2802 & grid(ng)%vmask_full(i,j)* &
2803# endif
2804 & ocean(ng)%v(i,j,k,nout)* &
2805 & ocean(ng)%v(i,j,k,nout)
2806 END DO
2807 END DO
2808 END DO
2809 END IF
2810 IF (aout(iduvav,ng)) THEN
2811 DO k=1,n(ng)
2812 DO j=jstr,jend
2813 DO i=istr,iend
2814 average(ng)%avgUV(i,j,k)=average(ng)%avgUV(i,j,k)+ &
2815# ifdef WET_DRY
2816 & grid(ng)%rmask_full(i,j)* &
2817# endif
2818 & 0.25_r8* &
2819 & (ocean(ng)%u(i ,j ,k,nout)+ &
2820 & ocean(ng)%u(i+1,j ,k,nout))* &
2821 & (ocean(ng)%v(i ,j ,k,nout)+ &
2822 & ocean(ng)%v(i ,j+1,k,nout))
2823 END DO
2824 END DO
2825 END DO
2826 END IF
2827
2828 IF (aout(idhuav,ng)) THEN
2829 DO k=1,n(ng)
2830 DO j=jstrr,jendr
2831 DO i=istr,iendr
2832 average(ng)%avgHuon(i,j,k)=average(ng)%avgHuon(i,j,k)+ &
2833# ifdef WET_DRY
2834 & grid(ng)%umask_full(i,j)* &
2835# endif
2836 & grid(ng)%Huon(i,j,k)
2837 END DO
2838 END DO
2839 END DO
2840 END IF
2841 IF (aout(idhvav,ng)) THEN
2842 DO k=1,n(ng)
2843 DO j=jstr,jendr
2844 DO i=istrr,iendr
2845 average(ng)%avgHvom(i,j,k)=average(ng)%avgHvom(i,j,k)+ &
2846# ifdef WET_DRY
2847 & grid(ng)%vmask_full(i,j)* &
2848# endif
2849 & grid(ng)%Hvom(i,j,k)
2850 END DO
2851 END DO
2852 END DO
2853 END IF
2854
2855 DO it=1,nt(ng)
2856 IF (aout(idttav(it),ng)) THEN
2857 DO k=1,n(ng)
2858 DO j=jstrr,jendr
2859 DO i=istrr,iendr
2860 average(ng)%avgTT(i,j,k,it)=average(ng)%avgTT(i,j,k, &
2861 & it)+ &
2862# ifdef WET_DRY
2863 & grid(ng)%rmask_full(i,j)* &
2864# endif
2865 & ocean(ng)%t(i,j,k, &
2866 & nout,it)* &
2867 & ocean(ng)%t(i,j,k, &
2868 & nout,it)
2869 END DO
2870 END DO
2871 END DO
2872 END IF
2873 IF (aout(idutav(it),ng)) THEN
2874 DO k=1,n(ng)
2875 DO j=jstrr,jendr
2876 DO i=istr,iend
2877 average(ng)%avgUT(i,j,k,it)=average(ng)%avgUT(i,j,k, &
2878 & it)+ &
2879# ifdef WET_DRY
2880 & grid(ng)%umask_full(i,j)* &
2881# endif
2882 & 0.5_r8* &
2883 & ocean(ng)%u(i,j,k,nout)* &
2884 & (ocean(ng)%t(i-1,j,k, &
2885 & nout,it)+ &
2886 & ocean(ng)%t(i ,j,k, &
2887 & nout,it))
2888 END DO
2889 END DO
2890 END DO
2891 END IF
2892 IF (aout(idvtav(it),ng)) THEN
2893 DO k=1,n(ng)
2894 DO j=jstr,jend
2895 DO i=istrr,iendr
2896 average(ng)%avgVT(i,j,k,it)=average(ng)%avgVT(i,j,k, &
2897 & it)+ &
2898# ifdef WET_DRY
2899 & grid(ng)%vmask_full(i,j)* &
2900# endif
2901 & 0.5_r8* &
2902 & ocean(ng)%v(i,j,k,nout)* &
2903 & (ocean(ng)%t(i,j-1,k, &
2904 & nout,it)+ &
2905 & ocean(ng)%t(i,j ,k, &
2906 & nout,it))
2907 END DO
2908 END DO
2909 END DO
2910 END IF
2911
2912 IF (aout(ihutav(it),ng)) THEN
2913 DO k=1,n(ng)
2914 DO j=jstrr,jendr
2915 DO i=istr,iend
2916 average(ng)%avgHuonT(i,j,k,it)=average(ng)%avgHuonT(i,&
2917 & j,k,it)+ &
2918# ifdef WET_DRY
2919 & grid(ng)%umask_full(i, &
2920 & j)* &
2921# endif
2922 & 0.5_r8* &
2923 & grid(ng)%Huon(i,j,k)* &
2924 & (ocean(ng)%t(i-1,j,k, &
2925 & nout,it)+ &
2926 & ocean(ng)%t(i ,j,k, &
2927 & nout,it))
2928 END DO
2929 END DO
2930 END DO
2931 END IF
2932 IF (aout(ihvtav(it),ng)) THEN
2933 DO k=1,n(ng)
2934 DO j=jstr,jend
2935 DO i=istrr,iendr
2936 average(ng)%avgHvomT(i,j,k,it)=average(ng)%avgHvomT(i,&
2937 & j,k,it)+ &
2938# ifdef WET_DRY
2939 & grid(ng)%vmask_full(i, &
2940 & j)* &
2941# endif
2942 & 0.5_r8* &
2943 & grid(ng)%Hvom(i,j,k)* &
2944 & (ocean(ng)%t(i,j-1,k, &
2945 & nout,it)+ &
2946 & ocean(ng)%t(i,j ,k, &
2947 & nout,it))
2948 END DO
2949 END DO
2950 END DO
2951 END IF
2952 END DO
2953# endif
2954 END IF
2955!
2956!-----------------------------------------------------------------------
2957! Convert accumulated sums into time-averages, if appropriate.
2958! Notice that we need to apply periodic conditions, if any, since
2959! the full I- and J-ranges are different.
2960!-----------------------------------------------------------------------
2961!
2962 IF (((iic(ng).gt.ntsavg(ng)).and. &
2963 & (mod(iic(ng)-1,navg(ng)).eq.0).and. &
2964 & ((iic(ng).ne.ntstart(ng)).or.(nrrec(ng).eq.0))).or. &
2965 & ((iic(ng).ge.ntsavg(ng)).and.(navg(ng).eq.1))) THEN
2966 IF (domain(ng)%SouthWest_Test(tile)) THEN
2967 IF (navg(ng).eq.1) THEN
2968 avgtime(ng)=time(ng)
2969 ELSE
2970 avgtime(ng)=avgtime(ng)+real(navg(ng),r8)*dt(ng)
2971 END IF
2972 END IF
2973!
2974! Set time-averaged factors for each C-grid variable type. Notice that
2975! the I- and J-ranges are all grid types are the same for convinience.
2976# ifdef WET_DRY
2977! In wetting and drying, the sums are devided by the number of times
2978! that each qrid point is wet.
2979# endif
2980!
2981# ifdef WET_DRY
2982 DO j=jstrr,jendr
2983 DO i=istrr,iendr
2984 pfac(i,j)=1.0_r8/max(1.0_r8, grid(ng)%pmask_avg(i,j))
2985 rfac(i,j)=1.0_r8/max(1.0_r8, grid(ng)%rmask_avg(i,j))
2986 ufac(i,j)=1.0_r8/max(1.0_r8, grid(ng)%umask_avg(i,j))
2987 vfac(i,j)=1.0_r8/max(1.0_r8, grid(ng)%vmask_avg(i,j))
2988 END DO
2989 END DO
2990# else
2991 fac=1.0_r8/real(navg(ng),r8)
2992 DO j=jstrr,jendr
2993 DO i=istrr,iendr
2994 pfac(i,j)=fac
2995 rfac(i,j)=fac
2996 ufac(i,j)=fac
2997 vfac(i,j)=fac
2998 END DO
2999 END DO
3000# endif
3001!
3002! Process state variables.
3003!
3004 IF (aout(idfsur,ng)) THEN
3005 DO j=jstrr,jendr
3006 DO i=istrr,iendr
3007 average(ng)%avgzeta(i,j)=rfac(i,j)* &
3008 & average(ng)%avgzeta(i,j)
3009 END DO
3010 END DO
3011 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3012 CALL exchange_r2d_tile (ng, tile, &
3013 & lbi, ubi, lbj, ubj, &
3014 & average(ng)%avgzeta)
3015# ifdef DISTRIBUTE
3016 CALL mp_exchange2d (ng, tile, inlm, 1, &
3017 & lbi, ubi, lbj, ubj, &
3018 & nghostpoints, &
3019 & ewperiodic(ng), nsperiodic(ng), &
3020 & average(ng)%avgzeta)
3021# endif
3022 END IF
3023 END IF
3024
3025 IF (aout(idubar,ng)) THEN
3026 DO j=jstrr,jendr
3027 DO i=istr,iendr
3028 average(ng)%avgu2d(i,j)=ufac(i,j)* &
3029 & average(ng)%avgu2d(i,j)
3030 END DO
3031 END DO
3032 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3033 CALL exchange_u2d_tile (ng, tile, &
3034 & lbi, ubi, lbj, ubj, &
3035 & average(ng)%avgu2d)
3036# ifdef DISTRIBUTE
3037 CALL mp_exchange2d (ng, tile, inlm, 1, &
3038 & lbi, ubi, lbj, ubj, &
3039 & nghostpoints, &
3040 & ewperiodic(ng), nsperiodic(ng), &
3041 & average(ng)%avgu2d)
3042# endif
3043 END IF
3044 END IF
3045
3046 IF (aout(idvbar,ng)) THEN
3047 DO j=jstr,jendr
3048 DO i=istrr,iendr
3049 average(ng)%avgv2d(i,j)=vfac(i,j)* &
3050 & average(ng)%avgv2d(i,j)
3051 END DO
3052 END DO
3053 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3054 CALL exchange_v2d_tile (ng, tile, &
3055 & lbi, ubi, lbj, ubj, &
3056 & average(ng)%avgv2d)
3057# ifdef DISTRIBUTE
3058 CALL mp_exchange2d (ng, tile, inlm, 1, &
3059 & lbi, ubi, lbj, ubj, &
3060 & nghostpoints, &
3061 & ewperiodic(ng), nsperiodic(ng), &
3062 & average(ng)%avgv2d)
3063# endif
3064 END IF
3065 END IF
3066
3067 IF (aout(idu2de,ng).and.aout(idv2dn,ng)) THEN
3068 DO j=jstr,jend
3069 DO i=istr,iend
3070 average(ng)%avgu2dE(i,j)=rfac(i,j)* &
3071 & average(ng)%avgu2dE(i,j)
3072 average(ng)%avgv2dN(i,j)=rfac(i,j)* &
3073 & average(ng)%avgv2dN(i,j)
3074 END DO
3075 END DO
3076 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3077 CALL exchange_r2d_tile (ng, tile, &
3078 & lbi, ubi, lbj, ubj, &
3079 & average(ng)%avgu2dE)
3080 CALL exchange_r2d_tile (ng, tile, &
3081 & lbi, ubi, lbj, ubj, &
3082 & average(ng)%avgv2dN)
3083# ifdef DISTRIBUTE
3084 CALL mp_exchange2d (ng, tile, inlm, 2, &
3085 & lbi, ubi, lbj, ubj, &
3086 & nghostpoints, &
3087 & ewperiodic(ng), nsperiodic(ng), &
3088 & average(ng)%avgu2dE, &
3089 & average(ng)%avgv2dN)
3090# endif
3091 END IF
3092 END IF
3093
3094# ifdef SOLVE3D
3095 IF (aout(iduvel,ng)) THEN
3096 DO k=1,n(ng)
3097 DO j=jstrr,jendr
3098 DO i=istr,iendr
3099 average(ng)%avgu3d(i,j,k)=ufac(i,j)* &
3100 & average(ng)%avgu3d(i,j,k)
3101 END DO
3102 END DO
3103 END DO
3104 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3105 CALL exchange_u3d_tile (ng, tile, &
3106 & lbi, ubi, lbj, ubj, 1, n(ng), &
3107 & average(ng)%avgu3d)
3108# ifdef DISTRIBUTE
3109 CALL mp_exchange3d (ng, tile, inlm, 1, &
3110 & lbi, ubi, lbj, ubj, 1, n(ng), &
3111 & nghostpoints, &
3112 & ewperiodic(ng), nsperiodic(ng), &
3113 & average(ng)%avgu3d)
3114# endif
3115 END IF
3116 END IF
3117
3118 IF (aout(idvvel,ng)) THEN
3119 DO k=1,n(ng)
3120 DO j=jstr,jendr
3121 DO i=istrr,iendr
3122 average(ng)%avgv3d(i,j,k)=vfac(i,j)* &
3123 & average(ng)%avgv3d(i,j,k)
3124 END DO
3125 END DO
3126 END DO
3127 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3128 CALL exchange_v3d_tile (ng, tile, &
3129 & lbi, ubi, lbj, ubj, 1, n(ng), &
3130 & average(ng)%avgv3d)
3131# ifdef DISTRIBUTE
3132 CALL mp_exchange3d (ng, tile, inlm, 1, &
3133 & lbi, ubi, lbj, ubj, 1, n(ng), &
3134 & nghostpoints, &
3135 & ewperiodic(ng), nsperiodic(ng), &
3136 & average(ng)%avgv3d)
3137# endif
3138 END IF
3139 END IF
3140
3141 IF (aout(idu3de,ng)) THEN
3142 DO k=1,n(ng)
3143 DO j=jstrr,jendr
3144 DO i=istrr,iendr
3145 average(ng)%avgu3dE(i,j,k)=rfac(i,j)* &
3146 & average(ng)%avgu3dE(i,j,k)
3147 END DO
3148 END DO
3149 END DO
3150 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3151 CALL exchange_r3d_tile (ng, tile, &
3152 & lbi, ubi, lbj, ubj, 1, n(ng), &
3153 & average(ng)%avgu3dE)
3154# ifdef DISTRIBUTE
3155 CALL mp_exchange3d (ng, tile, inlm, 1, &
3156 & lbi, ubi, lbj, ubj, 1, n(ng), &
3157 & nghostpoints, &
3158 & ewperiodic(ng), nsperiodic(ng), &
3159 & average(ng)%avgu3dE)
3160# endif
3161 END IF
3162 END IF
3163
3164 IF (aout(idv3dn,ng)) THEN
3165 DO k=1,n(ng)
3166 DO j=jstrr,jendr
3167 DO i=istrr,iendr
3168 average(ng)%avgv3dN(i,j,k)=rfac(i,j)* &
3169 & average(ng)%avgv3dN(i,j,k)
3170 END DO
3171 END DO
3172 END DO
3173 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3174 CALL exchange_r3d_tile (ng, tile, &
3175 & lbi, ubi, lbj, ubj, 1, n(ng), &
3176 & average(ng)%avgv3dN)
3177# ifdef DISTRIBUTE
3178 CALL mp_exchange3d (ng, tile, inlm, 1, &
3179 & lbi, ubi, lbj, ubj, 1, n(ng), &
3180 & nghostpoints, &
3181 & ewperiodic(ng), nsperiodic(ng), &
3182 & average(ng)%avgv3dN)
3183# endif
3184 END IF
3185 END IF
3186
3187 IF (aout(idovel,ng)) THEN
3188 DO k=0,n(ng)
3189 DO j=jstrr,jendr
3190 DO i=istrr,iendr
3191 average(ng)%avgw3d(i,j,k)=rfac(i,j)* &
3192 & average(ng)%avgw3d(i,j,k)
3193 END DO
3194 END DO
3195 END DO
3196 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3197 CALL exchange_w3d_tile (ng, tile, &
3198 & lbi, ubi, lbj, ubj, 0, n(ng), &
3199 & average(ng)%avgw3d)
3200# ifdef DISTRIBUTE
3201 CALL mp_exchange3d (ng, tile, inlm, 1, &
3202 & lbi, ubi, lbj, ubj, 0, n(ng), &
3203 & nghostpoints, &
3204 & ewperiodic(ng), nsperiodic(ng), &
3205 & average(ng)%avgw3d)
3206# endif
3207 END IF
3208 END IF
3209
3210 IF (aout(idwvel,ng)) THEN
3211 DO k=0,n(ng)
3212 DO j=jstrr,jendr
3213 DO i=istrr,iendr
3214 average(ng)%avgwvel(i,j,k)=rfac(i,j)* &
3215 & average(ng)%avgwvel(i,j,k)
3216 END DO
3217 END DO
3218 END DO
3219 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3220 CALL exchange_w3d_tile (ng, tile, &
3221 & lbi, ubi, lbj, ubj, 0, n(ng), &
3222 & average(ng)%avgwvel)
3223# ifdef DISTRIBUTE
3224 CALL mp_exchange3d (ng, tile, inlm, 1, &
3225 & lbi, ubi, lbj, ubj, 0, n(ng), &
3226 & nghostpoints, &
3227 & ewperiodic(ng), nsperiodic(ng), &
3228 & average(ng)%avgwvel)
3229# endif
3230 END IF
3231 END IF
3232
3233 IF (aout(iddano,ng)) THEN
3234 DO k=1,n(ng)
3235 DO j=jstrr,jendr
3236 DO i=istrr,iendr
3237 average(ng)%avgrho(i,j,k)=rfac(i,j)* &
3238 & average(ng)%avgrho(i,j,k)
3239 END DO
3240 END DO
3241 END DO
3242 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3243 CALL exchange_r3d_tile (ng, tile, &
3244 & lbi, ubi, lbj, ubj, 1, n(ng), &
3245 & average(ng)%avgrho)
3246# ifdef DISTRIBUTE
3247 CALL mp_exchange3d (ng, tile, inlm, 1, &
3248 & lbi, ubi, lbj, ubj, 1, n(ng), &
3249 & nghostpoints, &
3250 & ewperiodic(ng), nsperiodic(ng), &
3251 & average(ng)%avgrho)
3252# endif
3253 END IF
3254 END IF
3255
3256 DO it=1,nt(ng)
3257 IF (aout(idtvar(it),ng)) THEN
3258 DO k=1,n(ng)
3259 DO j=jstrr,jendr
3260 DO i=istrr,iendr
3261 average(ng)%avgt(i,j,k,it)=rfac(i,j)* &
3262 & average(ng)%avgt(i,j,k,it)
3263 END DO
3264 END DO
3265 END DO
3266 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3267 CALL exchange_r3d_tile (ng, tile, &
3268 & lbi, ubi, lbj, ubj, 1, n(ng), &
3269 & average(ng)%avgt(:,:,:,it))
3270# ifdef DISTRIBUTE
3271 CALL mp_exchange3d (ng, tile, inlm, 1, &
3272 & lbi, ubi, lbj, ubj, 1, n(ng), &
3273 & nghostpoints, &
3274 & ewperiodic(ng), nsperiodic(ng), &
3275 & average(ng)%avgt(:,:,:,it))
3276# endif
3277 END IF
3278 END IF
3279 END DO
3280
3281# if defined SEDIMENT && defined BEDLOAD
3282 DO it=1,nst
3283 IF (aout(idubld(it),ng)) THEN
3284 DO j=jstrr,jendr
3285 DO i=istr,iendr
3286 sedbed(ng)%avgbedldu(i,j,it)=ufac(i,j)* &
3287 & sedbed(ng)%avgbedldu(i,j, &
3288 & it)
3289 END DO
3290 END DO
3291 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3292 CALL exchange_u2d_tile (ng, tile, &
3293 & lbi, ubi, lbj, ubj, &
3294 & sedbed(ng)%avgbedldu(:,:,it))
3295# ifdef DISTRIBUTE
3296 CALL mp_exchange2d (ng, tile, inlm, 1, &
3297 & lbi, ubi, lbj, ubj, &
3298 & nghostpoints, &
3299 & ewperiodic(ng), nsperiodic(ng), &
3300 & sedbed(ng)%avgbedldu(:,:,it))
3301# endif
3302 END IF
3303 END IF
3304
3305 IF (aout(idvbld(it),ng)) THEN
3306 DO j=jstr,jendr
3307 DO i=istrr,iendr
3308 sedbed(ng)%avgbedldv(i,j,it)=vfac(i,j)* &
3309 & sedbed(ng)%avgbedldv(i,j, &
3310 & it)
3311 END DO
3312 END DO
3313 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3314 CALL exchange_v2d_tile (ng, tile, &
3315 & lbi, ubi, lbj, ubj, &
3316 & sedbed(ng)%avgbedldv(:,:,it))
3317# ifdef DISTRIBUTE
3318 CALL mp_exchange2d (ng, tile, inlm, 1, &
3319 & lbi, ubi, lbj, ubj, &
3320 & nghostpoints, &
3321 & ewperiodic(ng), nsperiodic(ng), &
3322 & sedbed(ng)%avgbedldv(:,:,it))
3323# endif
3324 END IF
3325 END IF
3326 END DO
3327# endif
3328
3329# if defined LMD_MIXING || defined MY25_MIXING || defined GLS_MIXING
3330 IF (aout(idvvis,ng)) THEN
3331 DO k=0,n(ng)
3332 DO j=jstrr,jendr
3333 DO i=istrr,iendr
3334 average(ng)%avgAKv(i,j,k)=rfac(i,j)* &
3335 & average(ng)%avgAKv(i,j,k)
3336 END DO
3337 END DO
3338 END DO
3339 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3340 CALL exchange_w3d_tile (ng, tile, &
3341 & lbi, ubi, lbj, ubj, 0, n(ng), &
3342 & average(ng)%avgAKv)
3343# ifdef DISTRIBUTE
3344 CALL mp_exchange3d (ng, tile, inlm, 1, &
3345 & lbi, ubi, lbj, ubj, 0, n(ng), &
3346 & nghostpoints, &
3347 & ewperiodic(ng), nsperiodic(ng), &
3348 & average(ng)%avgAKv)
3349# endif
3350 END IF
3351 END IF
3352
3353 IF (aout(idtdif,ng)) THEN
3354 DO k=0,n(ng)
3355 DO j=jstrr,jendr
3356 DO i=istrr,iendr
3357 average(ng)%avgAKt(i,j,k)=rfac(i,j)* &
3358 & average(ng)%avgAKt(i,j,k)
3359 END DO
3360 END DO
3361 END DO
3362 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3363 CALL exchange_w3d_tile (ng, tile, &
3364 & lbi, ubi, lbj, ubj, 0, n(ng), &
3365 & average(ng)%avgAKt)
3366# ifdef DISTRIBUTE
3367 CALL mp_exchange3d (ng, tile, inlm, 1, &
3368 & lbi, ubi, lbj, ubj, 0, n(ng), &
3369 & nghostpoints, &
3370 & ewperiodic(ng), nsperiodic(ng), &
3371 & average(ng)%avgAKt)
3372# endif
3373 END IF
3374 END IF
3375# ifdef SALINITY
3376 IF (aout(idsdif,ng)) THEN
3377 DO k=0,n(ng)
3378 DO j=jstrr,jendr
3379 DO i=istrr,iendr
3380 average(ng)%avgAKs(i,j,k)=rfac(i,j)* &
3381 & average(ng)%avgAKs(i,j,k)
3382 END DO
3383 END DO
3384 END DO
3385 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3386 CALL exchange_w3d_tile (ng, tile, &
3387 & lbi, ubi, lbj, ubj, 0, n(ng), &
3388 & average(ng)%avgAKs)
3389# ifdef DISTRIBUTE
3390 CALL mp_exchange3d (ng, tile, inlm, 1, &
3391 & lbi, ubi, lbj, ubj, 0, n(ng), &
3392 & nghostpoints, &
3393 & ewperiodic(ng), nsperiodic(ng), &
3394 & average(ng)%avgAKs)
3395# endif
3396 END IF
3397 END IF
3398# endif
3399# endif
3400
3401# ifdef LMD_SKPP
3402 IF (aout(idhsbl,ng)) THEN
3403 DO j=jstrr,jendr
3404 DO i=istrr,iendr
3405 average(ng)%avghsbl(i,j)=rfac(i,j)* &
3406 & average(ng)%avghsbl(i,j)
3407 END DO
3408 END DO
3409 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3410 CALL exchange_r2d_tile (ng, tile, &
3411 & lbi, ubi, lbj, ubj, &
3412 & average(ng)%avghsbl)
3413# ifdef DISTRIBUTE
3414 CALL mp_exchange2d (ng, tile, inlm, 1, &
3415 & lbi, ubi, lbj, ubj, &
3416 & nghostpoints, &
3417 & ewperiodic(ng), nsperiodic(ng), &
3418 & average(ng)%avghsbl)
3419# endif
3420 END IF
3421 END IF
3422# endif
3423
3424# ifdef LMD_BKPP
3425 IF (aout(idhbbl,ng)) THEN
3426 DO j=jstrr,jendr
3427 DO i=istrr,iendr
3428 average(ng)%avghbbl(i,j)=rfac(i,j)* &
3429 & average(ng)%avghbbl(i,j)
3430 END DO
3431 END DO
3432 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3433 CALL exchange_r2d_tile (ng, tile, &
3434 & lbi, ubi, lbj, ubj, &
3435 & average(ng)%avghbbl)
3436# ifdef DISTRIBUTE
3437 CALL mp_exchange2d (ng, tile, inlm, 1, &
3438 & lbi, ubi, lbj, ubj, &
3439 & nghostpoints, &
3440 & ewperiodic(ng), nsperiodic(ng), &
3441 & average(ng)%avghbbl)
3442# endif
3443 END IF
3444 END IF
3445# endif
3446# endif
3447
3448# if defined FORWARD_WRITE && defined SOLVE3D
3449!
3450! Process 2D/3D coupling terms.
3451!
3452 IF (aout(idufx1,ng)) THEN
3453 DO j=jstrr,jendr
3454 DO i=istr,iendr
3455 average(ng)%avgDU_avg1(i,j)=ufac(i,j)* &
3456 & average(ng)%avgDU_avg1(i,j)
3457 END DO
3458 END DO
3459 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3460 CALL exchange_u2d_tile (ng, tile, &
3461 & lbi, ubi, lbj, ubj, &
3462 & average(ng)%avgDU_avg1)
3463# ifdef DISTRIBUTE
3464 CALL mp_exchange2d (ng, tile, inlm, 1, &
3465 & lbi, ubi, lbj, ubj, &
3466 & nghostpoints, &
3467 & ewperiodic(ng), nsperiodic(ng), &
3468 & average(ng)%avgDU_avg1)
3469# endif
3470 END IF
3471 END IF
3472
3473 IF (aout(idufx2,ng)) THEN
3474 DO j=jstrr,jendr
3475 DO i=istr,iendr
3476 average(ng)%avgDU_avg2(i,j)=ufac(i,j)* &
3477 & average(ng)%avgDU_avg2(i,j)
3478 END DO
3479 END DO
3480 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3481 CALL exchange_u2d_tile (ng, tile, &
3482 & lbi, ubi, lbj, ubj, &
3483 & average(ng)%avgDU_avg2)
3484# ifdef DISTRIBUTE
3485 CALL mp_exchange2d (ng, tile, inlm, 1, &
3486 & lbi, ubi, lbj, ubj, &
3487 & nghostpoints, &
3488 & ewperiodic(ng), nsperiodic(ng), &
3489 & average(ng)%avgDU_avg2)
3490# endif
3491 END IF
3492 END IF
3493
3494 IF (aout(idvfx1,ng)) THEN
3495 DO j=jstr,jendr
3496 DO i=istrr,iendr
3497 average(ng)%avgDV_avg1(i,j)=vfac(i,j)* &
3498 & average(ng)%avgDV_avg1(i,j)
3499 END DO
3500 END DO
3501 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3502 CALL exchange_v2d_tile (ng, tile, &
3503 & lbi, ubi, lbj, ubj, &
3504 & average(ng)%avgDV_avg1)
3505# ifdef DISTRIBUTE
3506 CALL mp_exchange2d (ng, tile, inlm, 1, &
3507 & lbi, ubi, lbj, ubj, &
3508 & nghostpoints, &
3509 & ewperiodic(ng), nsperiodic(ng), &
3510 & average(ng)%avgDV_avg1)
3511# endif
3512 END IF
3513 END IF
3514
3515 IF (aout(idvfx2,ng)) THEN
3516 DO j=jstr,jendr
3517 DO i=istrr,iendr
3518 average(ng)%avgDV_avg2(i,j)=vfac(i,j)* &
3519 & average(ng)%avgDV_avg2(i,j)
3520 END DO
3521 END DO
3522 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3523 CALL exchange_v2d_tile (ng, tile, &
3524 & lbi, ubi, lbj, ubj, &
3525 & average(ng)%avgDV_avg2)
3526# ifdef DISTRIBUTE
3527 CALL mp_exchange2d (ng, tile, inlm, 1, &
3528 & lbi, ubi, lbj, ubj, &
3529 & nghostpoints, &
3530 & ewperiodic(ng), nsperiodic(ng), &
3531 & average(ng)%avgDV_avg2)
3532# endif
3533 END IF
3534 END IF
3535# endif
3536!
3537! Process surface and bottom fluxes.
3538!
3539 IF (aout(idusms,ng)) THEN
3540 DO j=jstrr,jendr
3541 DO i=istr,iendr
3542 average(ng)%avgsus(i,j)=ufac(i,j)* &
3543 & average(ng)%avgsus(i,j)
3544 END DO
3545 END DO
3546 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3547 CALL exchange_u2d_tile (ng, tile, &
3548 & lbi, ubi, lbj, ubj, &
3549 & average(ng)%avgsus)
3550# ifdef DISTRIBUTE
3551 CALL mp_exchange2d (ng, tile, inlm, 1, &
3552 & lbi, ubi, lbj, ubj, &
3553 & nghostpoints, &
3554 & ewperiodic(ng), nsperiodic(ng), &
3555 & average(ng)%avgsus)
3556# endif
3557 END IF
3558 END IF
3559
3560 IF (aout(idvsms,ng)) THEN
3561 DO j=jstr,jendr
3562 DO i=istrr,iendr
3563 average(ng)%avgsvs(i,j)=vfac(i,j)* &
3564 & average(ng)%avgsvs(i,j)
3565 END DO
3566 END DO
3567 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3568 CALL exchange_v2d_tile (ng, tile, &
3569 & lbi, ubi, lbj, ubj, &
3570 & average(ng)%avgsvs)
3571# ifdef DISTRIBUTE
3572 CALL mp_exchange2d (ng, tile, inlm, 1, &
3573 & lbi, ubi, lbj, ubj, &
3574 & nghostpoints, &
3575 & ewperiodic(ng), nsperiodic(ng), &
3576 & average(ng)%avgsvs)
3577# endif
3578 END IF
3579 END IF
3580
3581 IF (aout(idubms,ng)) THEN
3582 DO j=jstrr,jendr
3583 DO i=istr,iendr
3584 average(ng)%avgbus(i,j)=ufac(i,j)* &
3585 & average(ng)%avgbus(i,j)
3586 END DO
3587 END DO
3588 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3589 CALL exchange_u2d_tile (ng, tile, &
3590 & lbi, ubi, lbj, ubj, &
3591 & average(ng)%avgbus)
3592# ifdef DISTRIBUTE
3593 CALL mp_exchange2d (ng, tile, inlm, 1, &
3594 & lbi, ubi, lbj, ubj, &
3595 & nghostpoints, &
3596 & ewperiodic(ng), nsperiodic(ng), &
3597 & average(ng)%avgbus)
3598# endif
3599 END IF
3600 END IF
3601
3602 IF (aout(idvbms,ng)) THEN
3603 DO j=jstr,jendr
3604 DO i=istrr,iendr
3605 average(ng)%avgbvs(i,j)=vfac(i,j)* &
3606 & average(ng)%avgbvs(i,j)
3607 END DO
3608 END DO
3609 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3610 CALL exchange_v2d_tile (ng, tile, &
3611 & lbi, ubi, lbj, ubj, &
3612 & average(ng)%avgbvs)
3613# ifdef DISTRIBUTE
3614 CALL mp_exchange2d (ng, tile, inlm, 1, &
3615 & lbi, ubi, lbj, ubj, &
3616 & nghostpoints, &
3617 & ewperiodic(ng), nsperiodic(ng), &
3618 & average(ng)%avgbvs)
3619# endif
3620 END IF
3621 END IF
3622# ifdef BBL
3623 IF (aout(idubrs,ng)) THEN
3624 DO j=jstrr,jendr
3625 DO i=istrr,iendr
3626 average(ng)%avgUbrs(i,j)=rfac(i,j)* &
3627 & average(ng)%avgUbrs(i,j)
3628 END DO
3629 END DO
3630 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3631 CALL exchange_r2d_tile (ng, tile, &
3632 & lbi, ubi, lbj, ubj, &
3633 & average(ng)%avgUbrs)
3634# ifdef DISTRIBUTE
3635 CALL mp_exchange2d (ng, tile, inlm, 1, &
3636 & lbi, ubi, lbj, ubj, &
3637 & nghostpoints, &
3638 & ewperiodic(ng), nsperiodic(ng), &
3639 & average(ng)%avgUbrs)
3640# endif
3641 END IF
3642 END IF
3643 IF (aout(idvbrs,ng)) THEN
3644 DO j=jstrr,jendr
3645 DO i=istrr,iendr
3646 average(ng)%avgVbrs(i,j)=rfac(i,j)* &
3647 & average(ng)%avgVbrs(i,j)
3648 END DO
3649 END DO
3650 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3651 CALL exchange_r2d_tile (ng, tile, &
3652 & lbi, ubi, lbj, ubj, &
3653 & average(ng)%avgVbrs)
3654# ifdef DISTRIBUTE
3655 CALL mp_exchange2d (ng, tile, inlm, 1, &
3656 & lbi, ubi, lbj, ubj, &
3657 & nghostpoints, &
3658 & ewperiodic(ng), nsperiodic(ng), &
3659 & average(ng)%avgVbrs)
3660# endif
3661 END IF
3662 END IF
3663 IF (aout(idubws,ng)) THEN
3664 DO j=jstrr,jendr
3665 DO i=istrr,iendr
3666 average(ng)%avgUbws(i,j)=rfac(i,j)* &
3667 & average(ng)%avgUbws(i,j)
3668 END DO
3669 END DO
3670 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3671 CALL exchange_r2d_tile (ng, tile, &
3672 & lbi, ubi, lbj, ubj, &
3673 & average(ng)%avgUbws)
3674# ifdef DISTRIBUTE
3675 CALL mp_exchange2d (ng, tile, inlm, 1, &
3676 & lbi, ubi, lbj, ubj, &
3677 & nghostpoints, &
3678 & ewperiodic(ng), nsperiodic(ng), &
3679 & average(ng)%avgUbws)
3680# endif
3681 END IF
3682 END IF
3683 IF (aout(idvbws,ng)) THEN
3684 DO j=jstrr,jendr
3685 DO i=istrr,iendr
3686 average(ng)%avgVbws(i,j)=rfac(i,j)* &
3687 & average(ng)%avgVbws(i,j)
3688 END DO
3689 END DO
3690 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3691 CALL exchange_r2d_tile (ng, tile, &
3692 & lbi, ubi, lbj, ubj, &
3693 & average(ng)%avgVbws)
3694# ifdef DISTRIBUTE
3695 CALL mp_exchange2d (ng, tile, inlm, 1, &
3696 & lbi, ubi, lbj, ubj, &
3697 & nghostpoints, &
3698 & ewperiodic(ng), nsperiodic(ng), &
3699 & average(ng)%avgVbws)
3700# endif
3701 END IF
3702 END IF
3703 IF (aout(idubcs,ng)) THEN
3704 DO j=jstrr,jendr
3705 DO i=istrr,iendr
3706 average(ng)%avgUbcs(i,j)=rfac(i,j)* &
3707 & average(ng)%avgUbcs(i,j)
3708 END DO
3709 END DO
3710 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3711 CALL exchange_r2d_tile (ng, tile, &
3712 & lbi, ubi, lbj, ubj, &
3713 & average(ng)%avgUbcs)
3714# ifdef DISTRIBUTE
3715 CALL mp_exchange2d (ng, tile, inlm, 1, &
3716 & lbi, ubi, lbj, ubj, &
3717 & nghostpoints, &
3718 & ewperiodic(ng), nsperiodic(ng), &
3719 & average(ng)%avgUbcs)
3720# endif
3721 END IF
3722 END IF
3723 IF (aout(idvbcs,ng)) THEN
3724 DO j=jstrr,jendr
3725 DO i=istrr,iendr
3726 average(ng)%avgVbcs(i,j)=rfac(i,j)* &
3727 & average(ng)%avgVbcs(i,j)
3728 END DO
3729 END DO
3730 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3731 CALL exchange_r2d_tile (ng, tile, &
3732 & lbi, ubi, lbj, ubj, &
3733 & average(ng)%avgVbcs)
3734# ifdef DISTRIBUTE
3735 CALL mp_exchange2d (ng, tile, inlm, 1, &
3736 & lbi, ubi, lbj, ubj, &
3737 & nghostpoints, &
3738 & ewperiodic(ng), nsperiodic(ng), &
3739 & average(ng)%avgVbcs)
3740# endif
3741 END IF
3742 END IF
3743 IF (aout(iduvwc,ng)) THEN
3744 DO j=jstrr,jendr
3745 DO i=istrr,iendr
3746 average(ng)%avgUVwc(i,j)=rfac(i,j)* &
3747 & average(ng)%avgUVwc(i,j)
3748 END DO
3749 END DO
3750 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3751 CALL exchange_r2d_tile (ng, tile, &
3752 & lbi, ubi, lbj, ubj, &
3753 & average(ng)%avgUVwc)
3754# ifdef DISTRIBUTE
3755 CALL mp_exchange2d (ng, tile, inlm, 1, &
3756 & lbi, ubi, lbj, ubj, &
3757 & nghostpoints, &
3758 & ewperiodic(ng), nsperiodic(ng), &
3759 & average(ng)%avgUVwc)
3760# endif
3761 END IF
3762 END IF
3763 IF (aout(idubot,ng)) THEN
3764 DO j=jstrr,jendr
3765 DO i=istrr,iendr
3766 average(ng)%avgUbot(i,j)=rfac(i,j)* &
3767 & average(ng)%avgUbot(i,j)
3768 END DO
3769 END DO
3770 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3771 CALL exchange_r2d_tile (ng, tile, &
3772 & lbi, ubi, lbj, ubj, &
3773 & average(ng)%avgUbot)
3774# ifdef DISTRIBUTE
3775 CALL mp_exchange2d (ng, tile, inlm, 1, &
3776 & lbi, ubi, lbj, ubj, &
3777 & nghostpoints, &
3778 & ewperiodic(ng), nsperiodic(ng), &
3779 & average(ng)%avgUbot)
3780# endif
3781 END IF
3782 END IF
3783 IF (aout(idvbot,ng)) THEN
3784 DO j=jstrr,jendr
3785 DO i=istrr,iendr
3786 average(ng)%avgVbot(i,j)=rfac(i,j)* &
3787 & average(ng)%avgVbot(i,j)
3788 END DO
3789 END DO
3790 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3791 CALL exchange_r2d_tile (ng, tile, &
3792 & lbi, ubi, lbj, ubj, &
3793 & average(ng)%avgVbot)
3794# ifdef DISTRIBUTE
3795 CALL mp_exchange2d (ng, tile, inlm, 1, &
3796 & lbi, ubi, lbj, ubj, &
3797 & nghostpoints, &
3798 & ewperiodic(ng), nsperiodic(ng), &
3799 & average(ng)%avgVbot)
3800# endif
3801 END IF
3802 END IF
3803 IF (aout(idubur,ng)) THEN
3804 DO j=jstrr,jendr
3805 DO i=istrr,iendr
3806 average(ng)%avgUbur(i,j)=rfac(i,j)* &
3807 & average(ng)%avgUbur(i,j)
3808 END DO
3809 END DO
3810 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3811 CALL exchange_r2d_tile (ng, tile, &
3812 & lbi, ubi, lbj, ubj, &
3813 & average(ng)%avgUbur)
3814# ifdef DISTRIBUTE
3815 CALL mp_exchange2d (ng, tile, inlm, 1, &
3816 & lbi, ubi, lbj, ubj, &
3817 & nghostpoints, &
3818 & ewperiodic(ng), nsperiodic(ng), &
3819 & average(ng)%avgUbur)
3820# endif
3821 END IF
3822 END IF
3823 IF (aout(idvbvr,ng)) THEN
3824 DO j=jstrr,jendr
3825 DO i=istrr,iendr
3826 average(ng)%avgVbvr(i,j)=rfac(i,j)* &
3827 & average(ng)%avgVbvr(i,j)
3828 END DO
3829 END DO
3830 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3831 CALL exchange_r2d_tile (ng, tile, &
3832 & lbi, ubi, lbj, ubj, &
3833 & average(ng)%avgVbvr)
3834# ifdef DISTRIBUTE
3835 CALL mp_exchange2d (ng, tile, inlm, 1, &
3836 & lbi, ubi, lbj, ubj, &
3837 & nghostpoints, &
3838 & ewperiodic(ng), nsperiodic(ng), &
3839 & average(ng)%avgVbvr)
3840# endif
3841 END IF
3842 END IF
3843# endif
3844# ifdef SOLVE3D
3845# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
3846 IF (aout(idpair,ng)) THEN
3847 DO j=jstrr,jendr
3848 DO i=istrr,iendr
3849 average(ng)%avgPair(i,j)=rfac(i,j)* &
3850 & average(ng)%avgPair(i,j)
3851 END DO
3852 END DO
3853 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3854 CALL exchange_r2d_tile (ng, tile, &
3855 & lbi, ubi, lbj, ubj, &
3856 & average(ng)%avgPair)
3857# ifdef DISTRIBUTE
3858 CALL mp_exchange2d (ng, tile, inlm, 1, &
3859 & lbi, ubi, lbj, ubj, &
3860 & nghostpoints, &
3861 & ewperiodic(ng), nsperiodic(ng), &
3862 & average(ng)%avgPair)
3863# endif
3864 END IF
3865 END IF
3866# endif
3867
3868# if defined BULK_FLUXES
3869 IF (aout(idtair,ng)) THEN
3870 DO j=jstrr,jendr
3871 DO i=istrr,iendr
3872 average(ng)%avgTair(i,j)=rfac(i,j)* &
3873 & average(ng)%avgTair(i,j)
3874 END DO
3875 END DO
3876 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3877 CALL exchange_r2d_tile (ng, tile, &
3878 & lbi, ubi, lbj, ubj, &
3879 & average(ng)%avgTair)
3880# ifdef DISTRIBUTE
3881 CALL mp_exchange2d (ng, tile, inlm, 1, &
3882 & lbi, ubi, lbj, ubj, &
3883 & nghostpoints, &
3884 & ewperiodic(ng), nsperiodic(ng), &
3885 & average(ng)%avgTair)
3886# endif
3887 END IF
3888 END IF
3889# endif
3890
3891# if defined BULK_FLUXES || defined ECOSIM
3892 IF (aout(iduair,ng)) THEN
3893 DO j=jstrr,jendr
3894 DO i=istrr,iendr
3895 average(ng)%avgUwind(i,j)=rfac(i,j)* &
3896 & average(ng)%avgUwind(i,j)
3897 END DO
3898 END DO
3899 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3900 CALL exchange_r2d_tile (ng, tile, &
3901 & lbi, ubi, lbj, ubj, &
3902 & average(ng)%avgUwind)
3903# ifdef DISTRIBUTE
3904 CALL mp_exchange2d (ng, tile, inlm, 1, &
3905 & lbi, ubi, lbj, ubj, &
3906 & nghostpoints, &
3907 & ewperiodic(ng), nsperiodic(ng), &
3908 & average(ng)%avgUwind)
3909# endif
3910 END IF
3911 END IF
3912
3913 IF (aout(idvair,ng)) THEN
3914 DO j=jstrr,jendr
3915 DO i=istrr,iendr
3916 average(ng)%avgVwind(i,j)=rfac(i,j)* &
3917 & average(ng)%avgVwind(i,j)
3918 END DO
3919 END DO
3920 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3921 CALL exchange_r2d_tile (ng, tile, &
3922 & lbi, ubi, lbj, ubj, &
3923 & average(ng)%avgVwind)
3924# ifdef DISTRIBUTE
3925 CALL mp_exchange2d (ng, tile, inlm, 1, &
3926 & lbi, ubi, lbj, ubj, &
3927 & nghostpoints, &
3928 & ewperiodic(ng), nsperiodic(ng), &
3929 & average(ng)%avgVwind)
3930# endif
3931 END IF
3932 END IF
3933
3934 IF (aout(iduaie,ng).and.aout(idvain,ng)) THEN
3935 DO j=jstr,jend
3936 DO i=istr,iend
3937 average(ng)%avgUwindE(i,j)=rfac(i,j)* &
3938 & average(ng)%avgUwindE(i,j)
3939 average(ng)%avgVwindN(i,j)=rfac(i,j)* &
3940 & average(ng)%avgVwindN(i,j)
3941 END DO
3942 END DO
3943 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3944 CALL exchange_r2d_tile (ng, tile, &
3945 & lbi, ubi, lbj, ubj, &
3946 & average(ng)%avgUwindE)
3947 CALL exchange_r2d_tile (ng, tile, &
3948 & lbi, ubi, lbj, ubj, &
3949 & average(ng)%avgVwindN)
3950# ifdef DISTRIBUTE
3951 CALL mp_exchange2d (ng, tile, inlm, 2, &
3952 & lbi, ubi, lbj, ubj, &
3953 & nghostpoints, &
3954 & ewperiodic(ng), nsperiodic(ng), &
3955 & average(ng)%avgUwindE, &
3956 & average(ng)%avgVwindN)
3957# endif
3958 END IF
3959 END IF
3960# endif
3961
3962 IF (aout(idtsur(itemp),ng)) THEN
3963 DO j=jstrr,jendr
3964 DO i=istrr,iendr
3965 average(ng)%avgstf(i,j)=rfac(i,j)* &
3966 & average(ng)%avgstf(i,j)
3967 END DO
3968 END DO
3969 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3970 CALL exchange_r2d_tile (ng, tile, &
3971 & lbi, ubi, lbj, ubj, &
3972 & average(ng)%avgstf)
3973# ifdef DISTRIBUTE
3974 CALL mp_exchange2d (ng, tile, inlm, 1, &
3975 & lbi, ubi, lbj, ubj, &
3976 & nghostpoints, &
3977 & ewperiodic(ng), nsperiodic(ng), &
3978 & average(ng)%avgstf)
3979# endif
3980 END IF
3981 END IF
3982
3983# ifdef SALINITY
3984 IF (aout(idtsur(isalt),ng)) THEN
3985 DO j=jstrr,jendr
3986 DO i=istrr,iendr
3987 average(ng)%avgswf(i,j)=rfac(i,j)* &
3988 & average(ng)%avgswf(i,j)
3989 END DO
3990 END DO
3991 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3992 CALL exchange_r2d_tile (ng, tile, &
3993 & lbi, ubi, lbj, ubj, &
3994 & average(ng)%avgswf)
3995# ifdef DISTRIBUTE
3996 CALL mp_exchange2d (ng, tile, inlm, 1, &
3997 & lbi, ubi, lbj, ubj, &
3998 & nghostpoints, &
3999 & ewperiodic(ng), nsperiodic(ng), &
4000 & average(ng)%avgswf)
4001# endif
4002 END IF
4003 END IF
4004# endif
4005
4006# ifdef SHORTWAVE
4007 IF (aout(idsrad,ng)) THEN
4008 DO j=jstrr,jendr
4009 DO i=istrr,iendr
4010 average(ng)%avgsrf(i,j)=rfac(i,j)* &
4011 & average(ng)%avgsrf(i,j)
4012 END DO
4013 END DO
4014 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4015 CALL exchange_r2d_tile (ng, tile, &
4016 & lbi, ubi, lbj, ubj, &
4017 & average(ng)%avgsrf)
4018# ifdef DISTRIBUTE
4019 CALL mp_exchange2d (ng, tile, inlm, 1, &
4020 & lbi, ubi, lbj, ubj, &
4021 & nghostpoints, &
4022 & ewperiodic(ng), nsperiodic(ng), &
4023 & average(ng)%avgsrf)
4024# endif
4025 END IF
4026 END IF
4027# endif
4028
4029# if defined BULK_FLUXES || defined FRC_COUPLING
4030 IF (aout(idlhea,ng)) THEN
4031 DO j=jstrr,jendr
4032 DO i=istrr,iendr
4033 average(ng)%avglhf(i,j)=rfac(i,j)* &
4034 & average(ng)%avglhf(i,j)
4035 END DO
4036 END DO
4037 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4038 CALL exchange_r2d_tile (ng, tile, &
4039 & lbi, ubi, lbj, ubj, &
4040 & average(ng)%avglhf)
4041# ifdef DISTRIBUTE
4042 CALL mp_exchange2d (ng, tile, inlm, 1, &
4043 & lbi, ubi, lbj, ubj, &
4044 & nghostpoints, &
4045 & ewperiodic(ng), nsperiodic(ng), &
4046 & average(ng)%avglhf)
4047# endif
4048 END IF
4049 END IF
4050
4051 IF (aout(idshea,ng)) THEN
4052 DO j=jstrr,jendr
4053 DO i=istrr,iendr
4054 average(ng)%avgshf(i,j)=rfac(i,j)* &
4055 & average(ng)%avgshf(i,j)
4056 END DO
4057 END DO
4058 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4059 CALL exchange_r2d_tile (ng, tile, &
4060 & lbi, ubi, lbj, ubj, &
4061 & average(ng)%avgshf)
4062# ifdef DISTRIBUTE
4063 CALL mp_exchange2d (ng, tile, inlm, 1, &
4064 & lbi, ubi, lbj, ubj, &
4065 & nghostpoints, &
4066 & ewperiodic(ng), nsperiodic(ng), &
4067 & average(ng)%avgshf)
4068# endif
4069 END IF
4070 END IF
4071
4072 IF (aout(idlrad,ng)) THEN
4073 DO j=jstrr,jendr
4074 DO i=istrr,iendr
4075 average(ng)%avglrf(i,j)=rfac(i,j)* &
4076 & average(ng)%avglrf(i,j)
4077 END DO
4078 END DO
4079 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4080 CALL exchange_r2d_tile (ng, tile, &
4081 & lbi, ubi, lbj, ubj, &
4082 & average(ng)%avglrf)
4083# ifdef DISTRIBUTE
4084 CALL mp_exchange2d (ng, tile, inlm, 1, &
4085 & lbi, ubi, lbj, ubj, &
4086 & nghostpoints, &
4087 & ewperiodic(ng), nsperiodic(ng), &
4088 & average(ng)%avglrf)
4089# endif
4090 END IF
4091 END IF
4092# endif
4093
4094# if defined BULK_FLUXES && defined EMINUSP
4095 IF (aout(idevap,ng)) THEN
4096 DO j=jstrr,jendr
4097 DO i=istrr,iendr
4098 average(ng)%avgevap(i,j)=rfac(i,j)* &
4099 & average(ng)%avgevap(i,j)
4100 END DO
4101 END DO
4102 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4103 CALL exchange_r2d_tile (ng, tile, &
4104 & lbi, ubi, lbj, ubj, &
4105 & average(ng)%avgevap)
4106# ifdef DISTRIBUTE
4107 CALL mp_exchange2d (ng, tile, inlm, 1, &
4108 & lbi, ubi, lbj, ubj, &
4109 & nghostpoints, &
4110 & ewperiodic(ng), nsperiodic(ng), &
4111 & average(ng)%avgevap)
4112# endif
4113 END IF
4114 END IF
4115
4116 IF (aout(idrain,ng)) THEN
4117 DO j=jstrr,jendr
4118 DO i=istrr,iendr
4119 average(ng)%avgrain(i,j)=rfac(i,j)* &
4120 & average(ng)%avgrain(i,j)
4121 END DO
4122 END DO
4123 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4124 CALL exchange_r2d_tile (ng, tile, &
4125 & lbi, ubi, lbj, ubj, &
4126 & average(ng)%avgrain)
4127# ifdef DISTRIBUTE
4128 CALL mp_exchange2d (ng, tile, inlm, 1, &
4129 & lbi, ubi, lbj, ubj, &
4130 & nghostpoints, &
4131 & ewperiodic(ng), nsperiodic(ng), &
4132 & average(ng)%avgrain)
4133# endif
4134 END IF
4135 END IF
4136# endif
4137# endif
4138# ifdef WEC
4139!
4140! Process Waves Effect on Currents fields.
4141!
4142 IF (aout(idu2sd,ng)) THEN
4143 DO j=jstrr,jendr
4144 DO i=istr,iendr
4145 average(ng)%avgu2Sd(i,j)=ufac(i,j)* &
4146 & average(ng)%avgu2Sd(i,j)
4147 END DO
4148 END DO
4149 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4150 CALL exchange_u2d_tile (ng, tile, &
4151 & lbi, ubi, lbj, ubj, &
4152 & average(ng)%avgu2Sd)
4153# ifdef DISTRIBUTE
4154 CALL mp_exchange2d (ng, tile, inlm, 1, &
4155 & lbi, ubi, lbj, ubj, &
4156 & nghostpoints, &
4157 & ewperiodic(ng), nsperiodic(ng), &
4158 & average(ng)%avgu2Sd)
4159# endif
4160 END IF
4161 END IF
4162
4163 IF (aout(idv2sd,ng)) THEN
4164 DO j=jstr,jendr
4165 DO i=istrr,iendr
4166 average(ng)%avgv2Sd(i,j)=vfac(i,j)* &
4167 & average(ng)%avgv2Sd(i,j)
4168 END DO
4169 END DO
4170 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4171 CALL exchange_v2d_tile (ng, tile, &
4172 & lbi, ubi, lbj, ubj, &
4173 & average(ng)%avgv2Sd)
4174# ifdef DISTRIBUTE
4175 CALL mp_exchange2d (ng, tile, inlm, 1, &
4176 & lbi, ubi, lbj, ubj, &
4177 & nghostpoints, &
4178 & ewperiodic(ng), nsperiodic(ng), &
4179 & average(ng)%avgv2Sd)
4180# endif
4181 END IF
4182 END IF
4183
4184 IF (aout(idu2rs,ng)) THEN
4185 DO j=jstrr,jendr
4186 DO i=istr,iendr
4187 average(ng)%avgu2rs(i,j)=ufac(i,j)* &
4188 & average(ng)%avgu2rs(i,j)
4189 END DO
4190 END DO
4191 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4192 CALL exchange_u2d_tile (ng, tile, &
4193 & lbi, ubi, lbj, ubj, &
4194 & average(ng)%avgu2rs)
4195# ifdef DISTRIBUTE
4196 CALL mp_exchange2d (ng, tile, inlm, 1, &
4197 & lbi, ubi, lbj, ubj, &
4198 & nghostpoints, &
4199 & ewperiodic(ng), nsperiodic(ng), &
4200 & average(ng)%avgu2rs)
4201# endif
4202 END IF
4203 END IF
4204
4205 IF (aout(idv2rs,ng)) THEN
4206 DO j=jstr,jendr
4207 DO i=istrr,iendr
4208 average(ng)%avgv2rs(i,j)=vfac(i,j)* &
4209 & average(ng)%avgv2rs(i,j)
4210 END DO
4211 END DO
4212 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4213 CALL exchange_v2d_tile (ng, tile, &
4214 & lbi, ubi, lbj, ubj, &
4215 & average(ng)%avgv2rs)
4216# ifdef DISTRIBUTE
4217 CALL mp_exchange2d (ng, tile, inlm, 1, &
4218 & lbi, ubi, lbj, ubj, &
4219 & nghostpoints, &
4220 & ewperiodic(ng), nsperiodic(ng), &
4221 & average(ng)%avgv2rs)
4222# endif
4223 END IF
4224 END IF
4225# endif
4226# ifdef WEC
4227# ifdef SOLVE3D
4228 IF (aout(idu3sd,ng)) THEN
4229 DO k=1,n(ng)
4230 DO j=jstrr,jendr
4231 DO i=istr,iendr
4232 average(ng)%avgu3Sd(i,j,k)=ufac(i,j)* &
4233 & average(ng)%avgu3Sd(i,j,k)
4234 END DO
4235 END DO
4236 END DO
4237 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4238 CALL exchange_u3d_tile (ng, tile, &
4239 & lbi, ubi, lbj, ubj, 1, n(ng), &
4240 & average(ng)%avgu3Sd)
4241# ifdef DISTRIBUTE
4242 CALL mp_exchange3d (ng, tile, inlm, 1, &
4243 & lbi, ubi, lbj, ubj, 1, n(ng), &
4244 & nghostpoints, &
4245 & ewperiodic(ng), nsperiodic(ng), &
4246 & average(ng)%avgu3Sd)
4247# endif
4248 END IF
4249 END IF
4250
4251 IF (aout(idv3sd,ng)) THEN
4252 DO k=1,n(ng)
4253 DO j=jstr,jendr
4254 DO i=istrr,iendr
4255 average(ng)%avgv3Sd(i,j,k)=vfac(i,j)* &
4256 & average(ng)%avgv3Sd(i,j,k)
4257 END DO
4258 END DO
4259 END DO
4260 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4261 CALL exchange_v3d_tile (ng, tile, &
4262 & lbi, ubi, lbj, ubj, 1, n(ng), &
4263 & average(ng)%avgv3Sd)
4264# ifdef DISTRIBUTE
4265 CALL mp_exchange3d (ng, tile, inlm, 1, &
4266 & lbi, ubi, lbj, ubj, 1, n(ng), &
4267 & nghostpoints, &
4268 & ewperiodic(ng), nsperiodic(ng), &
4269 & average(ng)%avgv3Sd)
4270# endif
4271 END IF
4272 END IF
4273
4274 IF (aout(idu3rs,ng)) THEN
4275 DO k=1,n(ng)
4276 DO j=jstrr,jendr
4277 DO i=istr,iendr
4278 average(ng)%avgu3rs(i,j,k)=ufac(i,j)* &
4279 & average(ng)%avgu3rs(i,j,k)
4280 END DO
4281 END DO
4282 END DO
4283 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4284 CALL exchange_u3d_tile (ng, tile, &
4285 & lbi, ubi, lbj, ubj, 1, n(ng), &
4286 & average(ng)%avgu3rs)
4287# ifdef DISTRIBUTE
4288 CALL mp_exchange3d (ng, tile, inlm, 1, &
4289 & lbi, ubi, lbj, ubj, 1, n(ng), &
4290 & nghostpoints, &
4291 & ewperiodic(ng), nsperiodic(ng), &
4292 & average(ng)%avgu3rs)
4293# endif
4294 END IF
4295 END IF
4296
4297 IF (aout(idv3rs,ng)) THEN
4298 DO k=1,n(ng)
4299 DO j=jstr,jendr
4300 DO i=istrr,iendr
4301 average(ng)%avgv3RS(i,j,k)=vfac(i,j)* &
4302 & average(ng)%avgv3RS(i,j,k)
4303 END DO
4304 END DO
4305 END DO
4306 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4307 CALL exchange_v3d_tile (ng, tile, &
4308 & lbi, ubi, lbj, ubj, 1, n(ng), &
4309 & average(ng)%avgv3RS)
4310# ifdef DISTRIBUTE
4311 CALL mp_exchange3d (ng, tile, inlm, 1, &
4312 & lbi, ubi, lbj, ubj, 1, n(ng), &
4313 & nghostpoints, &
4314 & ewperiodic(ng), nsperiodic(ng), &
4315 & average(ng)%avgv3RS)
4316# endif
4317 END IF
4318 END IF
4319
4320 IF (aout(idw3sd,ng)) THEN
4321 DO k=1,n(ng)
4322 DO j=jstr,jendr
4323 DO i=istrr,iendr
4324 average(ng)%avgW3Sd(i,j,k)=rfac(i,j)* &
4325 & average(ng)%avgW3Sd(i,j,k)
4326 END DO
4327 END DO
4328 END DO
4329 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4330 CALL exchange_v3d_tile (ng, tile, &
4331 & lbi, ubi, lbj, ubj, 1, n(ng), &
4332 & average(ng)%avgW3Sd)
4333# ifdef DISTRIBUTE
4334 CALL mp_exchange3d (ng, tile, inlm, 1, &
4335 & lbi, ubi, lbj, ubj, 1, n(ng), &
4336 & nghostpoints, &
4337 & ewperiodic(ng), nsperiodic(ng), &
4338 & average(ng)%avgW3Sd)
4339# endif
4340 END IF
4341 END IF
4342 IF (aout(idw3st,ng)) THEN
4343 DO k=1,n(ng)
4344 DO j=jstr,jendr
4345 DO i=istrr,iendr
4346 average(ng)%avgW3St(i,j,k)=rfac(i,j)* &
4347 & average(ng)%avgW3St(i,j,k)
4348 END DO
4349 END DO
4350 END DO
4351 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4352 CALL exchange_v3d_tile (ng, tile, &
4353 & lbi, ubi, lbj, ubj, 1, n(ng), &
4354 & average(ng)%avgW3St)
4355# ifdef DISTRIBUTE
4356 CALL mp_exchange3d (ng, tile, inlm, 1, &
4357 & lbi, ubi, lbj, ubj, 1, n(ng), &
4358 & nghostpoints, &
4359 & ewperiodic(ng), nsperiodic(ng), &
4360 & average(ng)%avgW3St)
4361# endif
4362 END IF
4363 END IF
4364# endif
4365# endif
4366# ifdef WEC_VF
4367 IF (aout(idwztw,ng)) THEN
4368 DO j=jstrr,jendr
4369 DO i=istrr,iendr
4370 average(ng)%avgWztw(i,j)=rfac(i,j)* &
4371 & average(ng)%avgWztw(i,j)
4372 END DO
4373 END DO
4374 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4375 CALL exchange_r2d_tile (ng, tile, &
4376 & lbi, ubi, lbj, ubj, &
4377 & average(ng)%avgWztw)
4378# ifdef DISTRIBUTE
4379 CALL mp_exchange2d (ng, tile, inlm, 1, &
4380 & lbi, ubi, lbj, ubj, &
4381 & nghostpoints, &
4382 & ewperiodic(ng), nsperiodic(ng), &
4383 & average(ng)%avgWztw)
4384# endif
4385 END IF
4386 END IF
4387 IF (aout(idwqsp,ng)) THEN
4388 DO j=jstrr,jendr
4389 DO i=istrr,iendr
4390 average(ng)%avgWqsp(i,j)=rfac(i,j)* &
4391 & average(ng)%avgWqsp(i,j)
4392 END DO
4393 END DO
4394 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4395 CALL exchange_r2d_tile (ng, tile, &
4396 & lbi, ubi, lbj, ubj, &
4397 & average(ng)%avgWqsp)
4398# ifdef DISTRIBUTE
4399 CALL mp_exchange2d (ng, tile, inlm, 1, &
4400 & lbi, ubi, lbj, ubj, &
4401 & nghostpoints, &
4402 & ewperiodic(ng), nsperiodic(ng), &
4403 & average(ng)%avgWqsp)
4404# endif
4405 END IF
4406 END IF
4407 IF (aout(idwbeh,ng)) THEN
4408 DO j=jstrr,jendr
4409 DO i=istrr,iendr
4410 average(ng)%avgWbeh(i,j)=rfac(i,j)* &
4411 & average(ng)%avgWbeh(i,j)
4412 END DO
4413 END DO
4414 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4415 CALL exchange_r2d_tile (ng, tile, &
4416 & lbi, ubi, lbj, ubj, &
4417 & average(ng)%avgWbeh)
4418# ifdef DISTRIBUTE
4419 CALL mp_exchange2d (ng, tile, inlm, 1, &
4420 & lbi, ubi, lbj, ubj, &
4421 & nghostpoints, &
4422 & ewperiodic(ng), nsperiodic(ng), &
4423 & average(ng)%avgWbeh)
4424# endif
4425 END IF
4426 END IF
4427# endif
4428# ifdef WAVES_HEIGHT
4429 IF (aout(idwamp,ng)) THEN
4430 DO j=jstrr,jendr
4431 DO i=istrr,iendr
4432 average(ng)%avgWamp(i,j)=rfac(i,j)* &
4433 & average(ng)%avgWamp(i,j)
4434 END DO
4435 END DO
4436 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4437 CALL exchange_r2d_tile (ng, tile, &
4438 & lbi, ubi, lbj, ubj, &
4439 & average(ng)%avgWamp)
4440# ifdef DISTRIBUTE
4441 CALL mp_exchange2d (ng, tile, inlm, 1, &
4442 & lbi, ubi, lbj, ubj, &
4443 & nghostpoints, &
4444 & ewperiodic(ng), nsperiodic(ng), &
4445 & average(ng)%avgWamp)
4446# endif
4447 END IF
4448 END IF
4449 IF (aout(idwam2,ng)) THEN
4450 DO j=jstrr,jendr
4451 DO i=istrr,iendr
4452 average(ng)%avgWam2(i,j)=rfac(i,j)* &
4453 & average(ng)%avgWam2(i,j)
4454 END DO
4455 END DO
4456 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4457 CALL exchange_r2d_tile (ng, tile, &
4458 & lbi, ubi, lbj, ubj, &
4459 & average(ng)%avgWam2)
4460# ifdef DISTRIBUTE
4461 CALL mp_exchange2d (ng, tile, inlm, 1, &
4462 & lbi, ubi, lbj, ubj, &
4463 & nghostpoints, &
4464 & ewperiodic(ng), nsperiodic(ng), &
4465 & average(ng)%avgWam2)
4466# endif
4467 END IF
4468 END IF
4469# endif
4470# ifdef WAVES_LENGTH
4471 IF (aout(idwlen,ng)) THEN
4472 DO j=jstrr,jendr
4473 DO i=istrr,iendr
4474 average(ng)%avgWlen(i,j)=rfac(i,j)* &
4475 & average(ng)%avgWlen(i,j)
4476 END DO
4477 END DO
4478 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4479 CALL exchange_r2d_tile (ng, tile, &
4480 & lbi, ubi, lbj, ubj, &
4481 & average(ng)%avgWlen)
4482# ifdef DISTRIBUTE
4483 CALL mp_exchange2d (ng, tile, inlm, 1, &
4484 & lbi, ubi, lbj, ubj, &
4485 & nghostpoints, &
4486 & ewperiodic(ng), nsperiodic(ng), &
4487 & average(ng)%avgWlen)
4488# endif
4489 END IF
4490 END IF
4491# endif
4492# ifdef WAVES_LENGTHP
4493 IF (aout(idwlep,ng)) THEN
4494 DO j=jstrr,jendr
4495 DO i=istrr,iendr
4496 average(ng)%avgWlep(i,j)=rfac(i,j)* &
4497 & average(ng)%avgWlep(i,j)
4498 END DO
4499 END DO
4500 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4501 CALL exchange_r2d_tile (ng, tile, &
4502 & lbi, ubi, lbj, ubj, &
4503 & average(ng)%avgWlep)
4504# ifdef DISTRIBUTE
4505 CALL mp_exchange2d (ng, tile, inlm, 1, &
4506 & lbi, ubi, lbj, ubj, &
4507 & nghostpoints, &
4508 & ewperiodic(ng), nsperiodic(ng), &
4509 & average(ng)%avgWlep)
4510# endif
4511 END IF
4512 END IF
4513# endif
4514# ifdef WAVES_DIR
4515 IF (aout(idwdir,ng)) THEN
4516 DO j=jstrr,jendr
4517 DO i=istrr,iendr
4518 average(ng)%avgWdir(i,j)=rfac(i,j)* &
4519 & average(ng)%avgWdir(i,j)
4520 END DO
4521 END DO
4522 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4523 CALL exchange_r2d_tile (ng, tile, &
4524 & lbi, ubi, lbj, ubj, &
4525 & average(ng)%avgWdir)
4526# ifdef DISTRIBUTE
4527 CALL mp_exchange2d (ng, tile, inlm, 1, &
4528 & lbi, ubi, lbj, ubj, &
4529 & nghostpoints, &
4530 & ewperiodic(ng), nsperiodic(ng), &
4531 & average(ng)%avgWdir)
4532# endif
4533 END IF
4534 END IF
4535# endif
4536# ifdef WAVES_DIRP
4537 IF (aout(idwdip,ng)) THEN
4538 DO j=jstrr,jendr
4539 DO i=istrr,iendr
4540 average(ng)%avgWdip(i,j)=rfac(i,j)* &
4541 & average(ng)%avgWdip(i,j)
4542 END DO
4543 END DO
4544 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4545 CALL exchange_r2d_tile (ng, tile, &
4546 & lbi, ubi, lbj, ubj, &
4547 & average(ng)%avgWdip)
4548# ifdef DISTRIBUTE
4549 CALL mp_exchange2d (ng, tile, inlm, 1, &
4550 & lbi, ubi, lbj, ubj, &
4551 & nghostpoints, &
4552 & ewperiodic(ng), nsperiodic(ng), &
4553 & average(ng)%avgWdip)
4554# endif
4555 END IF
4556 END IF
4557# endif
4558# ifdef WAVES_TOP_PERIOD
4559 IF (aout(idwptp,ng)) THEN
4560 DO j=jstrr,jendr
4561 DO i=istrr,iendr
4562 average(ng)%avgWptp(i,j)=rfac(i,j)* &
4563 & average(ng)%avgWptp(i,j)
4564 END DO
4565 END DO
4566 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4567 CALL exchange_r2d_tile (ng, tile, &
4568 & lbi, ubi, lbj, ubj, &
4569 & average(ng)%avgWptp)
4570# ifdef DISTRIBUTE
4571 CALL mp_exchange2d (ng, tile, inlm, 1, &
4572 & lbi, ubi, lbj, ubj, &
4573 & nghostpoints, &
4574 & ewperiodic(ng), nsperiodic(ng), &
4575 & average(ng)%avgWptp)
4576# endif
4577 END IF
4578 END IF
4579# endif
4580# ifdef WAVES_BOT_PERIOD
4581 IF (aout(idwpbt,ng)) THEN
4582 DO j=jstrr,jendr
4583 DO i=istrr,iendr
4584 average(ng)%avgWpbt(i,j)=rfac(i,j)* &
4585 & average(ng)%avgWpbt(i,j)
4586 END DO
4587 END DO
4588 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4589 CALL exchange_r2d_tile (ng, tile, &
4590 & lbi, ubi, lbj, ubj, &
4591 & average(ng)%avgWpbt)
4592# ifdef DISTRIBUTE
4593 CALL mp_exchange2d (ng, tile, inlm, 1, &
4594 & lbi, ubi, lbj, ubj, &
4595 & nghostpoints, &
4596 & ewperiodic(ng), nsperiodic(ng), &
4597 & average(ng)%avgWpbt)
4598# endif
4599 END IF
4600 END IF
4601# endif
4602# ifdef BBL_MODEL
4603 IF (aout(idworb,ng)) THEN
4604 DO j=jstrr,jendr
4605 DO i=istrr,iendr
4606 average(ng)%avgWorb(i,j)=rfac(i,j)* &
4607 & average(ng)%avgWorb(i,j)
4608 END DO
4609 END DO
4610 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4611 CALL exchange_r2d_tile (ng, tile, &
4612 & lbi, ubi, lbj, ubj, &
4613 & average(ng)%avgWorb)
4614# ifdef DISTRIBUTE
4615 CALL mp_exchange2d (ng, tile, inlm, 1, &
4616 & lbi, ubi, lbj, ubj, &
4617 & nghostpoints, &
4618 & ewperiodic(ng), nsperiodic(ng), &
4619 & average(ng)%avgWorb)
4620# endif
4621 END IF
4622 END IF
4623# endif
4624# if defined WAV_COUPLING || (defined WEC_VF && defined BOTTOM_STREAMING)
4625 IF (aout(idwdif,ng)) THEN
4626 DO j=jstrr,jendr
4627 DO i=istrr,iendr
4628 average(ng)%avgWdif(i,j)=rfac(i,j)* &
4629 & average(ng)%avgWdif(i,j)
4630 END DO
4631 END DO
4632 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4633 CALL exchange_r2d_tile (ng, tile, &
4634 & lbi, ubi, lbj, ubj, &
4635 & average(ng)%avgWdif)
4636# ifdef DISTRIBUTE
4637 CALL mp_exchange2d (ng, tile, inlm, 1, &
4638 & lbi, ubi, lbj, ubj, &
4639 & nghostpoints, &
4640 & ewperiodic(ng), nsperiodic(ng), &
4641 & average(ng)%avgWdif)
4642# endif
4643 END IF
4644 END IF
4645# endif
4646# if defined WAV_COUPLING || defined TKE_WAVEDISS || \
4647 defined wdiss_thorguza || defined wdiss_churthor
4648 IF (aout(idwdib,ng)) THEN
4649 DO j=jstrr,jendr
4650 DO i=istrr,iendr
4651 average(ng)%avgWdib(i,j)=rfac(i,j)* &
4652 & average(ng)%avgWdib(i,j)
4653 END DO
4654 END DO
4655 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4656 CALL exchange_r2d_tile (ng, tile, &
4657 & lbi, ubi, lbj, ubj, &
4658 & average(ng)%avgWdib)
4659# ifdef DISTRIBUTE
4660 CALL mp_exchange2d (ng, tile, inlm, 1, &
4661 & lbi, ubi, lbj, ubj, &
4662 & nghostpoints, &
4663 & ewperiodic(ng), nsperiodic(ng), &
4664 & average(ng)%avgWdib)
4665# endif
4666 END IF
4667 END IF
4668 IF (aout(idwdiw,ng)) THEN
4669 DO j=jstrr,jendr
4670 DO i=istrr,iendr
4671 average(ng)%avgWdiw(i,j)=rfac(i,j)* &
4672 & average(ng)%avgWdiw(i,j)
4673 END DO
4674 END DO
4675 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4676 CALL exchange_r2d_tile (ng, tile, &
4677 & lbi, ubi, lbj, ubj, &
4678 & average(ng)%avgWdiw)
4679# ifdef DISTRIBUTE
4680 CALL mp_exchange2d (ng, tile, inlm, 1, &
4681 & lbi, ubi, lbj, ubj, &
4682 & nghostpoints, &
4683 & ewperiodic(ng), nsperiodic(ng), &
4684 & average(ng)%avgWdiw)
4685# endif
4686 END IF
4687 END IF
4688# endif
4689# ifdef ROLLER_SVENDSEN
4690 IF (aout(idwbrk,ng)) THEN
4691 DO j=jstrr,jendr
4692 DO i=istrr,iendr
4693 average(ng)%avgWbrk(i,j)=rfac(i,j)* &
4694 & average(ng)%avgWbrk(i,j)
4695 END DO
4696 END DO
4697 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4698 CALL exchange_r2d_tile (ng, tile, &
4699 & lbi, ubi, lbj, ubj, &
4700 & average(ng)%avgWbrk)
4701# ifdef DISTRIBUTE
4702 CALL mp_exchange2d (ng, tile, inlm, 1, &
4703 & lbi, ubi, lbj, ubj, &
4704 & nghostpoints, &
4705 & ewperiodic(ng), nsperiodic(ng), &
4706 & average(ng)%avgWbrk)
4707# endif
4708 END IF
4709 END IF
4710# endif
4711# ifdef WEC_ROLLER
4712 IF (aout(idwdis,ng)) THEN
4713 DO j=jstrr,jendr
4714 DO i=istrr,iendr
4715 average(ng)%avgWdis(i,j)=rfac(i,j)* &
4716 & average(ng)%avgWdis(i,j)
4717 END DO
4718 END DO
4719 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4720 CALL exchange_r2d_tile (ng, tile, &
4721 & lbi, ubi, lbj, ubj, &
4722 & average(ng)%avgWdis)
4723# ifdef DISTRIBUTE
4724 CALL mp_exchange2d (ng, tile, inlm, 1, &
4725 & lbi, ubi, lbj, ubj, &
4726 & nghostpoints, &
4727 & ewperiodic(ng), nsperiodic(ng), &
4728 & average(ng)%avgWdis)
4729# endif
4730 END IF
4731 END IF
4732 IF (aout(idwrol,ng)) THEN
4733 DO j=jstrr,jendr
4734 DO i=istrr,iendr
4735 average(ng)%avgWrol(i,j)=rfac(i,j)* &
4736 & average(ng)%avgWrol(i,j)
4737 END DO
4738 END DO
4739 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4740 CALL exchange_r2d_tile (ng, tile, &
4741 & lbi, ubi, lbj, ubj, &
4742 & average(ng)%avgWrol)
4743# ifdef DISTRIBUTE
4744 CALL mp_exchange2d (ng, tile, inlm, 1, &
4745 & lbi, ubi, lbj, ubj, &
4746 & nghostpoints, &
4747 & ewperiodic(ng), nsperiodic(ng), &
4748 & average(ng)%avgWrol)
4749# endif
4750 END IF
4751 END IF
4752# endif
4753# ifdef UV_KIRBY
4754 IF (aout(iduwav,ng)) THEN
4755 DO j=jstrr,jendr
4756 DO i=istrr,iendr
4757 average(ng)%avgUwav(i,j)=rfac(i,j)* &
4758 & average(ng)%avgUwav(i,j)
4759 END DO
4760 END DO
4761 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4762 CALL exchange_r2d_tile (ng, tile, &
4763 & lbi, ubi, lbj, ubj, &
4764 & average(ng)%avgUwav)
4765# ifdef DISTRIBUTE
4766 CALL mp_exchange2d (ng, tile, inlm, 1, &
4767 & lbi, ubi, lbj, ubj, &
4768 & nghostpoints, &
4769 & ewperiodic(ng), nsperiodic(ng), &
4770 & average(ng)%avgUwav)
4771# endif
4772 END IF
4773 END IF
4774 IF (aout(idvwav,ng)) THEN
4775 DO j=jstrr,jendr
4776 DO i=istrr,iendr
4777 average(ng)%avgVwav(i,j)=rfac(i,j)* &
4778 & average(ng)%avgVwav(i,j)
4779 END DO
4780 END DO
4781 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4782 CALL exchange_r2d_tile (ng, tile, &
4783 & lbi, ubi, lbj, ubj, &
4784 & average(ng)%avgVwav)
4785# ifdef DISTRIBUTE
4786 CALL mp_exchange2d (ng, tile, inlm, 1, &
4787 & lbi, ubi, lbj, ubj, &
4788 & nghostpoints, &
4789 & ewperiodic(ng), nsperiodic(ng), &
4790 & average(ng)%avgVwav)
4791# endif
4792 END IF
4793 END IF
4794# endif
4795!
4796! Process vorticity fields.
4797!
4798 IF (aout(id2dpv,ng)) THEN
4799 DO j=jstr,jend
4800 DO i=istr,iend
4801 average(ng)%avgpvor2d(i,j)=pfac(i,j)* &
4802 & average(ng)%avgpvor2d(i,j)
4803 END DO
4804 END DO
4805 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4806 CALL exchange_p2d_tile (ng, tile, &
4807 & lbi, ubi, lbj, ubj, &
4808 & average(ng)%avgpvor2d)
4809# ifdef DISTRIBUTE
4810 CALL mp_exchange2d (ng, tile, inlm, 1, &
4811 & lbi, ubi, lbj, ubj, &
4812 & nghostpoints, &
4813 & ewperiodic(ng), nsperiodic(ng), &
4814 & average(ng)%avgpvor2d)
4815# endif
4816 END IF
4817 END IF
4818
4819 IF (aout(id2drv,ng)) THEN
4820 DO j=jstr,jend
4821 DO i=istr,iend
4822 average(ng)%avgrvor2d(i,j)=pfac(i,j)* &
4823 & average(ng)%avgrvor2d(i,j)
4824 END DO
4825 END DO
4826 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4827 CALL exchange_p2d_tile (ng, tile, &
4828 & lbi, ubi, lbj, ubj, &
4829 & average(ng)%avgrvor2d)
4830# ifdef DISTRIBUTE
4831 CALL mp_exchange2d (ng, tile, inlm, 1, &
4832 & lbi, ubi, lbj, ubj, &
4833 & nghostpoints, &
4834 & ewperiodic(ng), nsperiodic(ng), &
4835 & average(ng)%avgrvor2d)
4836# endif
4837 END IF
4838 END IF
4839
4840# ifdef SOLVE3D
4841 IF (aout(id3dpv,ng)) THEN
4842 DO k=1,n(ng)
4843 DO j=jstr,jend
4844 DO i=istr,iend
4845 average(ng)%avgpvor3d(i,j,k)=pfac(i,j)* &
4846 & average(ng)%avgpvor3d(i,j,k)
4847 END DO
4848 END DO
4849 END DO
4850 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4851 CALL exchange_p3d_tile (ng, tile, &
4852 & lbi, ubi, lbj, ubj, 1, n(ng), &
4853 & average(ng)%avgpvor3d)
4854# ifdef DISTRIBUTE
4855 CALL mp_exchange3d (ng, tile, inlm, 1, &
4856 & lbi, ubi, lbj, ubj, 1, n(ng), &
4857 & nghostpoints, &
4858 & ewperiodic(ng), nsperiodic(ng), &
4859 & average(ng)%avgpvor3d)
4860# endif
4861 END IF
4862 END IF
4863
4864 IF (aout(id3drv,ng)) THEN
4865 DO k=1,n(ng)
4866 DO j=jstr,jend
4867 DO i=istr,iend
4868 average(ng)%avgrvor3d(i,j,k)=pfac(i,j)* &
4869 & average(ng)%avgrvor3d(i,j,k)
4870 END DO
4871 END DO
4872 END DO
4873 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4874 CALL exchange_p3d_tile (ng, tile, &
4875 & lbi, ubi, lbj, ubj, 1, n(ng), &
4876 & average(ng)%avgrvor3d)
4877# ifdef DISTRIBUTE
4878 CALL mp_exchange3d (ng, tile, inlm, 1, &
4879 & lbi, ubi, lbj, ubj, 1, n(ng), &
4880 & nghostpoints, &
4881 & ewperiodic(ng), nsperiodic(ng), &
4882 & average(ng)%avgrvor3d)
4883# endif
4884 END IF
4885 END IF
4886# endif
4887!
4888! Process quadratic fields.
4889!
4890 IF (aout(idzzav,ng)) THEN
4891 DO j=jstrr,jendr
4892 DO i=istrr,iendr
4893 average(ng)%avgZZ(i,j)=rfac(i,j)* &
4894 & average(ng)%avgZZ(i,j)
4895 END DO
4896 END DO
4897 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4898 CALL exchange_r2d_tile (ng, tile, &
4899 & lbi, ubi, lbj, ubj, &
4900 & average(ng)%avgZZ)
4901# ifdef DISTRIBUTE
4902 CALL mp_exchange2d (ng, tile, inlm, 1, &
4903 & lbi, ubi, lbj, ubj, &
4904 & nghostpoints, &
4905 & ewperiodic(ng), nsperiodic(ng), &
4906 & average(ng)%avgZZ)
4907# endif
4908 END IF
4909 END IF
4910
4911 IF (aout(idu2av,ng)) THEN
4912 DO j=jstrr,jendr
4913 DO i=istr,iendr
4914 average(ng)%avgU2(i,j)=ufac(i,j)* &
4915 & average(ng)%avgU2(i,j)
4916 END DO
4917 END DO
4918 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4919 CALL exchange_u2d_tile (ng, tile, &
4920 & lbi, ubi, lbj, ubj, &
4921 & average(ng)%avgU2)
4922# ifdef DISTRIBUTE
4923 CALL mp_exchange2d (ng, tile, inlm, 1, &
4924 & lbi, ubi, lbj, ubj, &
4925 & nghostpoints, &
4926 & ewperiodic(ng), nsperiodic(ng), &
4927 & average(ng)%avgU2)
4928# endif
4929 END IF
4930 END IF
4931
4932 IF (aout(idv2av,ng)) THEN
4933 DO j=jstr,jendr
4934 DO i=istrr,iendr
4935 average(ng)%avgV2(i,j)=vfac(i,j)* &
4936 & average(ng)%avgV2(i,j)
4937 END DO
4938 END DO
4939 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4940 CALL exchange_v2d_tile (ng, tile, &
4941 & lbi, ubi, lbj, ubj, &
4942 & average(ng)%avgV2)
4943# ifdef DISTRIBUTE
4944 CALL mp_exchange2d (ng, tile, inlm, 1, &
4945 & lbi, ubi, lbj, ubj, &
4946 & nghostpoints, &
4947 & ewperiodic(ng), nsperiodic(ng), &
4948 & average(ng)%avgV2)
4949# endif
4950 END IF
4951 END IF
4952
4953# ifdef SOLVE3D
4954 IF (aout(iduuav,ng)) THEN
4955 DO k=1,n(ng)
4956 DO j=jstrr,jendr
4957 DO i=istr,iendr
4958 average(ng)%avgUU(i,j,k)=ufac(i,j)* &
4959 & average(ng)%avgUU(i,j,k)
4960 END DO
4961 END DO
4962 END DO
4963 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4964 CALL exchange_u3d_tile (ng, tile, &
4965 & lbi, ubi, lbj, ubj, 1, n(ng), &
4966 & average(ng)%avgUU)
4967# ifdef DISTRIBUTE
4968 CALL mp_exchange3d (ng, tile, inlm, 1, &
4969 & lbi, ubi, lbj, ubj, 1, n(ng), &
4970 & nghostpoints, &
4971 & ewperiodic(ng), nsperiodic(ng), &
4972 & average(ng)%avgUU)
4973# endif
4974 END IF
4975 END IF
4976
4977 IF (aout(idvvav,ng)) THEN
4978 DO k=1,n(ng)
4979 DO j=jstr,jendr
4980 DO i=istrr,iendr
4981 average(ng)%avgVV(i,j,k)=vfac(i,j)* &
4982 & average(ng)%avgVV(i,j,k)
4983 END DO
4984 END DO
4985 END DO
4986 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4987 CALL exchange_v3d_tile (ng, tile, &
4988 & lbi, ubi, lbj, ubj, 1, n(ng), &
4989 & average(ng)%avgVV)
4990# ifdef DISTRIBUTE
4991 CALL mp_exchange3d (ng, tile, inlm, 1, &
4992 & lbi, ubi, lbj, ubj, 1, n(ng), &
4993 & nghostpoints, &
4994 & ewperiodic(ng), nsperiodic(ng), &
4995 & average(ng)%avgVV)
4996# endif
4997 END IF
4998 END IF
4999
5000 IF (aout(iduvav,ng)) THEN
5001 DO k=1,n(ng)
5002 DO j=jstr,jend
5003 DO i=istr,iend
5004 average(ng)%avgUV(i,j,k)=rfac(i,j)* &
5005 & average(ng)%avgUV(i,j,k)
5006 END DO
5007 END DO
5008 END DO
5009 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5010 CALL exchange_r3d_tile (ng, tile, &
5011 & lbi, ubi, lbj, ubj, 1, n(ng), &
5012 & average(ng)%avgUV)
5013# ifdef DISTRIBUTE
5014 CALL mp_exchange3d (ng, tile, inlm, 1, &
5015 & lbi, ubi, lbj, ubj, 1, n(ng), &
5016 & nghostpoints, &
5017 & ewperiodic(ng), nsperiodic(ng), &
5018 & average(ng)%avgUV)
5019# endif
5020 END IF
5021 END IF
5022
5023 IF (aout(idhuav,ng)) THEN
5024 DO k=1,n(ng)
5025 DO j=jstrr,jendr
5026 DO i=istr,iendr
5027 average(ng)%avgHuon(i,j,k)=ufac(i,j)* &
5028 & average(ng)%avgHuon(i,j,k)
5029 END DO
5030 END DO
5031 END DO
5032 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5033 CALL exchange_u3d_tile (ng, tile, &
5034 & lbi, ubi, lbj, ubj, 1, n(ng), &
5035 & average(ng)%avgHuon)
5036# ifdef DISTRIBUTE
5037 CALL mp_exchange3d (ng, tile, inlm, 1, &
5038 & lbi, ubi, lbj, ubj, 1, n(ng), &
5039 & nghostpoints, &
5040 & ewperiodic(ng), nsperiodic(ng), &
5041 & average(ng)%avgHuon)
5042# endif
5043 END IF
5044 END IF
5045
5046 IF (aout(idhvav,ng)) THEN
5047 DO k=1,n(ng)
5048 DO j=jstr,jendr
5049 DO i=istrr,iendr
5050 average(ng)%avgHvom(i,j,k)=vfac(i,j)* &
5051 & average(ng)%avgHvom(i,j,k)
5052 END DO
5053 END DO
5054 END DO
5055 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5056 CALL exchange_v3d_tile (ng, tile, &
5057 & lbi, ubi, lbj, ubj, 1, n(ng), &
5058 & average(ng)%avgHvom)
5059# ifdef DISTRIBUTE
5060 CALL mp_exchange3d (ng, tile, inlm, 1, &
5061 & lbi, ubi, lbj, ubj, 1, n(ng), &
5062 & nghostpoints, &
5063 & ewperiodic(ng), nsperiodic(ng), &
5064 & average(ng)%avgHvom)
5065# endif
5066 END IF
5067 END IF
5068
5069 DO it=1,nt(ng)
5070 IF (aout(idttav(it),ng)) THEN
5071 DO k=1,n(ng)
5072 DO j=jstrr,jendr
5073 DO i=istrr,iendr
5074 average(ng)%avgTT(i,j,k,it)=rfac(i,j)* &
5075 & average(ng)%avgTT(i,j,k,it)
5076 END DO
5077 END DO
5078 END DO
5079 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5080 CALL exchange_r3d_tile (ng, tile, &
5081 & lbi, ubi, lbj, ubj, 1, n(ng), &
5082 & average(ng)%avgTT(:,:,:,it))
5083# ifdef DISTRIBUTE
5084 CALL mp_exchange3d (ng, tile, inlm, 1, &
5085 & lbi, ubi, lbj, ubj, 1, n(ng), &
5086 & nghostpoints, &
5087 & ewperiodic(ng), nsperiodic(ng), &
5088 & average(ng)%avgTT(:,:,:,it))
5089# endif
5090 END IF
5091 END IF
5092
5093 IF (aout(idutav(it),ng)) THEN
5094 DO k=1,n(ng)
5095 DO j=jstrr,jendr
5096 DO i=istr,iend
5097 average(ng)%avgUT(i,j,k,it)=ufac(i,j)* &
5098 & average(ng)%avgUT(i,j,k,it)
5099 END DO
5100 END DO
5101 END DO
5102 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5103 CALL exchange_u3d_tile (ng, tile, &
5104 & lbi, ubi, lbj, ubj, 1, n(ng), &
5105 & average(ng)%avgUT(:,:,:,it))
5106# ifdef DISTRIBUTE
5107 CALL mp_exchange3d (ng, tile, inlm, 1, &
5108 & lbi, ubi, lbj, ubj, 1, n(ng), &
5109 & nghostpoints, &
5110 & ewperiodic(ng), nsperiodic(ng), &
5111 & average(ng)%avgUT(:,:,:,it))
5112# endif
5113 END IF
5114 END IF
5115
5116 IF (aout(idvtav(it),ng)) THEN
5117 DO k=1,n(ng)
5118 DO j=jstr,jend
5119 DO i=istrr,iendr
5120 average(ng)%avgVT(i,j,k,it)=vfac(i,j)* &
5121 & average(ng)%avgVT(i,j,k,it)
5122 END DO
5123 END DO
5124 END DO
5125 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5126 CALL exchange_v3d_tile (ng, tile, &
5127 & lbi, ubi, lbj, ubj, 1, n(ng), &
5128 & average(ng)%avgVT(:,:,:,it))
5129# ifdef DISTRIBUTE
5130 CALL mp_exchange3d (ng, tile, inlm, 1, &
5131 & lbi, ubi, lbj, ubj, 1, n(ng), &
5132 & nghostpoints, &
5133 & ewperiodic(ng), nsperiodic(ng), &
5134 & average(ng)%avgVT(:,:,:,it))
5135# endif
5136 END IF
5137 END IF
5138
5139 IF (aout(ihutav(it),ng)) THEN
5140 DO k=1,n(ng)
5141 DO j=jstrr,jendr
5142 DO i=istr,iend
5143 average(ng)%avgHuonT(i,j,k,it)=ufac(i,j)* &
5144 & average(ng)%avgHuonT(i,j,k,it)
5145 END DO
5146 END DO
5147 END DO
5148 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5149 CALL exchange_u3d_tile (ng, tile, &
5150 & lbi, ubi, lbj, ubj, 1, n(ng), &
5151 & average(ng)%avgHuonT(:,:,:,it))
5152# ifdef DISTRIBUTE
5153 CALL mp_exchange3d (ng, tile, inlm, 1, &
5154 & lbi, ubi, lbj, ubj, 1, n(ng), &
5155 & nghostpoints, &
5156 & ewperiodic(ng), nsperiodic(ng), &
5157 & average(ng)%avgHuonT(:,:,:,it))
5158# endif
5159 END IF
5160 END IF
5161
5162 IF (aout(ihvtav(it),ng)) THEN
5163 DO k=1,n(ng)
5164 DO j=jstr,jend
5165 DO i=istrr,iendr
5166 average(ng)%avgHvomT(i,j,k,it)=vfac(i,j)* &
5167 & average(ng)%avgHvomT(i,j,k,it)
5168 END DO
5169 END DO
5170 END DO
5171 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5172 CALL exchange_v3d_tile (ng, tile, &
5173 & lbi, ubi, lbj, ubj, 1, n(ng), &
5174 & average(ng)%avgHvomT(:,:,:,it))
5175# ifdef DISTRIBUTE
5176 CALL mp_exchange3d (ng, tile, inlm, 1, &
5177 & lbi, ubi, lbj, ubj, 1, n(ng), &
5178 & nghostpoints, &
5179 & ewperiodic(ng), nsperiodic(ng), &
5180 & average(ng)%avgHvomT(:,:,:,it))
5181# endif
5182 END IF
5183 END IF
5184 END DO
5185# endif
5186 END IF
5187
5188 RETURN
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
exchange_2d_mod::exchange_u2d_tile
subroutine exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:440
exchange_2d_mod::exchange_p2d_tile
subroutine exchange_p2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:66
exchange_2d_mod::exchange_v2d_tile
subroutine exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:627
exchange_3d_mod
Definition exchange_3d.F:2
exchange_3d_mod::exchange_u3d_tile
subroutine exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:495
exchange_3d_mod::exchange_p3d_tile
subroutine exchange_p3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:70
exchange_3d_mod::exchange_r3d_tile
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:283
exchange_3d_mod::exchange_v3d_tile
subroutine exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:707
exchange_3d_mod::exchange_w3d_tile
subroutine exchange_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:920
mod_average
Definition mod_average.F:2
mod_average::average
type(t_average), dimension(:), allocatable average
Definition mod_average.F:351
mod_bbl
Definition mod_bbl.F:2
mod_bbl::bbl
type(t_bbl), dimension(:), allocatable bbl
Definition mod_bbl.F:62
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_mixing
Definition mod_mixing.F:2
mod_mixing::mixing
type(t_mixing), dimension(:), allocatable mixing
Definition mod_mixing.F:399
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::iddano
integer iddano
Definition mod_ncparam.F:200
mod_ncparam::idvair
integer idvair
Definition mod_ncparam.F:358
mod_ncparam::idwqsp
integer idwqsp
Definition mod_ncparam.F:418
mod_ncparam::idttav
integer, dimension(:), allocatable idttav
Definition mod_ncparam.F:478
mod_ncparam::idevap
integer idevap
Definition mod_ncparam.F:204
mod_ncparam::idvbrs
integer idvbrs
Definition mod_ncparam.F:367
mod_ncparam::ihvtav
integer, dimension(:), allocatable ihvtav
Definition mod_ncparam.F:477
mod_ncparam::idzzav
integer idzzav
Definition mod_ncparam.F:468
mod_ncparam::idu2av
integer idu2av
Definition mod_ncparam.F:466
mod_ncparam::idv2rs
integer idv2rs
Definition mod_ncparam.F:353
mod_ncparam::iduvwc
integer iduvwc
Definition mod_ncparam.F:344
mod_ncparam::idwdis
integer idwdis
Definition mod_ncparam.F:410
mod_ncparam::idwdif
integer idwdif
Definition mod_ncparam.F:407
mod_ncparam::idv3sd
integer idv3sd
Definition mod_ncparam.F:356
mod_ncparam::idubar
integer idubar
Definition mod_ncparam.F:325
mod_ncparam::idwvel
integer idwvel
Definition mod_ncparam.F:421
mod_ncparam::idvvel
integer idvvel
Definition mod_ncparam.F:381
mod_ncparam::idubur
integer idubur
Definition mod_ncparam.F:334
mod_ncparam::ihutav
integer, dimension(:), allocatable ihutav
Definition mod_ncparam.F:476
mod_ncparam::idhsbl
integer idhsbl
Definition mod_ncparam.F:213
mod_ncparam::idvsms
integer idvsms
Definition mod_ncparam.F:377
mod_ncparam::idwlen
integer idwlen
Definition mod_ncparam.F:412
mod_ncparam::idwdiw
integer idwdiw
Definition mod_ncparam.F:411
mod_ncparam::idutav
integer, dimension(:), allocatable idutav
Definition mod_ncparam.F:479
mod_ncparam::idvbvr
integer idvbvr
Definition mod_ncparam.F:369
mod_ncparam::idpair
integer idpair
Definition mod_ncparam.F:263
mod_ncparam::id3dpv
integer id3dpv
Definition mod_ncparam.F:437
mod_ncparam::idwlep
integer idwlep
Definition mod_ncparam.F:413
mod_ncparam::idw3st
integer idw3st
Definition mod_ncparam.F:392
mod_ncparam::idu2rs
integer idu2rs
Definition mod_ncparam.F:318
mod_ncparam::idv2dn
integer idv2dn
Definition mod_ncparam.F:387
mod_ncparam::idvbot
integer idvbot
Definition mod_ncparam.F:366
mod_ncparam::idsdif
integer idsdif
Definition mod_ncparam.F:290
mod_ncparam::idvfx2
integer idvfx2
Definition mod_ncparam.F:373
mod_ncparam::id3drv
integer id3drv
Definition mod_ncparam.F:438
mod_ncparam::idwrol
integer idwrol
Definition mod_ncparam.F:419
mod_ncparam::idtsur
integer, dimension(:), allocatable idtsur
Definition mod_ncparam.F:453
mod_ncparam::id2drv
integer id2drv
Definition mod_ncparam.F:436
mod_ncparam::idvain
integer idvain
Definition mod_ncparam.F:359
mod_ncparam::idtdif
integer idtdif
Definition mod_ncparam.F:306
mod_ncparam::idfsur
integer idfsur
Definition mod_ncparam.F:206
mod_ncparam::idwbrk
integer idwbrk
Definition mod_ncparam.F:405
mod_ncparam::idtvar
integer, dimension(:), allocatable idtvar
Definition mod_ncparam.F:568
mod_ncparam::idhbbl
integer idhbbl
Definition mod_ncparam.F:212
mod_ncparam::idvbws
integer idvbws
Definition mod_ncparam.F:370
mod_ncparam::idvfx1
integer idvfx1
Definition mod_ncparam.F:372
mod_ncparam::idufx2
integer idufx2
Definition mod_ncparam.F:338
mod_ncparam::iduwav
integer iduwav
Definition mod_ncparam.F:345
mod_ncparam::idvbms
integer idvbms
Definition mod_ncparam.F:365
mod_ncparam::iduair
integer iduair
Definition mod_ncparam.F:323
mod_ncparam::iduvel
integer iduvel
Definition mod_ncparam.F:343
mod_ncparam::idhuav
integer idhuav
Definition mod_ncparam.F:470
mod_ncparam::idv3dn
integer idv3dn
Definition mod_ncparam.F:390
mod_ncparam::idhvav
integer idhvav
Definition mod_ncparam.F:471
mod_ncparam::idovel
integer idovel
Definition mod_ncparam.F:261
mod_ncparam::idv3rs
integer idv3rs
Definition mod_ncparam.F:354
mod_ncparam::idvvav
integer idvvav
Definition mod_ncparam.F:474
mod_ncparam::idwam2
integer idwam2
Definition mod_ncparam.F:403
mod_ncparam::idu3rs
integer idu3rs
Definition mod_ncparam.F:319
mod_ncparam::idshea
integer idshea
Definition mod_ncparam.F:297
mod_ncparam::idlrad
integer idlrad
Definition mod_ncparam.F:229
mod_ncparam::idwdip
integer idwdip
Definition mod_ncparam.F:408
mod_ncparam::idv2av
integer idv2av
Definition mod_ncparam.F:467
mod_ncparam::idusms
integer idusms
Definition mod_ncparam.F:339
mod_ncparam::idvbcs
integer idvbcs
Definition mod_ncparam.F:363
mod_ncparam::idwbeh
integer idwbeh
Definition mod_ncparam.F:404
mod_ncparam::idwamp
integer idwamp
Definition mod_ncparam.F:402
mod_ncparam::idwdir
integer idwdir
Definition mod_ncparam.F:409
mod_ncparam::idvvis
integer idvvis
Definition mod_ncparam.F:382
mod_ncparam::idwptp
integer idwptp
Definition mod_ncparam.F:416
mod_ncparam::idu3de
integer idu3de
Definition mod_ncparam.F:352
mod_ncparam::idwdib
integer idwdib
Definition mod_ncparam.F:406
mod_ncparam::idvtav
integer, dimension(:), allocatable idvtav
Definition mod_ncparam.F:480
mod_ncparam::id2dpv
integer id2dpv
Definition mod_ncparam.F:435
mod_ncparam::idv2sd
integer idv2sd
Definition mod_ncparam.F:355
mod_ncparam::idubcs
integer idubcs
Definition mod_ncparam.F:328
mod_ncparam::idufx1
integer idufx1
Definition mod_ncparam.F:337
mod_ncparam::idu2de
integer idu2de
Definition mod_ncparam.F:349
mod_ncparam::idlhea
integer idlhea
Definition mod_ncparam.F:228
mod_ncparam::idubot
integer idubot
Definition mod_ncparam.F:331
mod_ncparam::idrain
integer idrain
Definition mod_ncparam.F:287
mod_ncparam::idubms
integer idubms
Definition mod_ncparam.F:330
mod_ncparam::idubrs
integer idubrs
Definition mod_ncparam.F:332
mod_ncparam::idsrad
integer idsrad
Definition mod_ncparam.F:293
mod_ncparam::idubws
integer idubws
Definition mod_ncparam.F:335
mod_ncparam::iduuav
integer iduuav
Definition mod_ncparam.F:472
mod_ncparam::idwpbt
integer idwpbt
Definition mod_ncparam.F:417
mod_ncparam::idworb
integer idworb
Definition mod_ncparam.F:415
mod_ncparam::idu3sd
integer idu3sd
Definition mod_ncparam.F:321
mod_ncparam::idu2sd
integer idu2sd
Definition mod_ncparam.F:320
mod_ncparam::iduaie
integer iduaie
Definition mod_ncparam.F:324
mod_ncparam::idvwav
integer idvwav
Definition mod_ncparam.F:383
mod_ncparam::idtair
integer idtair
Definition mod_ncparam.F:305
mod_ncparam::aout
logical, dimension(:,:), allocatable aout
Definition mod_ncparam.F:166
mod_ncparam::idw3sd
integer idw3sd
Definition mod_ncparam.F:391
mod_ncparam::iduvav
integer iduvav
Definition mod_ncparam.F:473
mod_ncparam::idwztw
integer idwztw
Definition mod_ncparam.F:423
mod_ncparam::idvbar
integer idvbar
Definition mod_ncparam.F:360
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_param::nst
integer nst
Definition mod_param.F:521
mod_scalars
Definition mod_scalars.F:2
mod_scalars::nrrec
integer, dimension(:), allocatable nrrec
Definition mod_scalars.F:1171
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::avgtime
real(dp), dimension(:), allocatable avgtime
Definition mod_scalars.F:273
mod_scalars::navg
integer, dimension(:), allocatable navg
Definition mod_scalars.F:1073
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::time
real(dp), dimension(:), allocatable time
Definition mod_scalars.F:262
mod_scalars::ntstart
integer, dimension(:), allocatable ntstart
Definition mod_scalars.F:378
mod_scalars::ntsavg
integer, dimension(:), allocatable ntsavg
Definition mod_scalars.F:1067
mod_sedbed
Definition sedbed_mod.h:1
mod_sedbed::sedbed
type(t_sedbed), dimension(:), allocatable sedbed
Definition sedbed_mod.h:157
mod_sediment
Definition sediment_mod.h:1
mod_sediment::idubld
integer, dimension(:), allocatable idubld
Definition sediment_mod.h:160
mod_sediment::idvbld
integer, dimension(:), allocatable idvbld
Definition sediment_mod.h:161
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
mp_exchange_mod::mp_exchange3d
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:2037
uv_rotate_mod
Definition uv_rotate.F:2
uv_rotate_mod::uv_rotate3d
subroutine, public uv_rotate3d(ng, tile, add, lboundary, lbi, ubi, lbj, ubj, lbk, ubk, cosangler, sinangler, rmask_full, uinp, vinp, uout, vout)
Definition uv_rotate.F:155
uv_rotate_mod::uv_rotate2d
subroutine, public uv_rotate2d(ng, tile, add, lboundary, lbi, ubi, lbj, ubj, cosangler, sinangler, rmask_full, uinp, vinp, uout, vout)
Definition uv_rotate.F:35
vorticity_mod
Definition vorticity.F:2
vorticity_mod::vorticity_tile
subroutine, public vorticity_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kout, nout, pmask, umask, vmask, f, h, om_u, on_v, pm, pn, z_r, pden, u, v, ubar, vbar, zeta, pvor, rvor, pvor_bar, rvor_bar)
Definition vorticity.F:144

References mod_ncparam::aout, mod_average::average, mod_scalars::avgtime, mod_bbl::bbl, mod_coupling::coupling, mod_param::domain, mod_scalars::dt, mod_scalars::ewperiodic, exchange_2d_mod::exchange_p2d_tile(), exchange_3d_mod::exchange_p3d_tile(), exchange_2d_mod::exchange_r2d_tile(), exchange_3d_mod::exchange_r3d_tile(), exchange_2d_mod::exchange_u2d_tile(), exchange_3d_mod::exchange_u3d_tile(), exchange_2d_mod::exchange_v2d_tile(), exchange_3d_mod::exchange_v3d_tile(), exchange_3d_mod::exchange_w3d_tile(), mod_forces::forces, mod_grid::grid, mod_ncparam::id2dpv, mod_ncparam::id2drv, mod_ncparam::id3dpv, mod_ncparam::id3drv, mod_ncparam::iddano, mod_ncparam::idevap, mod_ncparam::idfsur, mod_ncparam::idhbbl, mod_ncparam::idhsbl, mod_ncparam::idhuav, mod_ncparam::idhvav, mod_ncparam::idlhea, mod_ncparam::idlrad, mod_ncparam::idovel, mod_ncparam::idpair, mod_ncparam::idrain, mod_ncparam::idsdif, mod_ncparam::idshea, mod_ncparam::idsrad, mod_ncparam::idtair, mod_ncparam::idtdif, mod_ncparam::idtsur, mod_ncparam::idttav, mod_ncparam::idtvar, mod_ncparam::idu2av, mod_ncparam::idu2de, mod_ncparam::idu2rs, mod_ncparam::idu2sd, mod_ncparam::idu3de, mod_ncparam::idu3rs, mod_ncparam::idu3sd, mod_ncparam::iduaie, mod_ncparam::iduair, mod_ncparam::idubar, mod_ncparam::idubcs, mod_sediment::idubld, mod_ncparam::idubms, mod_ncparam::idubot, mod_ncparam::idubrs, mod_ncparam::idubur, mod_ncparam::idubws, mod_ncparam::idufx1, mod_ncparam::idufx2, mod_ncparam::idusms, mod_ncparam::idutav, mod_ncparam::iduuav, mod_ncparam::iduvav, mod_ncparam::iduvel, mod_ncparam::iduvwc, mod_ncparam::iduwav, mod_ncparam::idv2av, mod_ncparam::idv2dn, mod_ncparam::idv2rs, mod_ncparam::idv2sd, mod_ncparam::idv3dn, mod_ncparam::idv3rs, mod_ncparam::idv3sd, mod_ncparam::idvain, mod_ncparam::idvair, mod_ncparam::idvbar, mod_ncparam::idvbcs, mod_sediment::idvbld, mod_ncparam::idvbms, mod_ncparam::idvbot, mod_ncparam::idvbrs, mod_ncparam::idvbvr, mod_ncparam::idvbws, mod_ncparam::idvfx1, mod_ncparam::idvfx2, mod_ncparam::idvsms, mod_ncparam::idvtav, mod_ncparam::idvvav, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_ncparam::idvwav, mod_ncparam::idw3sd, mod_ncparam::idw3st, mod_ncparam::idwam2, mod_ncparam::idwamp, mod_ncparam::idwbeh, mod_ncparam::idwbrk, mod_ncparam::idwdib, mod_ncparam::idwdif, mod_ncparam::idwdip, mod_ncparam::idwdir, mod_ncparam::idwdis, mod_ncparam::idwdiw, mod_ncparam::idwlen, mod_ncparam::idwlep, mod_ncparam::idworb, mod_ncparam::idwpbt, mod_ncparam::idwptp, mod_ncparam::idwqsp, mod_ncparam::idwrol, mod_ncparam::idwvel, mod_ncparam::idwztw, mod_ncparam::idzzav, mod_ncparam::ihutav, mod_ncparam::ihvtav, mod_scalars::iic, mod_param::inlm, mod_scalars::isalt, mod_scalars::itemp, mod_mixing::mixing, mp_exchange_mod::mp_exchange2d(), mp_exchange_mod::mp_exchange3d(), mod_scalars::navg, mod_param::nghostpoints, mod_scalars::nrrec, mod_scalars::nsperiodic, mod_param::nst, mod_param::nt, mod_scalars::ntsavg, mod_scalars::ntstart, mod_ocean::ocean, mod_sedbed::sedbed, mod_scalars::time, uv_rotate_mod::uv_rotate2d(), uv_rotate_mod::uv_rotate3d(), and vorticity_mod::vorticity_tile().

Referenced by set_avg().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ set_detide_tile()

subroutine set_avg_mod::set_detide_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) ntc,
integer, intent(in) kout,
integer, intent(in) nout,
real(r8), dimension(:), intent(in) cosomega,
real(r8), dimension(:), intent(in) sinomega,
real(r8), dimension(:), intent(inout) cosw_avg,
real(r8), dimension(:), intent(inout) cosw_sum,
real(r8), dimension(:), intent(inout) sinw_avg,
real(r8), dimension(:), intent(inout) sinw_sum,
real(r8), dimension(:,:), intent(inout) coswcosw,
real(r8), dimension(:,:), intent(inout) sinwsinw,
real(r8), dimension(:,:), intent(inout) sinwcosw )
private

Definition at line 5194 of file set_avg.F.

5205!***********************************************************************
5206!
5207 USE mod_param
5208 USE mod_ncparam
5209 USE mod_average
5210# ifdef WET_DRY
5211 USE mod_grid
5212# endif
5213 USE mod_ocean
5214 USE mod_scalars
5215 USE mod_tides
5216!
5217 implicit none
5218!
5219! Imported variable declarations.
5220!
5221 integer, intent(in) :: ng, tile
5222 integer, intent(in) :: LBi, UBi, LBj, UBj
5223 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
5224 integer, intent(in) :: Kout
5225# ifdef SOLVE3D
5226 integer, intent(in) :: Nout
5227# endif
5228 integer, intent(in) :: NTC
5229!
5230# ifdef ASSUMED_SHAPE
5231 real(r8), intent(in) :: CosOmega(:)
5232 real(r8), intent(in) :: SinOmega(:)
5233 real(r8), intent(inout) :: CosW_avg(:)
5234 real(r8), intent(inout) :: CosW_sum(:)
5235 real(r8), intent(inout) :: SinW_avg(:)
5236 real(r8), intent(inout) :: SinW_sum(:)
5237 real(r8), intent(inout) :: CosWCosW(:,:)
5238 real(r8), intent(inout) :: SinWSinW(:,:)
5239 real(r8), intent(inout) :: SinWCosW(:,:)
5240# else
5241 real(r8), intent(in) :: CosOmega(NTC)
5242 real(r8), intent(in) :: SinOmega(NTC)
5243 real(r8), intent(inout) :: CosW_avg(NTC)
5244 real(r8), intent(inout) :: CosW_sum(NTC)
5245 real(r8), intent(inout) :: SinW_avg(NTC)
5246 real(r8), intent(inout) :: SinW_sum(NTC)
5247 real(r8), intent(inout) :: CosWCosW(NTC,NTC)
5248 real(r8), intent(inout) :: SinWSinW(NTC,NTC)
5249 real(r8), intent(inout) :: SinWCosW(NTC,NTC)
5250# endif
5251!
5252! Local variable declarations.
5253!
5254 integer :: i, it, j, k
5255 integer :: NTC2, mk, nk
5256
5257 integer, dimension(2*NTC+1) :: indx
5258
5259 real(r8) :: fac, fac1
5260 real(r8) :: Hsum, d
5261
5262 real(r8), dimension(0:2*NTC) :: Ak
5263 real(r8), dimension(0:2*NTC) :: tide_harmonics
5264 real(r8), dimension(0:2*NTC,0:2*NTC) :: C, Y
5265
5266 real(r8) :: rfac(IminS:ImaxS,JminS:JmaxS)
5267 real(r8) :: ufac(IminS:ImaxS,JminS:JmaxS)
5268 real(r8) :: vfac(IminS:ImaxS,JminS:JmaxS)
5269
5270# include "set_bounds.h"
5271!
5272!-----------------------------------------------------------------------
5273! Return if time-averaging window is zero.
5274!-----------------------------------------------------------------------
5275!
5276 IF (navg(ng).eq.0) RETURN
5277!
5278!-----------------------------------------------------------------------
5279! Initialize time-averaged arrays when appropriate. Notice that
5280! fields are initilized twice during re-start. However, the time-
5281! averaged fields are computed correctly.
5282!-----------------------------------------------------------------------
5283!
5284 ntc2=2*ntc
5285
5286 IF (((iic(ng).gt.ntsavg(ng)).and. &
5287 & (mod(iic(ng)-1,navg(ng)).eq.1)).or. &
5288 & ((nrrec(ng).gt.0).and.(iic(ng).eq.ntstart(ng)))) THEN
5289!
5290! Compute least-squares coefficients to detide time-averaged fields.
5291! Notice that the coefficients are always accumulated and not
5292! re-initialized. This allows better tidal fit as the simulation
5293! progresses.
5294!
5295 IF (domain(ng)%SouthWest_Test(tile)) THEN
5296 hcount(ng)=hcount(ng)+1
5297 DO nk=1,ntc
5298 sinw_avg(nk)=sinomega(nk)
5299 cosw_avg(nk)=cosomega(nk)
5300 sinw_sum(nk)=sinw_sum(nk)+sinomega(nk)
5301 cosw_sum(nk)=cosw_sum(nk)+cosomega(nk)
5302 DO mk=1,ntc
5303 sinwsinw(mk,nk)=sinwsinw(mk,nk)+sinomega(mk)*sinomega(nk)
5304 coswcosw(mk,nk)=coswcosw(mk,nk)+cosomega(mk)*cosomega(nk)
5305 sinwcosw(mk,nk)=sinwcosw(mk,nk)+sinomega(mk)*cosomega(nk)
5306 END DO
5307 END DO
5308 tide_harmonics(0)=1.0_r8
5309 DO nk=1,ntc
5310 tide_harmonics(nk )=sinomega(nk)
5311 tide_harmonics(nk+ntc)=cosomega(nk)
5312 END DO
5313 END IF
5314!
5315! Initialize.
5316!
5317 IF (aout(idfsud,ng)) THEN
5318 DO nk=0,ntc2
5319 DO j=jstrr,jendr
5320 DO i=istrr,iendr
5321 tides(ng)%zeta_tide(i,j,nk)=tides(ng)%zeta_tide(i,j, &
5322 & nk)+ &
5323# ifdef WET_DRY
5324 & grid(ng)%rmask_full(i,j)* &
5325# endif
5326 & ocean(ng)%zeta(i,j,kout)* &
5327 & tide_harmonics(nk)
5328 END DO
5329 END DO
5330 END DO
5331 END IF
5332
5333 IF (aout(idu2dd,ng)) THEN
5334 DO nk=0,ntc2
5335 DO j=jstrr,jendr
5336 DO i=istr,iendr
5337 tides(ng)%ubar_tide(i,j,nk)=tides(ng)%ubar_tide(i,j, &
5338 & nk)+ &
5339# ifdef WET_DRY
5340 & grid(ng)%umask_full(i,j)* &
5341# endif
5342 & ocean(ng)%ubar(i,j,kout)* &
5343 & tide_harmonics(nk)
5344 END DO
5345 END DO
5346 END DO
5347 END IF
5348
5349 IF (aout(idv2dd,ng)) THEN
5350 DO nk=0,ntc2
5351 DO j=jstr,jendr
5352 DO i=istrr,iendr
5353 tides(ng)%vbar_tide(i,j,nk)=tides(ng)%vbar_tide(i,j, &
5354 & nk)+ &
5355# ifdef WET_DRY
5356 & grid(ng)%vmask_full(i,j)* &
5357# endif
5358 & ocean(ng)%vbar(i,j,kout)* &
5359 & tide_harmonics(nk)
5360 END DO
5361 END DO
5362 END DO
5363 END IF
5364
5365# ifdef SOLVE3D
5366 IF (aout(idu3dd,ng)) THEN
5367 DO nk=0,ntc2
5368 DO k=1,n(ng)
5369 DO j=jstrr,jendr
5370 DO i=istr,iendr
5371 tides(ng)%u_tide(i,j,k,nk)=tides(ng)%u_tide(i,j,k, &
5372 & nk)+ &
5373# ifdef WET_DRY
5374 & grid(ng)%umask_full(i,j)* &
5375# endif
5376 & ocean(ng)%u(i,j,k,nout)* &
5377 & tide_harmonics(nk)
5378 END DO
5379 END DO
5380 END DO
5381 END DO
5382 END IF
5383
5384 IF (aout(idv3dd,ng)) THEN
5385 DO nk=0,ntc2
5386 DO k=1,n(ng)
5387 DO j=jstr,jendr
5388 DO i=istrr,iendr
5389 tides(ng)%v_tide(i,j,k,nk)=tides(ng)%v_tide(i,j,k, &
5390 & nk)+ &
5391# ifdef WET_DRY
5392 & grid(ng)%vmask_full(i,j)* &
5393# endif
5394 & ocean(ng)%v(i,j,k,nout)* &
5395 & tide_harmonics(nk)
5396 END DO
5397 END DO
5398 END DO
5399 END DO
5400 END IF
5401
5402 DO it=1,nat
5403 IF (aout(idtrcd(it),ng)) THEN
5404 DO nk=0,ntc2
5405 DO k=1,n(ng)
5406 DO j=jstr,jendr
5407 DO i=istrr,iendr
5408 tides(ng)%t_tide(i,j,k,nk,it)=tides(ng)%t_tide(i,j, &
5409 & k,nk,it)+ &
5410# ifdef WET_DRY
5411 & grid(ng)%rmask_full(i,j)* &
5412# endif
5413 & ocean(ng)%t(i,j,k, &
5414 & nout,it)* &
5415 & tide_harmonics(nk)
5416 END DO
5417 END DO
5418 END DO
5419 END DO
5420 END IF
5421 END DO
5422# endif
5423!
5424!-----------------------------------------------------------------------
5425! Accumulate time-averaged fields.
5426!-----------------------------------------------------------------------
5427!
5428 ELSE IF (iic(ng).gt.ntsavg(ng)) THEN
5429!
5430! Accumukate Detide least-squares coefficients. They only vary in time
5431! since omega (as computed in set_tides) uses model time coordinate.
5432!
5433 IF (domain(ng)%SouthWest_Test(tile)) THEN
5434 hcount(ng)=hcount(ng)+1
5435 DO nk=1,ntc
5436 sinw_avg(nk)=sinw_avg(nk)+sinomega(nk)
5437 cosw_avg(nk)=cosw_avg(nk)+cosomega(nk)
5438 sinw_sum(nk)=sinw_sum(nk)+sinomega(nk)
5439 cosw_sum(nk)=cosw_sum(nk)+cosomega(nk)
5440 DO mk=1,ntc
5441 sinwsinw(mk,nk)=sinwsinw(mk,nk)+sinomega(mk)*sinomega(nk)
5442 coswcosw(mk,nk)=coswcosw(mk,nk)+cosomega(mk)*cosomega(nk)
5443 sinwcosw(mk,nk)=sinwcosw(mk,nk)+sinomega(mk)*cosomega(nk)
5444 END DO
5445 END DO
5446 tide_harmonics(0)=1.0_r8
5447 DO nk=1,ntc
5448 tide_harmonics(nk )=sinomega(nk)
5449 tide_harmonics(nk+ntc)=cosomega(nk)
5450 END DO
5451 END IF
5452!
5453! Accumulate.
5454!
5455 IF (aout(idfsud,ng)) THEN
5456 DO nk=0,ntc2
5457 DO j=jstrr,jendr
5458 DO i=istrr,iendr
5459 tides(ng)%zeta_tide(i,j,nk)=tides(ng)%zeta_tide(i,j, &
5460 & nk)+ &
5461# ifdef WET_DRY
5462 & grid(ng)%rmask_full(i,j)* &
5463# endif
5464 & ocean(ng)%zeta(i,j,kout)* &
5465 & tide_harmonics(nk)
5466 END DO
5467 END DO
5468 END DO
5469 END IF
5470
5471 IF (aout(idu2dd,ng)) THEN
5472 DO nk=0,ntc2
5473 DO j=jstrr,jendr
5474 DO i=istr,iendr
5475 tides(ng)%ubar_tide(i,j,nk)=tides(ng)%ubar_tide(i,j, &
5476 & nk)+ &
5477# ifdef WET_DRY
5478 & grid(ng)%umask_full(i,j)* &
5479# endif
5480 & ocean(ng)%ubar(i,j,kout)* &
5481 & tide_harmonics(nk)
5482 END DO
5483 END DO
5484 END DO
5485 END IF
5486
5487 IF (aout(idv2dd,ng)) THEN
5488 DO nk=0,ntc2
5489 DO j=jstr,jendr
5490 DO i=istrr,iendr
5491 tides(ng)%vbar_tide(i,j,nk)=tides(ng)%vbar_tide(i,j, &
5492 & nk)+ &
5493# ifdef WET_DRY
5494 & grid(ng)%vmask_full(i,j)* &
5495# endif
5496 & ocean(ng)%vbar(i,j,kout)* &
5497 & tide_harmonics(nk)
5498 END DO
5499 END DO
5500 END DO
5501 END IF
5502
5503# ifdef SOLVE3D
5504 IF (aout(idu3dd,ng)) THEN
5505 DO nk=0,ntc2
5506 DO k=1,n(ng)
5507 DO j=jstrr,jendr
5508 DO i=istr,iendr
5509 tides(ng)%u_tide(i,j,k,nk)=tides(ng)%u_tide(i,j,k, &
5510 & nk)+ &
5511# ifdef WET_DRY
5512 & grid(ng)%umask_full(i,j)* &
5513# endif
5514 & ocean(ng)%u(i,j,k,nout)* &
5515 & tide_harmonics(nk)
5516 END DO
5517 END DO
5518 END DO
5519 END DO
5520 END IF
5521
5522 IF (aout(idv3dd,ng)) THEN
5523 DO nk=0,ntc2
5524 DO k=1,n(ng)
5525 DO j=jstr,jendr
5526 DO i=istrr,iendr
5527 tides(ng)%v_tide(i,j,k,nk)=tides(ng)%v_tide(i,j,k, &
5528 & nk)+ &
5529# ifdef WET_DRY
5530 & grid(ng)%vmask_full(i,j)* &
5531# endif
5532 & ocean(ng)%v(i,j,k,nout)* &
5533 & tide_harmonics(nk)
5534 END DO
5535 END DO
5536 END DO
5537 END DO
5538 END IF
5539
5540 DO it=1,nat
5541 IF (aout(idtrcd(it),ng)) THEN
5542 DO nk=0,ntc2
5543 DO k=1,n(ng)
5544 DO j=jstr,jendr
5545 DO i=istrr,iendr
5546 tides(ng)%t_tide(i,j,k,nk,it)=tides(ng)%t_tide(i,j, &
5547 & k,nk,it)+ &
5548# ifdef WET_DRY
5549 & grid(ng)%umask_full(i,j)* &
5550# endif
5551 & ocean(ng)%t(i,j,k, &
5552 & nout,it)* &
5553 & tide_harmonics(nk)
5554 END DO
5555 END DO
5556 END DO
5557 END DO
5558 END IF
5559 END DO
5560# endif
5561 END IF
5562!
5563!-----------------------------------------------------------------------
5564! Convert accumulated sums into time-averages, if appropriate.
5565!-----------------------------------------------------------------------
5566!
5567 IF ((iic(ng).gt.ntsavg(ng)).and. &
5568 & (mod(iic(ng)-1,navg(ng)).eq.0).and. &
5569 & ((iic(ng).ne.ntstart(ng)).or.(nrrec(ng).eq.0))) THEN
5570!
5571! Compute detide least-squares coefficients. Build coefficient squared
5572! matrix C(0:2*NTC,0:2*NTC) to invert. It is 2*NTC because we are
5573! solving for real components Ak and Bk. The zero rows and column is
5574! for the coefficients associated with the time mean.
5575!
5576! F(t) = Fmean + SUM [ Ak sin(omega(k)*t) ]
5577! + SUM [ Bk cos(omega(k)*t) ] for k=1:NTC
5578!
5579! In the code below, all the arrays are collapsed into a single
5580! dimension index such that:
5581!
5582! k=0 mean term
5583! k=1:NTC sine terms
5584! k=NTC+1:2*NTC cosine terms
5585!
5586 IF (domain(ng)%SouthWest_Test(tile)) THEN
5587 c(0,0)=1.0_r8 ! time-averaged coefficient
5588 fac1=1.0_r8/real(hcount(ng),r8) ! global summation factor
5589 DO nk=1,ntc
5590 c(0,nk )=fac1*sinw_sum(nk)
5591 c(0,nk+ntc)=fac1*cosw_sum(nk)
5592 c(nk,0 )=c(0,nk) ! symmetric
5593 c(nk+ntc,0)=c(0,nk+ntc) ! symmetric
5594 DO mk=1,ntc
5595 c(mk,nk)=fac1*sinwsinw(mk,nk)
5596 c(mk,nk+ntc)=fac1*sinwcosw(mk,nk)
5597 c(mk+ntc,nk)=fac1*sinwcosw(nk,mk)
5598 c(mk+ntc,nk+ntc)=fac1*coswcosw(mk,nk)
5599 END DO
5600 END DO
5601 DO nk=0,ntc2
5602 DO mk=0,ntc2
5603 c(nk,mk)=c(mk,nk)
5604 END DO
5605 END DO
5606!
5607! Invert least-squares coefficient matrix by LU decomposition.
5608!
5609 DO mk=0,ntc2
5610 DO nk=0,ntc2
5611 y(mk,nk)=0.0_r8
5612 END DO
5613 y(mk,mk)=1.0_r8 ! identity matrix
5614 END DO
5615 CALL ludcmp (c(0,0), ntc2+1, ntc2+1, indx, d)
5616!
5617! Find inverse by columns. The matrix Y will now contain the inverse
5618! of the least-squares coefficient matrix C, which will have been
5619! destroyed.
5620!
5621 DO nk=0,ntc2
5622 CALL lubksb (c(0,0), ntc2+1, ntc2+1, indx, y(0,nk))
5623 END DO
5624!
5625! Compute time-averaged harmonics for current field average window.
5626!
5627 tide_harmonics(0)=1.0_r8
5628 DO nk=1,ntc
5629 tide_harmonics(nk )=sinw_avg(nk)
5630 tide_harmonics(nk+ntc)=cosw_avg(nk)
5631 END DO
5632!
5633! Scale inverse by the global summation factor.
5634!
5635 DO nk=0,ntc2
5636 DO mk=0,ntc2
5637 y(nk,mk)=fac1*y(nk,mk)
5638 END DO
5639 END DO
5640 END IF
5641!
5642! Set time-averaged factors for each C-grid variable type. Notice that
5643! the I- and J-ranges are all grid types are the same for convinience.
5644# ifdef WET_DRY
5645! In wetting and drying, the sums are devided by the number of times
5646! that each qrid point is wet. This was already computed in above in
5647! routine "set_avg_tile" for nAVG steps time-average window.
5648# endif
5649!
5650# ifdef WET_DRY
5651 DO j=jstrr,jendr
5652 DO i=istrr,iendr
5653 rfac(i,j)=1.0_r8/max(1.0_r8, grid(ng)%rmask_avg(i,j))
5654 ufac(i,j)=1.0_r8/max(1.0_r8, grid(ng)%umask_avg(i,j))
5655 vfac(i,j)=1.0_r8/max(1.0_r8, grid(ng)%vmask_avg(i,j))
5656 END DO
5657 END DO
5658# else
5659 fac=1.0_r8/real(navg(ng),r8)
5660 DO j=jstrr,jendr
5661 DO i=istrr,iendr
5662 rfac(i,j)=fac
5663 ufac(i,j)=fac
5664 vfac(i,j)=fac
5665 END DO
5666 END DO
5667# endif
5668!
5669! Process accumulated detided averages. Notice that the regular
5670! time-averaged field values used here are the ones computed in
5671! routine "set_avg_tile".
5672!
5673 IF (aout(idfsud,ng)) THEN
5674 DO j=jstrr,jendr
5675 DO i=istrr,iendr
5676 hsum=0.0_r8
5677 DO nk=0,ntc2
5678 ak(nk)=0.0_r8
5679 DO mk=0,ntc2
5680!! Ak(nk)=Ak(nk)+Y(nk,mk)*TIDES(ng)%zeta_tide(i,j,mk)
5681 ak(nk)=ak(nk)+y(mk,nk)*tides(ng)%zeta_tide(i,j,mk)
5682 END DO
5683 hsum=hsum+ak(nk)*tide_harmonics(nk)*rfac(i,j)
5684 END DO
5685 tides(ng)%zeta_detided(i,j)=average(ng)%avgzeta(i,j)- &
5686 & hsum
5687 END DO
5688 END DO
5689 END IF
5690
5691 IF (aout(idu2dd,ng)) THEN
5692 DO j=jstrr,jendr
5693 DO i=istr,iendr
5694 hsum=0.0_r8
5695 DO nk=0,ntc2
5696 ak(nk)=0.0_r8
5697 DO mk=0,ntc2
5698!! Ak(nk)=Ak(nk)+Y(nk,mk)*TIDES(ng)%ubar_tide(i,j,mk)
5699 ak(nk)=ak(nk)+y(mk,nk)*tides(ng)%ubar_tide(i,j,mk)
5700 END DO
5701 hsum=hsum+ak(nk)*tide_harmonics(nk)*ufac(i,j)
5702 END DO
5703 tides(ng)%ubar_detided(i,j)=average(ng)%avgu2d(i,j)- &
5704 & hsum
5705 END DO
5706 END DO
5707 END IF
5708
5709 IF (aout(idv2dd,ng)) THEN
5710 DO j=jstr,jendr
5711 DO i=istrr,iendr
5712 hsum=0.0_r8
5713 DO nk=0,ntc2
5714 ak(nk)=0.0_r8
5715 DO mk=0,ntc2
5716!! Ak(nk)=Ak(nk)+Y(nk,mk)*TIDES(ng)%vbar_tide(i,j,mk)
5717 ak(nk)=ak(nk)+y(mk,nk)*tides(ng)%vbar_tide(i,j,mk)
5718 END DO
5719 hsum=hsum+ak(nk)*tide_harmonics(nk)*vfac(i,j)
5720 END DO
5721 tides(ng)%vbar_detided(i,j)=average(ng)%avgv2d(i,j)- &
5722 & hsum
5723 END DO
5724 END DO
5725 END IF
5726
5727# ifdef SOLVE3D
5728 IF (aout(idu3dd,ng)) THEN
5729 DO k=1,n(ng)
5730 DO j=jstrr,jendr
5731 DO i=istr,iendr
5732 hsum=0.0_r8
5733 DO nk=0,ntc2
5734 ak(nk)=0.0_r8
5735 DO mk=0,ntc2
5736!! Ak(nk)=Ak(nk)+Y(nk,mk)*TIDES(ng)%u_tide(i,j,k,mk)
5737 ak(nk)=ak(nk)+y(mk,nk)*tides(ng)%u_tide(i,j,k,mk)
5738 END DO
5739 hsum=hsum+ak(nk)*tide_harmonics(nk)*ufac(i,j)
5740 END DO
5741 tides(ng)%u_detided(i,j,k)=average(ng)%avgu3d(i,j,k)- &
5742 & hsum
5743 END DO
5744 END DO
5745 END DO
5746 END IF
5747
5748 IF (aout(idv3dd,ng)) THEN
5749 DO k=1,n(ng)
5750 DO j=jstr,jendr
5751 DO i=istrr,iendr
5752 hsum=0.0_r8
5753 DO nk=0,ntc2
5754 ak(nk)=0.0_r8
5755 DO mk=0,ntc2
5756!! Ak(nk)=Ak(nk)+Y(nk,mk)*TIDES(ng)%v_tide(i,j,k,mk)
5757 ak(nk)=ak(nk)+y(mk,nk)*tides(ng)%v_tide(i,j,k,mk)
5758 END DO
5759 hsum=hsum+ak(nk)*tide_harmonics(nk)*vfac(i,j)
5760 END DO
5761 tides(ng)%v_detided(i,j,k)=average(ng)%avgv3d(i,j,k)- &
5762 & hsum
5763 END DO
5764 END DO
5765 END DO
5766 END IF
5767
5768 DO it=1,nat
5769 IF (aout(idtrcd(it),ng)) THEN
5770 DO k=1,n(ng)
5771 DO j=jstr,jendr
5772 DO i=istrr,iendr
5773 hsum=0.0_r8
5774 DO nk=0,ntc2
5775 ak(nk)=0.0_r8
5776 DO mk=0,ntc2
5777!! Ak(nk)=Ak(nk)+ &
5778!! & Y(nk,mk)*TIDES(ng)%t_tide(i,j,k,mk,it)
5779 ak(nk)=ak(nk)+ &
5780 & y(mk,nk)*tides(ng)%t_tide(i,j,k,mk,it)
5781 END DO
5782 hsum=hsum+ak(nk)*tide_harmonics(nk)*rfac(i,j)
5783 END DO
5784 tides(ng)%t_detided(i,j,k,it)=average(ng)%avgt(i,j,k, &
5785 & it)- &
5786 & hsum
5787 END DO
5788 END DO
5789 END DO
5790 END IF
5791 END DO
5792# endif
5793 END IF
5794
5795 RETURN
lubksb
subroutine lubksb(a, n, np, indx, b)
Definition lubksb.F:3
ludcmp
subroutine ludcmp(a, n, np, indx, d)
Definition ludcmp.F:3
mod_ncparam::idu3dd
integer idu3dd
Definition mod_ncparam.F:350
mod_ncparam::idv3dd
integer idv3dd
Definition mod_ncparam.F:388
mod_ncparam::idfsud
integer idfsud
Definition mod_ncparam.F:207
mod_ncparam::idtrcd
integer, dimension(:), allocatable idtrcd
Definition mod_ncparam.F:569
mod_ncparam::idv2dd
integer idv2dd
Definition mod_ncparam.F:385
mod_ncparam::idu2dd
integer idu2dd
Definition mod_ncparam.F:347
mod_param::nat
integer nat
Definition mod_param.F:499
mod_scalars::hcount
integer, dimension(:), allocatable hcount
Definition mod_scalars.F:1206

References mod_ncparam::aout, mod_average::average, mod_param::domain, mod_grid::grid, mod_scalars::hcount, mod_ncparam::idfsud, mod_ncparam::idtrcd, mod_ncparam::idu2dd, mod_ncparam::idu3dd, mod_ncparam::idv2dd, mod_ncparam::idv3dd, mod_scalars::iic, lubksb(), ludcmp(), mod_param::n, mod_param::nat, mod_scalars::navg, mod_scalars::nrrec, mod_scalars::ntsavg, mod_scalars::ntstart, mod_ocean::ocean, and mod_tides::tides.

Referenced by set_avg().

Here is the call graph for this function:
Here is the caller graph for this function: