ROMS
Loading...
Searching...
No Matches
ad_ini_fields.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE ad_ini_fields_mod
3#ifdef ADJOINT
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group Andrew M. Moore !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This routine initializes other time levels for 2D adjoint fields. !
13! It also couples 3D and 2D momentum equations: it initializes 2D !
14! momentum (ubar,vbar) to the vertical integral of initial 3D !
15! momentum (u,v). !
16! !
17!=======================================================================
18!
19 USE mod_param
20 USE mod_grid
21# ifdef SOLVE3D
22 USE mod_coupling
23# endif
24 USE mod_ncparam
25 USE mod_ocean
26 USE mod_scalars
27# if defined SEDIMENT && defined SED_MORPH && defined SOLVE3D
28 USE mod_sedbed
29 USE mod_sediment
30# endif
31!
32 USE ad_exchange_2d_mod
33# ifdef SOLVE3D
34 USE ad_exchange_3d_mod
35# endif
36# ifdef DISTRIBUTE
37 USE mp_exchange_mod, ONLY : ad_mp_exchange2d
38# ifdef SOLVE3D
39 USE mp_exchange_mod, ONLY : ad_mp_exchange3d, ad_mp_exchange4d
40# endif
41# endif
42# ifdef SOLVE3D
43 USE ad_set_depth_mod, ONLY : ad_set_depth_tile
44 USE ad_t3dbc_mod, ONLY : ad_t3dbc_tile
45 USE ad_u3dbc_mod, ONLY : ad_u3dbc_tile
46 USE ad_v3dbc_mod, ONLY : ad_v3dbc_tile
47# endif
48 USE ad_u2dbc_mod, ONLY : ad_u2dbc_tile
49 USE ad_v2dbc_mod, ONLY : ad_v2dbc_tile
50 USE ad_zetabc_mod, ONLY : ad_zetabc_tile
51!
52 implicit none
53!
54 PRIVATE
55 PUBLIC :: ad_ini_fields
56 PUBLIC :: ad_ini_zeta
57# ifdef SOLVE3D
58 PUBLIC :: ad_set_zeta_timeavg
59# endif
60 PUBLIC :: ad_out_fields
61 PUBLIC :: ad_out_zeta
62!
63 CONTAINS
64!
65!***********************************************************************
66 SUBROUTINE ad_ini_fields (ng, tile, model)
67!***********************************************************************
68!
69 USE mod_stepping
70!
71! Imported variable declarations.
72!
73 integer, intent(in) :: ng, tile, model
74!
75! Local variable declarations.
76!
77 character (len=*), parameter :: myfile = &
78 & __FILE__
79!
80# include "tile.h"
81!
82# ifdef PROFILE
83 CALL wclock_on (ng, iadm, 2, __line__, myfile)
84# endif
85 CALL ad_ini_fields_tile (ng, tile, model, &
86 & lbi, ubi, lbj, ubj, &
87 & imins, imaxs, jmins, jmaxs, &
88 & kstp(ng), krhs(ng), knew(ng), &
89# ifdef SOLVE3D
90 & nstp(ng), nnew(ng), &
91# endif
92# ifdef MASKING
93 & grid(ng) % rmask, &
94 & grid(ng) % umask, &
95 & grid(ng) % vmask, &
96# endif
97# ifdef SOLVE3D
98 & grid(ng) % Hz, &
99 & grid(ng) % ad_Hz, &
100 & ocean(ng) % ad_t, &
101 & ocean(ng) % u, &
102 & ocean(ng) % ad_u, &
103 & ocean(ng) % v, &
104 & ocean(ng) % ad_v, &
105# endif
106 & ocean(ng) % ubar, &
107 & ocean(ng) % ad_ubar_sol, &
108 & ocean(ng) % ad_ubar, &
109 & ocean(ng) % vbar, &
110 & ocean(ng) % ad_vbar_sol, &
111 & ocean(ng) % ad_vbar, &
112 & ocean(ng) % zeta, &
113 & ocean(ng) % ad_zeta)
114# ifdef PROFILE
115 CALL wclock_off (ng, iadm, 2, __line__, myfile)
116# endif
117!
118 RETURN
119 END SUBROUTINE ad_ini_fields
120!
121!***********************************************************************
122 SUBROUTINE ad_ini_fields_tile (ng, tile, model, &
123 & LBi, UBi, LBj, UBj, &
124 & IminS, ImaxS, JminS, JmaxS, &
125 & kstp, krhs, knew, &
126# ifdef SOLVE3D
127 & nstp, nnew, &
128# endif
129# ifdef MASKING
130 & rmask, umask, vmask, &
131# endif
132# ifdef SOLVE3D
133 & Hz, ad_Hz, &
134 & ad_t, &
135 & u, ad_u, &
136 & v, ad_v, &
137# endif
138 & ubar, ad_ubar_sol, ad_ubar, &
139 & vbar, ad_vbar_sol, ad_vbar, &
140 & zeta, ad_zeta)
141!***********************************************************************
142!
143! Imported variable declarations.
144!
145 integer, intent(in) :: ng, tile, model
146 integer, intent(in) :: LBi, UBi, LBj, UBj
147 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
148 integer, intent(in) :: kstp, krhs, knew
149# ifdef SOLVE3D
150 integer, intent(in) :: nstp, nnew
151# endif
152!
153# ifdef ASSUMED_SHAPE
154# ifdef MASKING
155 real(r8), intent(in) :: rmask(LBi:,LBj:)
156 real(r8), intent(in) :: umask(LBi:,LBj:)
157 real(r8), intent(in) :: vmask(LBi:,LBj:)
158# endif
159# ifdef SOLVE3D
160 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
161 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
162 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
163# endif
164 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
165 real(r8), intent(in) :: vbar(LBi:,LBj:,:)
166 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
167# ifdef SOLVE3D
168 real(r8), intent(inout) :: ad_Hz(LBi:,LBj:,:)
169 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
170 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
171 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
172# endif
173 real(r8), intent(inout) :: ad_ubar_sol(LBi:,LBj:)
174 real(r8), intent(inout) :: ad_vbar_sol(LBi:,LBj:)
175
176 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
177 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
178 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
179
180# else
181
182# ifdef MASKING
183 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
184 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
185 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
186# endif
187# ifdef SOLVE3D
188 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
189 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
190 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
191# endif
192 real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
193 real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
194 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
195# ifdef SOLVE3D
196# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
197 real(r8), intent(inout) :: ad_bed(LBi:UBi,LBj:UBj,Nbed,MBEDP)
198 real(r8), intent(inout) :: ad_bed_thick0(LBi:UBi,LBj:UBj)
199 real(r8), intent(inout) :: ad_bed_thick(LBi:UBi,LBj:UBj,3)
200# endif
201 real(r8), intent(inout) :: ad_Hz(LBi:UBi,LBj:UBj,N(ng))
202 real(r8), intent(inout) :: ad_Zt_avg1(LBi:UBi,LBj:UBj)
203 real(r8), intent(inout) :: ad_z_r(LBi:UBi,LBj:UBj,N(ng))
204 real(r8), intent(inout) :: ad_z_w(LBi:UBi,LBj:UBj,0:N(ng))
205
206 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
207 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
208 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
209# endif
210 real(r8), intent(inout) :: ad_ubar_sol(LBi:UBi,LBj:UBj)
211 real(r8), intent(inout) :: ad_vbar_sol(LBi:UBi,LBj:UBj)
212
213 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
214 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
215 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
216# endif
217!
218! Local variable declarations.
219!
220 integer :: i, ic, itrc, j, k, kbed
221
222 real(r8) :: cff1
223 real(r8) :: adfac, ad_cff1, ad_cff2
224# ifdef SOLVE3D
225 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: CF
226 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC
227
228 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_CF
229 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_DC
230# endif
231
232# include "set_bounds.h"
233!
234!-----------------------------------------------------------------------
235! Initialize adjoint private variables.
236!-----------------------------------------------------------------------
237!
238 ad_cff1=0.0_r8
239 ad_cff2=0.0_r8
240# ifdef SOLVE3D
241 DO k=0,n(ng)
242 DO i=imins,imaxs
243 ad_cf(i,k)=0.0_r8
244 ad_dc(i,k)=0.0_r8
245 END DO
246 END DO
247# endif
248
249# ifdef SOLVE3D
250!
251!-----------------------------------------------------------------------
252! Adjoint of initialize other time levels for tracers. Only time level
253! "nstp" is needed in the adjoint.
254!-----------------------------------------------------------------------
255!
256! Apply boundary conditions.
257!
258# ifdef DISTRIBUTE
259!^ CALL mp_exchange4d (ng, tile, model, 1, &
260!^ & LBi, UBi, LBj, UBj, 1, N(ng), 1, NT(ng), &
261!^ & NghostPoints, &
262!^ & EWperiodic(ng), NSperiodic(ng), &
263!^ & tl_t(:,:,:,nstp,:), &
264!^ & tl_t(:,:,:,nnew,:))
265!^ only nstp needed
266 CALL ad_mp_exchange4d (ng, tile, model, 1, &
267 & lbi, ubi, lbj, ubj, 1, n(ng), 1, nt(ng), &
268 & nghostpoints, &
269 & ewperiodic(ng), nsperiodic(ng), &
270 & ad_t(:,:,:,nstp,:))
271!
272# endif
273
274 ic=0
275 DO itrc=1,nt(ng)
276 IF (ltracerclm(itrc,ng).and.lnudgetclm(itrc,ng)) THEN
277 ic=ic+1 ! OBC nudging coefficient index
278 END IF
279 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
280!! CALL exchange_r3d_tile (ng, tile, &
281!! & LBi, UBi, LBj, UBj, 1, N(ng), &
282!! & tl_t(:,:,:,nnew,itrc))
283!!
284!! CALL ad_exchange_r3d_tile (ng, tile, &
285!! & LBi, UBi, LBj, UBj, 1, N(ng), &
286!! & ad_t(:,:,:,nnew,itrc))
287!^ CALL exchange_r3d_tile (ng, tile, &
288!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
289!^ & tl_t(:,:,:,nstp,itrc))
290!^ only nstp needed
291 CALL ad_exchange_r3d_tile (ng, tile, &
292 & lbi, ubi, lbj, ubj, 1, n(ng), &
293 & ad_t(:,:,:,nstp,itrc))
294 END IF
295!
296!! CALL tl_t3dbc_tile (ng, tile, itrc, ic, &
297!! & LBi, UBi, LBj, UBj, N(ng), NT(ng), &
298!! & IminS, ImaxS, JminS, JmaxS, &
299!! & nstp, nnew, &
300!! & tl_t)
301!!
302!! CALL ad_t3dbc_tile (ng, tile, itrc, ic, &
303!! & LBi, UBi, LBj, UBj, N(ng), NT(ng), &
304!! & IminS, ImaxS, JminS, JmaxS, &
305!! & nstp, nnew, &
306!! & ad_t)
307!^ CALL tl_t3dbc_tile (ng, tile, itrc, ic, &
308!^ & LBi, UBi, LBj, UBj, N(ng), NT(ng), &
309!^ & IminS, ImaxS, JminS, JmaxS, &
310!^ & nstp, nstp, &
311!^ & tl_t)
312!^ only nstp needed
313 CALL ad_t3dbc_tile (ng, tile, itrc, ic, &
314 & lbi, ubi, lbj, ubj, n(ng), nt(ng), &
315 & imins, imaxs, jmins, jmaxs, &
316 & nstp, nstp, &
317 & ad_t)
318!
319! Adjoint of tracers initialization.
320!
321 DO k=1,n(ng)
322 DO j=jstrb,jendb
323 DO i=istrb,iendb
324!^ tl_t(i,j,k,nstp,itrc)=tl_cff1
325!! tl_t(i,j,k,nnew,itrc)=tl_cff1
326!^
327 ad_cff1=ad_cff1+ad_t(i,j,k,nstp,itrc)
328!! & ad_t(i,j,k,nnew,itrc)
329 ad_t(i,j,k,nstp,itrc)=0.0_r8
330!! ad_t(i,j,k,nnew,itrc)=0.0_r8
331# ifdef MASKING
332!^ tl_cff1=tl_cff1*rmask(i,j)
333!^
334 ad_cff1=ad_cff1*rmask(i,j)
335# endif
336!^ tl_cff1=tl_t(i,j,k,nstp,itrc)
337!^
338 ad_t(i,j,k,nstp,itrc)=ad_t(i,j,k,nstp,itrc)+ad_cff1
339 ad_cff1=0.0_r8
340 END DO
341 END DO
342 END DO
343 END DO
344# endif
345
346# ifdef SOLVE3D
347!
348!-----------------------------------------------------------------------
349! Adjoint of compute vertically-integrated momentum (tl_ubar, tl_vbar)
350! from initial 3D momentum (tl_u, tl_v).
351!-----------------------------------------------------------------------
352!
353! Apply boundary conditions.
354!
355# ifdef DISTRIBUTE
356# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
357!^ CALL mp_exchange2d (ng, tile, model, 2, &
358!^ & LBi, UBi, LBj, UBj, &
359!^ & NghostPoints, &
360!^ & EWperiodic(ng), NSperiodic(ng), &
361!^ & tl_ubar(:,:,kstp), tl_vbar(:,:,kstp))
362!^
363 CALL ad_mp_exchange2d (ng, tile, model, 2, &
364 & lbi, ubi, lbj, ubj, &
365 & nghostpoints, &
366 & ewperiodic(ng), nsperiodic(ng), &
367 & ad_ubar(:,:,kstp), ad_vbar(:,:,kstp))
368# else
369!^ CALL mp_exchange2d (ng, tile, model, 4, &
370!^ & LBi, UBi, LBj, UBj, &
371!^ & NghostPoints, &
372!^ & EWperiodic(ng), NSperiodic(ng), &
373!^ & tl_ubar(:,:,kstp), tl_vbar(:,:,kstp), &
374!^ & tl_ubar(:,:,knew), tl_vbar(:,:,knew))
375!^
376 CALL ad_mp_exchange2d (ng, tile, model, 4, &
377 & lbi, ubi, lbj, ubj, &
378 & nghostpoints, &
379 & ewperiodic(ng), nsperiodic(ng), &
380 & ad_ubar(:,:,kstp), ad_vbar(:,:,kstp), &
381 & ad_ubar(:,:,knew), ad_vbar(:,:,knew))
382# endif
383!
384# endif
385
386 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
387# if !(defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3)
388!^ CALL exchange_v2d_tile (ng, tile, &
389!^ & LBi, UBi, LBj, UBj, &
390!^ & tl_vbar(:,:,knew))
391!^
392 CALL ad_exchange_v2d_tile (ng, tile, &
393 & lbi, ubi, lbj, ubj, &
394 & ad_vbar(:,:,knew))
395!^ CALL exchange_u2d_tile (ng, tile, &
396!^ & LBi, UBi, LBj, UBj, &
397!^ & tl_ubar(:,:,knew))
398!^
399 CALL ad_exchange_u2d_tile (ng, tile, &
400 & lbi, ubi, lbj, ubj, &
401 & ad_ubar(:,:,knew))
402# endif
403!^ CALL exchange_v2d_tile (ng, tile, &
404!^ & LBi, UBi, LBj, UBj, &
405!^ & tl_vbar(:,:,kstp))
406!^
407 CALL ad_exchange_v2d_tile (ng, tile, &
408 & lbi, ubi, lbj, ubj, &
409 & ad_vbar(:,:,kstp))
410!^ CALL exchange_u2d_tile (ng, tile, &
411!^ & LBi, UBi, LBj, UBj, &
412!^ & tl_ubar(:,:,kstp))
413!^
414 CALL ad_exchange_u2d_tile (ng, tile, &
415 & lbi, ubi, lbj, ubj, &
416 & ad_ubar(:,:,kstp))
417 END IF
418!
419 IF (.not.(any(ad_lbc(:,isubar,ng)%radiation).or. &
420 & any(ad_lbc(:,isvbar,ng)%radiation).or. &
421 & any(ad_lbc(:,isubar,ng)%Flather).or. &
422 & any(ad_lbc(:,isvbar,ng)%Flather))) THEN
423# if !(defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3)
424!^ CALL tl_v2dbc_tile (ng, tile, &
425!^ & LBi, UBi, LBj, UBj, &
426!^ & IminS, ImaxS, JminS, JmaxS, &
427!^ & krhs, kstp, knew, &
428!^ & ubar, vbar, zeta, &
429!^ & tl_ubar, tl_vbar, tl_zeta)
430!^
431 CALL ad_v2dbc_tile (ng, tile, &
432 & lbi, ubi, lbj, ubj, &
433 & imins, imaxs, jmins, jmaxs, &
434 & krhs, kstp, knew, &
435 & ubar, vbar, zeta, &
436 & ad_ubar, ad_vbar, ad_zeta)
437!^ CALL tl_u2dbc_tile (ng, tile, &
438!^ & LBi, UBi, LBj, UBj, &
439!^ & IminS, ImaxS, JminS, JmaxS, &
440!^ & krhs, kstp, knew, &
441!^ & ubar, vbar, zeta, &
442!^ & tl_ubar, tl_vbar, tl_zeta)
443!^
444 CALL ad_u2dbc_tile (ng, tile, &
445 & lbi, ubi, lbj, ubj, &
446 & imins, imaxs, jmins, jmaxs, &
447 & krhs, kstp, knew, &
448 & ubar, vbar, zeta, &
449 & ad_ubar, ad_vbar, ad_zeta)
450# endif
451!^ CALL tl_v2dbc_tile (ng, tile, &
452!^ & LBi, UBi, LBj, UBj, &
453!^ & IminS, ImaxS, JminS, JmaxS, &
454!^ & krhs, kstp, kstp, &
455!^ & ubar, vbar, zeta, &
456!^ & tl_ubar, tl_vbar, tl_zeta)
457!^
458 CALL ad_v2dbc_tile (ng, tile, &
459 & lbi, ubi, lbj, ubj, &
460 & imins, imaxs, jmins, jmaxs, &
461 & krhs, kstp, kstp, &
462 & ubar, vbar, zeta, &
463 & ad_ubar, ad_vbar, ad_zeta)
464!^ CALL tl_u2dbc_tile (ng, tile, &
465!^ & LBi, UBi, LBj, UBj, &
466!^ & IminS, ImaxS, JminS, JmaxS, &
467!^ & krhs, kstp, kstp, &
468!^ & ubar, vbar, zeta, &
469!^ & tl_ubar, tl_vbar, tl_zeta)
470!^
471 CALL ad_u2dbc_tile (ng, tile, &
472 & lbi, ubi, lbj, ubj, &
473 & imins, imaxs, jmins, jmaxs, &
474 & krhs, kstp, kstp, &
475 & ubar, vbar, zeta, &
476 & ad_ubar, ad_vbar, ad_zeta)
477 END IF
478!
479! Load 2D adjoint momentum solution into IO arrays.
480!
481 DO j=jstrt,jendt
482 DO i=istrp,iendt
483# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
484 ad_ubar_sol(i,j)=ad_ubar(i,j,kstp)
485# else
486 ad_ubar_sol(i,j)=ad_ubar(i,j,kstp)+ad_ubar(i,j,knew)
487# endif
488 END DO
489 IF (j.ge.jstrp) THEN
490 DO i=istrt,iendt
491# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
492 ad_vbar_sol(i,j)=ad_vbar(i,j,kstp)
493# else
494 ad_vbar_sol(i,j)=ad_vbar(i,j,kstp)+ad_vbar(i,j,knew)
495# endif
496 END DO
497 END IF
498 END DO
499!
500! Adjoint of compute vertically-integrated momentum (tl_ubar, tl_vbar)
501! from initial 3D momentum (tl_u, tl_v). Here DC(i,1:N) are the grid
502! cell thicknesses, DC(i,0) is total depth of the water column, and
503! CF(i,0) is the vertical integral.
504!
505 DO j=jstrb,jendb
506 IF (j.ge.jstrm) THEN
507 DO i=istrb,iendb
508 dc(i,0)=0.0_r8
509 cf(i,0)=0.0_r8
510 END DO
511 DO k=1,n(ng)
512 DO i=istrb,iendb
513 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i,j-1,k))
514 dc(i,0)=dc(i,0)+dc(i,k)
515 cf(i,0)=cf(i,0)+dc(i,k)*v(i,j,k,nstp)
516 END DO
517 END DO
518 DO i=istrb,iendb
519 cff1=1.0_r8/dc(i,0)
520# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
521!^ tl_vbar(i,j,kstp)=tl_cff2
522!^
523 ad_cff2=ad_cff2+ad_vbar(i,j,kstp)
524 ad_vbar(i,j,kstp)=0.0_r8
525# else
526!^ tl_vbar(i,j,kstp)=tl_cff2
527!^ tl_vbar(i,j,knew)=tl_cff2
528!^
529 ad_cff2=ad_cff2+ad_vbar(i,j,knew)+ &
530 & ad_vbar(i,j,kstp)
531 ad_vbar(i,j,knew)=0.0_r8
532 ad_vbar(i,j,kstp)=0.0_r8
533# endif
534# ifdef MASKING
535!^ tl_cff2=tl_cff2*vmask(i,j)
536!^
537 ad_cff2=ad_cff2*vmask(i,j)
538# endif
539!^ tl_cff2=tl_CF(i,0)*cff1+CF(i,0)*tl_cff1
540!^
541 ad_cff1=ad_cff1+cf(i,0)*ad_cff2
542 ad_cf(i,0)=ad_cf(i,0)+cff1*ad_cff2
543 ad_cff2=0.0_r8
544!^ tl_cff1=-cff1*cff1*tl_DC(i,0)
545!^
546 ad_dc(i,0)=ad_dc(i,0)-cff1*cff1*ad_cff1
547 ad_cff1=0.0_r8
548 END DO
549 DO k=1,n(ng)
550 DO i=istrb,iendb
551!^ tl_CF(i,0)=tl_CF(i,0)+tl_DC(i,k)*v(i,j,k,nstp)+ &
552!^ & DC(i,k)*tl_v(i,j,k,nstp)
553!^
554 ad_dc(i,k)=ad_dc(i,k)+v(i,j,k,nstp)*ad_cf(i,0)
555 ad_v(i,j,k,nstp)=ad_v(i,j,k,nstp)+dc(i,k)*ad_cf(i,0)
556!^ tl_DC(i,0)=tl_DC(i,0)+tl_DC(i,k)
557!^
558 ad_dc(i,k)=ad_dc(i,k)+ad_dc(i,0)
559!^ tl_DC(i,k)=0.5_r8*(tl_Hz(i,j,k)+tl_Hz(i,j-1,k))
560!^
561 adfac=0.5_r8*ad_dc(i,k)
562 ad_hz(i,j-1,k)=ad_hz(i,j-1,k)+adfac
563 ad_hz(i,j ,k)=ad_hz(i,j ,k)+adfac
564 ad_dc(i,k)=0.0_r8
565 END DO
566 END DO
567 DO i=istrb,iendb
568!^ tl_CF(i,0)=0.0_r8
569!^
570 ad_cf(i,0)=0.0_r8
571!^ tl_DC(i,0)=0.0_r8
572!^
573 ad_dc(i,0)=0.0_r8
574 END DO
575 END IF
576!
577 DO i=istrm,iendb
578 dc(i,0)=0.0_r8
579 cf(i,0)=0.0_r8
580 END DO
581 DO k=1,n(ng)
582 DO i=istrm,iendb
583 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i-1,j,k))
584 dc(i,0)=dc(i,0)+dc(i,k)
585 cf(i,0)=cf(i,0)+dc(i,k)*u(i,j,k,nstp)
586 END DO
587 END DO
588 DO i=istrm,iendb
589 cff1=1.0_r8/dc(i,0)
590# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
591!^ tl_ubar(i,j,kstp)=tl_cff2
592!^
593 ad_cff2=ad_cff2+ad_ubar(i,j,kstp)
594 ad_ubar(i,j,kstp)=0.0_r8
595# else
596!^ tl_ubar(i,j,kstp)=tl_cff2
597!^ tl_ubar(i,j,knew)=tl_cff2
598!^
599 ad_cff2=ad_cff2+ad_ubar(i,j,knew)+ &
600 & ad_ubar(i,j,kstp)
601 ad_ubar(i,j,knew)=0.0_r8
602 ad_ubar(i,j,kstp)=0.0_r8
603# endif
604# ifdef MASKING
605!^ tl_cff2=tl_cff2*umask(i,j)
606!^
607 ad_cff2=ad_cff2*umask(i,j)
608# endif
609!^ tl_cff2=tl_CF(i,0)*cff1+CF(i,0)*tl_cff1
610!^
611 ad_cff1=ad_cff1+cf(i,0)*ad_cff2
612 ad_cf(i,0)=ad_cf(i,0)+cff1*ad_cff2
613 ad_cff2=0.0_r8
614!^ tl_cff1=-cff1*cff1*tl_DC(i,0)
615!^
616 ad_dc(i,0)=ad_dc(i,0)-cff1*cff1*ad_cff1
617 ad_cff1=0.0_r8
618 END DO
619 DO k=1,n(ng)
620 DO i=istrm,iendb
621!^ tl_CF(i,0)=tl_CF(i,0)+tl_DC(i,k)*u(i,j,k,nstp)+ &
622!^ & DC(i,k)*tl_u(i,j,k,nstp)
623!^
624 ad_dc(i,k)=ad_dc(i,k)+u(i,j,k,nstp)*ad_cf(i,0)
625 ad_u(i,j,k,nstp)=ad_u(i,j,k,nstp)+dc(i,k)*ad_cf(i,0)
626!^ tl_DC(i,0)=tl_DC(i,0)+tl_DC(i,k)
627!^
628 ad_dc(i,k)=ad_dc(i,k)+ad_dc(i,0)
629!^ tl_DC(i,k)=0.5_r8*(tl_Hz(i,j,k)+tl_Hz(i-1,j,k))
630!^
631 adfac=0.5_r8*ad_dc(i,k)
632 ad_hz(i-1,j,k)=ad_hz(i-1,j,k)+adfac
633 ad_hz(i ,j,k)=ad_hz(i ,j,k)+adfac
634 ad_dc(i,k)=0.0_r8
635 END DO
636 END DO
637 DO i=istrm,iendb
638!^ tl_CF(i,0)=0.0_r8
639!^
640 ad_cf(i,0)=0.0_r8
641!^ tl_DC(i,0)=0.0_r8
642!^
643 ad_dc(i,0)=0.0_r8
644 END DO
645 END DO
646
647# else
648!
649!-----------------------------------------------------------------------
650! Adjoint of initialize other time levels for 2D momentum.
651!-----------------------------------------------------------------------
652!
653! Apply boundary conditions.
654!
655# ifdef DISTRIBUTE
656!^ CALL mp_exchange2d (ng, tile, model, 4, &
657!^ & LBi, UBi, LBj, UBj, &
658!^ & NghostPoints, &
659!^ & EWperiodic(ng), NSperiodic(ng), &
660!^ & tl_ubar(:,:,kstp), tl_vbar(:,:,kstp), &
661!^ & tl_ubar(:,:,krhs), tl_vbar(:,:,krhs))
662!^
663 CALL ad_mp_exchange2d (ng, tile, model, 4, &
664 & lbi, ubi, lbj, ubj, &
665 & nghostpoints, &
666 & ewperiodic(ng), nsperiodic(ng), &
667 & ad_ubar(:,:,kstp), ad_vbar(:,:,kstp), &
668 & ad_ubar(:,:,krhs), ad_vbar(:,:,krhs))
669!
670# endif
671
672 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
673!^ CALL exchange_v2d_tile (ng, tile, &
674!^ & LBi, UBi, LBj, UBj, &
675!^ & tl_vbar(:,:,krhs))
676!^
677 CALL ad_exchange_v2d_tile (ng, tile, &
678 & lbi, ubi, lbj, ubj, &
679 & ad_vbar(:,:,krhs))
680!^ CALL exchange_u2d_tile (ng, tile, &
681!^ & LBi, UBi, LBj, UBj, &
682!^ & tl_ubar(:,:,krhs))
683!^
684 CALL ad_exchange_u2d_tile (ng, tile, &
685 & lbi, ubi, lbj, ubj, &
686 & ad_ubar(:,:,krhs))
687
688!^ CALL exchange_v2d_tile (ng, tile, &
689!^ & LBi, UBi, LBj, UBj, &
690!^ & tl_vbar(:,:,kstp))
691!^
692 CALL ad_exchange_v2d_tile (ng, tile, &
693 & lbi, ubi, lbj, ubj, &
694 & ad_vbar(:,:,kstp))
695!^ CALL exchange_u2d_tile (ng, tile, &
696!^ & LBi, UBi, LBj, UBj, &
697!^ & tl_ubar(:,:,kstp))
698!^
699 CALL ad_exchange_u2d_tile (ng, tile, &
700 & lbi, ubi, lbj, ubj, &
701 & ad_ubar(:,:,kstp))
702 END IF
703!
704 IF (.not.(any(ad_lbc(:,isubar,ng)%radiation).or. &
705 & any(ad_lbc(:,isvbar,ng)%radiation).or. &
706 & any(ad_lbc(:,isubar,ng)%Flather).or. &
707 & any(ad_lbc(:,isvbar,ng)%Flather))) THEN
708!^ CALL tl_v2dbc_tile (ng, tile, &
709!^ & LBi, UBi, LBj, UBj, &
710!^ & IminS, ImaxS, JminS, JmaxS, &
711!^ & krhs, kstp, krhs, &
712!^ & ubar, vbar, zeta, &
713!^ & tl_ubar, tl_vbar, tl_zeta)
714!^
715 CALL ad_v2dbc_tile (ng, tile, &
716 & lbi, ubi, lbj, ubj, &
717 & imins, imaxs, jmins, jmaxs, &
718 & krhs, kstp, krhs, &
719 & ubar, vbar, zeta, &
720 & ad_ubar, ad_vbar, ad_zeta)
721!^ CALL tl_u2dbc_tile (ng, tile, &
722!^ & LBi, UBi, LBj, UBj, &
723!^ & IminS, ImaxS, JminS, JmaxS, &
724!^ & krhs, kstp, krhs, &
725!^ & ubar, vbar, zeta, &
726!^ & tl_ubar, tl_vbar, tl_zeta)
727!^
728 CALL ad_u2dbc_tile (ng, tile, &
729 & lbi, ubi, lbj, ubj, &
730 & imins, imaxs, jmins, jmaxs, &
731 & krhs, kstp, krhs, &
732 & ubar, vbar, zeta, &
733 & ad_ubar, ad_vbar, ad_zeta)
734
735!^ CALL tl_v2dbc_tile (ng, tile, &
736!^ & LBi, UBi, LBj, UBj, &
737!^ & IminS, ImaxS, JminS, JmaxS, &
738!^ & krhs, kstp, kstp, &
739!^ & ubar, vbar, zeta, &
740!^ & tl_ubar, tl_vbar, tl_zeta)
741!^
742 CALL ad_v2dbc_tile (ng, tile, &
743 & lbi, ubi, lbj, ubj, &
744 & imins, imaxs, jmins, jmaxs, &
745 & krhs, kstp, kstp, &
746 & ubar, vbar, zeta, &
747 & ad_ubar, ad_vbar, ad_zeta)
748!^ CALL tl_u2dbc_tile (ng, tile, &
749!^ & LBi, UBi, LBj, UBj, &
750!^ & IminS, ImaxS, JminS, JmaxS, &
751!^ & krhs, kstp, kstp, &
752!^ & ubar, vbar, zeta, &
753!^ & tl_ubar, tl_vbar, tl_zeta)
754!^
755 CALL ad_u2dbc_tile (ng, tile, &
756 & lbi, ubi, lbj, ubj, &
757 & imins, imaxs, jmins, jmaxs, &
758 & krhs, kstp, kstp, &
759 & ubar, vbar, zeta, &
760 & ad_ubar, ad_vbar, ad_zeta)
761 END IF
762!
763! Load 2D adjoint momentum solution into IO arrays.
764!
765 DO j=jstrt,jendt
766 DO i=istrp,iendt
767# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
768 ad_ubar_sol(i,j)=ad_ubar(i,j,kstp)
769# else
770 ad_ubar_sol(i,j)=ad_ubar(i,j,kstp)+ad_ubar(i,j,krhs)
771# endif
772 END DO
773 IF (j.ge.jstrp) THEN
774 DO i=istrt,iendt
775# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
776 ad_vbar_sol(i,j)=ad_vbar(i,j,kstp)
777# else
778 ad_vbar_sol(i,j)=ad_vbar(i,j,kstp)+ad_vbar(i,j,krhs)
779# endif
780 END DO
781 END IF
782 END DO
783!
784! Adjoint of initialize other time levels for 2D momentum.
785!
786 DO j=jstrb,jendb
787 IF (j.ge.jstrm) THEN
788 DO i=istrb,iendb
789# if !(defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3)
790!^ tl_vbar(i,j,krhs)=tl_cff2
791!^
792 ad_cff2=ad_cff2+ad_vbar(i,j,krhs)
793 ad_vbar(i,j,krhs)=0.0_r8
794# endif
795!^ tl_vbar(i,j,kstp)=tl_cff2
796!^
797 ad_cff2=ad_cff2+ad_vbar(i,j,kstp)
798 ad_vbar(i,j,kstp)=0.0_r8
799# ifdef MASKING
800!^ tl_cff2=tl_cff2*vmask(i,j)
801!^
802 ad_cff2=ad_cff2*vmask(i,j)
803# endif
804!^ tl_cff2=tl_vbar(i,j,kstp)
805!^
806 ad_vbar(i,j,kstp)=ad_vbar(i,j,kstp)+ad_cff2
807 ad_cff2=0.0_r8
808 END DO
809 END IF
810 DO i=istrm,iendb
811# if !(defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3)
812!^ tl_ubar(i,j,krhs)=tl_cff1
813!^
814 ad_cff1=ad_cff1+ad_ubar(i,j,krhs)
815 ad_ubar(i,j,krhs)=0.0_r8
816# endif
817!^ tl_ubar(i,j,kstp)=tl_cff1
818!^
819 ad_cff1=ad_cff1+ad_ubar(i,j,kstp)
820 ad_ubar(i,j,kstp)=0.0_r8
821# ifdef MASKING
822!^ tl_cff1=tl_cff1*umask(i,j)
823!^
824 ad_cff1=ad_cff1*umask(i,j)
825# endif
826!^ tl_cff1=tl_ubar(i,j,kstp)
827!^
828 ad_ubar(i,j,kstp)=ad_ubar(i,j,kstp)+ad_cff1
829 ad_cff1=0.0_r8
830 END DO
831 END DO
832# endif
833
834# ifdef SOLVE3D
835!
836!-----------------------------------------------------------------------
837! Adjoint of initialize other time levels for 3D momentum.
838!-----------------------------------------------------------------------
839!
840! Apply boundary conditions.
841!
842# ifdef DISTRIBUTE
843!^ CALL mp_exchange3d (ng, tile, model, 4, &
844!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
845!^ & NghostPoints, &
846!^ & EWperiodic(ng), NSperiodic(ng), &
847!^ & tl_u(:,:,:,nstp), tl_v(:,:,:,nstp), &
848!^ & tl_u(:,:,:,nnew), tl_v(:,:,:,nnew))
849!^ only nstp needed
850 CALL ad_mp_exchange3d (ng, tile, model, 2, &
851 & lbi, ubi, lbj, ubj, 1, n(ng), &
852 & nghostpoints, &
853 & ewperiodic(ng), nsperiodic(ng), &
854 & ad_u(:,:,:,nstp), ad_v(:,:,:,nstp))
855# endif
856!
857 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
858!! CALL exchange_v3d_tile (ng, tile, &
859!! & LBi, UBi, LBj, UBj, 1, N(ng), &
860!! & tl_v(:,:,:,nnew))
861!! only nstp needed
862!! CALL exchange_u3d_tile (ng, tile, &
863!! & LBi, UBi, LBj, UBj, 1, N(ng), &
864!! & tl_u(:,:,:,nnew))
865!! only nstp needed
866!^ CALL exchange_v3d_tile (ng, tile, &
867!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
868!^ & tl_v(:,:,:,nstp))
869!^ only nstp needed
870 CALL ad_exchange_v3d_tile (ng, tile, &
871 & lbi, ubi, lbj, ubj, 1, n(ng), &
872 & ad_v(:,:,:,nstp))
873!^ CALL exchange_u3d_tile (ng, tile, &
874!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
875!^ & tl_u(:,:,:,nstp))
876!^ only nstp needed
877 CALL ad_exchange_u3d_tile (ng, tile, &
878 & lbi, ubi, lbj, ubj, 1, n(ng), &
879 & ad_u(:,:,:,nstp))
880 END IF
881!
882!! CALL tl_v3dbc_tile (ng, tile, &
883!! & LBi, UBi, LBj, UBj, N(ng), &
884!! & IminS, ImaxS, JminS, JmaxS, &
885!! & nstp, nnew, &
886!! & tl_v)
887!! only nstp needed
888!! CALL tl_u3dbc_tile (ng, tile, &
889!! & LBi, UBi, LBj, UBj, N(ng), &
890!! & IminS, ImaxS, JminS, JmaxS, &
891!! & nstp, nnew, &
892!! & tl_u)
893!! only nstp needed
894!^ CALL tl_v3dbc_tile (ng, tile, &
895!^ & LBi, UBi, LBj, UBj, N(ng), &
896!^ & IminS, ImaxS, JminS, JmaxS, &
897!^ & nstp, nstp, &
898!^ & tl_v)
899!^ only nstp needed
900 CALL ad_v3dbc_tile (ng, tile, &
901 & lbi, ubi, lbj, ubj, n(ng), &
902 & imins, imaxs, jmins, jmaxs, &
903 & nstp, nstp, &
904 & ad_v)
905!^ CALL tl_u3dbc_tile (ng, tile, &
906!^ & LBi, UBi, LBj, UBj, N(ng), &
907!^ & IminS, ImaxS, JminS, JmaxS, &
908!^ & nstp, nstp, &
909!^ & tl_u)
910!^ only nstp needed
911 CALL ad_u3dbc_tile (ng, tile, &
912 & lbi, ubi, lbj, ubj, n(ng), &
913 & imins, imaxs, jmins, jmaxs, &
914 & nstp, nstp, &
915 & ad_u)
916!
917! Adjoint of initialize other time levels for momentum.
918!
919 DO j=jstrb,jendb
920 IF (j.ge.jstrm) THEN
921 DO k=1,n(ng)
922 DO i=istrb,iendb
923!^ tl_v(i,j,k,nstp)=tl_cff2
924!! tl_v(i,j,k,nnew)=tl_cff2
925!^
926 ad_cff2=ad_cff2+ad_v(i,j,k,nstp)
927!! & +ad_v(i,j,k,nnew) ! only nstp needed
928 ad_v(i,j,k,nstp)=0.0_r8
929!! ad_v(i,j,k,nnew)=0.0_r8
930# ifdef MASKING
931!^ tl_cff2=tl_cff2*vmask(i,j)
932!^
933 ad_cff2=ad_cff2*vmask(i,j)
934# endif
935!^ tl_cff2=tl_v(i,j,k,nstp)
936!^
937 ad_v(i,j,k,nstp)=ad_v(i,j,k,nstp)+ad_cff2
938 ad_cff2=0.0_r8
939 END DO
940 END DO
941 END IF
942 DO k=1,n(ng)
943 DO i=istrm,iendb
944!^ tl_u(i,j,k,nstp)=tl_cff1
945!! tl_u(i,j,k,nnew)=tl_cff1
946!^
947 ad_cff1=ad_cff1+ad_u(i,j,k,nstp)
948!! & +ad_u(i,j,k,nnew) ! only nstp needed
949 ad_u(i,j,k,nstp)=0.0_r8
950!! ad_u(i,j,k,nnew)=0.0_r8
951# ifdef MASKING
952!^ tl_cff1=tl_cff1*umask(i,j)
953!^
954 ad_cff1=ad_cff1*umask(i,j)
955# endif
956!^ tl_cff1=tl_u(i,j,k,nstp)
957!^
958 ad_u(i,j,k,nstp)=ad_u(i,j,k,nstp)+ad_cff1
959 ad_cff1=0.0_r8
960 END DO
961 END DO
962 END DO
963# endif
964!
965 RETURN
966 END SUBROUTINE ad_ini_fields_tile
967
968!
969!***********************************************************************
970 SUBROUTINE ad_ini_zeta (ng, tile, model)
971!***********************************************************************
972!
973 USE mod_stepping
974!
975! Imported variable declarations.
976!
977 integer, intent(in) :: ng, tile, model
978!
979! Local variable declarations.
980!
981 character (len=*), parameter :: myfile = &
982 & __FILE__//", ad_ini_zeta"
983!
984# include "tile.h"
985!
986# ifdef PROFILE
987 CALL wclock_on (ng, iadm, 2, __line__, myfile)
988# endif
989 CALL ad_ini_zeta_tile (ng, tile, model, &
990 & lbi, ubi, lbj, ubj, &
991 & imins, imaxs, jmins, jmaxs, &
992 & kstp(ng), krhs(ng), knew(ng), &
993# ifdef MASKING
994 & grid(ng) % rmask, &
995# endif
996# ifdef WET_DRY_NOT_YET
997 & grid(ng) % h, &
998# endif
999# ifdef SOLVE3D
1000# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
1001 & sedbed(ng) % ad_bed, &
1002 & sedbed(ng) % ad_bed_thick0, &
1003 & sedbed(ng) % ad_bed_thick, &
1004# endif
1005 & coupling(ng) % ad_Zt_avg1, &
1006# endif
1007 & ocean(ng) % zeta, &
1008 & ocean(ng) % ad_zeta_sol, &
1009 & ocean(ng) % ad_zeta)
1010# ifdef PROFILE
1011 CALL wclock_off (ng, iadm, 2, __line__, myfile)
1012# endif
1013!
1014 RETURN
1015 END SUBROUTINE ad_ini_zeta
1016!
1017!***********************************************************************
1018 SUBROUTINE ad_ini_zeta_tile (ng, tile, model, &
1019 & LBi, UBi, LBj, UBj, &
1020 & IminS, ImaxS, JminS, JmaxS, &
1021 & kstp, krhs, knew, &
1022# ifdef MASKING
1023 & rmask, &
1024# endif
1025# ifdef WET_DRY_NOT_YET
1026 & h, &
1027# endif
1028# ifdef SOLVE3D
1029# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
1030 & ad_bed, &
1031 & ad_bed_thick0, ad_bed_thick, &
1032# endif
1033
1034 & ad_Zt_avg1, &
1035# endif
1036 & zeta, ad_zeta_sol, ad_zeta)
1037!***********************************************************************
1038!
1039! Imported variable declarations.
1040!
1041 integer, intent(in) :: ng, tile, model
1042 integer, intent(in) :: LBi, UBi, LBj, UBj
1043 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
1044 integer, intent(in) :: kstp, krhs, knew
1045!
1046# ifdef ASSUMED_SHAPE
1047# ifdef MASKING
1048 real(r8), intent(in) :: rmask(LBi:,LBj:)
1049# endif
1050# ifdef WET_DRY_NOT_YET
1051 real(r8), intent(in) :: h(LBi:,LBj:)
1052# endif
1053 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
1054# ifdef SOLVE3D
1055# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
1056 real(r8), intent(inout) :: ad_bed(LBi:,LBj:,:,:)
1057 real(r8), intent(inout) :: ad_bed_thick0(LBi:,LBj:)
1058 real(r8), intent(inout) :: ad_bed_thick(LBi:,LBj:,:)
1059# endif
1060 real(r8), intent(inout) :: ad_Zt_avg1(LBi:,LBj:)
1061# endif
1062 real(r8), intent(inout) :: ad_zeta_sol(LBi:,LBj:)
1063 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
1064
1065# else
1066
1067# ifdef MASKING
1068 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
1069# endif
1070# ifdef WET_DRY_NOT_YET
1071 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
1072# endif
1073 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
1074# ifdef SOLVE3D
1075# if defined SOLVE3D && defined SEDIMENT && defined SED_MORPH
1076 real(r8), intent(inout) :: ad_bed(LBi:UBi,LBj:UBj,Nbed,MBEDP)
1077 real(r8), intent(inout) :: ad_bed_thick0(LBi:UBi,LBj:UBj)
1078 real(r8), intent(inout) :: ad_bed_thick(LBi:UBi,LBj:UBj,3)
1079# endif
1080 real(r8), intent(inout) :: ad_Zt_avg1(LBi:UBi,LBj:UBj)
1081# endif
1082 real(r8), intent(inout) :: ad_zeta_sol(LBi:UBi,LBj:UBj)
1083 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
1084# endif
1085!
1086! Local variable declarations.
1087!
1088 integer :: Imin, Imax, Jmin, Jmax
1089 integer :: i, j, kbed
1090
1091 real(r8) :: ad_cff1
1092
1093# include "set_bounds.h"
1094!
1095!-----------------------------------------------------------------------
1096! Initialize adjoint private variables.
1097!-----------------------------------------------------------------------
1098!
1099 ad_cff1=0.0_r8
1100
1101# ifdef SOLVE3D
1102# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
1103!
1104!-----------------------------------------------------------------------
1105! Compute initial total thickness for all sediment bed layers.
1106!-----------------------------------------------------------------------
1107!
1108# ifdef DISTRIBUTE
1109!^ CALL mp_exchange2d (ng, tile, model, 3, &
1110!^ & LBi, UBi, LBj, UBj, &
1111!^ & NghostPoints, &
1112!^ & EWperiodic(ng), NSperiodic(ng), &
1113!^ & tl_bed_thick0, &
1114!^ & tl_bed_thick(:,:,1), tl_bed_thick(:,:,2))
1115!^
1116 CALL ad_mp_exchange2d (ng, tile, model, 3, &
1117 & lbi, ubi, lbj, ubj, &
1118 & nghostpoints, &
1119 & ewperiodic(ng), nsperiodic(ng), &
1120 & ad_bed_thick0, &
1121 & ad_bed_thick(:,:,1), ad_bed_thick(:,:,2))
1122!
1123# endif
1124
1125 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1126!^ CALL exchange_r2d_tile (ng, tile, &
1127!^ & LBi, UBi, LBj, UBj, &
1128!^ & tl_bed_thick(:,:,2))
1129!^
1130 CALL ad_exchange_r2d_tile (ng, tile, &
1131 & lbi, ubi, lbj, ubj, &
1132 & ad_bed_thick(:,:,2))
1133!^ CALL exchange_r2d_tile (ng, tile, &
1134!^ & LBi, UBi, LBj, UBj, &
1135!^ & tl_bed_thick(:,:,1))
1136!^
1137 CALL ad_exchange_r2d_tile (ng, tile, &
1138 & lbi, ubi, lbj, ubj, &
1139 & ad_bed_thick(:,:,1))
1140!^ CALL exchange_r2d_tile (ng, tile, &
1141!^ & LBi, UBi, LBj, UBj, &
1142!^ & tl_bed_thick0)
1143!^
1144 CALL ad_exchange_r2d_tile (ng, tile, &
1145 & lbi, ubi, lbj, ubj, &
1146 & ad_bed_thick0)
1147 END IF
1148!
1149 DO j=jstrt,jendt
1150 DO i=istrt,iendt
1151!^ tl_bed_thick(i,j,2)=tl_bed_thick0(i,j)
1152!^ tl_bed_thick(i,j,1)=tl_bed_thick0(i,j)
1153!^
1154 ad_bed_thick0(i,j)=ad_bed_thick0(i,j)+ &
1155 & ad_bed_thick(i,j,1)+ad_bed_thick(i,j,1)
1156 ad_bed_thick(i,j,1)=0.0_r8
1157 ad_bed_thick(i,j,2)=0.0_r8
1158 DO kbed=1,nbed
1159!^ tl_bed_thick0(i,j)=tl_bed_thick0(i,j)+tl_bed(i,j,kbed,ithck)
1160!^
1161 ad_bed(i,j,kbed,ithck)=ad_bed(i,j,kbed,ithck)+ &
1162 & ad_bed_thick0(i,j)
1163 END DO
1164!^ tl_bed_thick0(i,j)=0.0_r8
1165!^
1166 ad_bed_thick0(i,j)=0.0_r8
1167 END DO
1168 END DO
1169# endif
1170!
1171!-----------------------------------------------------------------------
1172! Initialize fast-time averaged free-surface (Zt_avg1) with the inital
1173! free-surface
1174!-----------------------------------------------------------------------
1175!
1176 CALL ad_set_zeta_timeavg (ng, tile, model)
1177# endif
1178!
1179!-----------------------------------------------------------------------
1180! Adjoint of initialize other time levels for free-surface.
1181!-----------------------------------------------------------------------
1182!
1183! Apply boundary conditions.
1184!
1185# ifdef DISTRIBUTE
1186# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1187!^ CALL mp_exchange2d (ng, tile, model, 1, &
1188!^ & LBi, UBi, LBj, UBj, &
1189!^ & NghostPoints, &
1190!^ & EWperiodic(ng), NSperiodic(ng), &
1191!^ & tl_zeta(:,:,kstp))
1192!^
1193 CALL ad_mp_exchange2d (ng, tile, model, 1, &
1194 & lbi, ubi, lbj, ubj, &
1195 & nghostpoints, &
1196 & ewperiodic(ng), nsperiodic(ng), &
1197 & ad_zeta(:,:,kstp))
1198# else
1199# ifdef SOLVE3D
1200!^ CALL mp_exchange2d (ng, tile, model, 2, &
1201!^ & LBi, UBi, LBj, UBj, &
1202!^ & NghostPoints, &
1203!^ & EWperiodic(ng), NSperiodic(ng), &
1204!^ & tl_zeta(:,:,kstp), &
1205!^ & tl_zeta(:,:,knew))
1206!^
1207 CALL ad_mp_exchange2d (ng, tile, model, 2, &
1208 & lbi, ubi, lbj, ubj, &
1209 & nghostpoints, &
1210 & ewperiodic(ng), nsperiodic(ng), &
1211 & ad_zeta(:,:,kstp), &
1212 & ad_zeta(:,:,knew))
1213# else
1214!^ CALL mp_exchange2d (ng, tile, model, 2, &
1215!^ & LBi, UBi, LBj, UBj, 1, 1, &
1216!^ & NghostPoints, &
1217!^ & EWperiodic(ng), NSperiodic(ng), &
1218!^ & tl_zeta(:,:,kstp), &
1219!^ & tl_zeta(:,:,krhs))
1220!^
1221 CALL ad_mp_exchange2d (ng, tile, model, 2, &
1222 & lbi, ubi, lbj, ubj, &
1223 & nghostpoints, &
1224 & ewperiodic(ng), nsperiodic(ng), &
1225 & ad_zeta(:,:,kstp), &
1226 & ad_zeta(:,:,krhs))
1227# endif
1228# endif
1229!
1230# endif
1231
1232 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1233# if !(defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3)
1234# ifdef SOLVE3D
1235!^ CALL exchange_r2d_tile (ng, tile, &
1236!^ & LBi, UBi, LBj, UBj, &
1237!^ & tl_zeta(:,:,knew))
1238!^
1239 CALL ad_exchange_r2d_tile (ng, tile, &
1240 & lbi, ubi, lbj, ubj, &
1241 & ad_zeta(:,:,knew))
1242# else
1243!^ CALL exchange_r2d_tile (ng, tile, &
1244!^ & LBi, UBi, LBj, UBj, &
1245!^ & tl_zeta(:,:,krhs))
1246!^
1247 CALL ad_exchange_r2d_tile (ng, tile, &
1248 & lbi, ubi, lbj, ubj, &
1249 & ad_zeta(:,:,krhs))
1250# endif
1251# endif
1252!^ CALL exchange_r2d_tile (ng, tile, &
1253!^ & LBi, UBi, LBj, UBj, &
1254!^ & tl_zeta(:,:,kstp))
1255!^
1256 CALL ad_exchange_r2d_tile (ng, tile, &
1257 & lbi, ubi, lbj, ubj, &
1258 & ad_zeta(:,:,kstp))
1259 END IF
1260
1261# if !(defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
1262 defined sensitivity_4dvar || defined so_semi)
1263!
1264 IF (.not.(any(ad_lbc(:,isfsur,ng)%radiation).or. &
1265 & any(ad_lbc(:,isfsur,ng)%Chapman_explicit).or. &
1266 & any(ad_lbc(:,isfsur,ng)%Chapman_implicit))) THEN
1267# if !(defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3)
1268# ifdef SOLVE3D
1269!^ CALL tl_zetabc_tile (ng, tile, &
1270!^ & LBi, UBi, LBj, UBj, &
1271!^ & IminS, ImaxS, JminS, JmaxS, &
1272!^ & krhs, kstp, knew, &
1273!^ & zeta, &
1274!^ & tl_zeta)
1275!^
1276 CALL ad_zetabc_tile (ng, tile, &
1277 & lbi, ubi, lbj, ubj, &
1278 & imins, imaxs, jmins, jmaxs, &
1279 & krhs, kstp, knew, &
1280 & zeta, &
1281 & ad_zeta)
1282# else
1283!^ CALL tl_zetabc_tile (ng, tile, &
1284!^ & LBi, UBi, LBj, UBj, &
1285!^ & IminS, ImaxS, JminS, JmaxS, &
1286!^ & krhs, kstp, krhs, &
1287!^ & zeta, &
1288!^ & tl_zeta)
1289!^
1290 CALL ad_zetabc_tile (ng, tile, &
1291 & lbi, ubi, lbj, ubj, &
1292 & imins, imaxs, jmins, jmaxs, &
1293 & krhs, kstp, krhs, &
1294 & zeta, &
1295 & ad_zeta)
1296# endif
1297# endif
1298!^ CALL tl_zetabc_tile (ng, tile, &
1299!^ & LBi, UBi, LBj, UBj, &
1300!^ & IminS, ImaxS, JminS, JmaxS, &
1301!^ & krhs, kstp, kstp, &
1302!^ & zeta, &
1303!^ & tl_zeta)
1304!^
1305 CALL ad_zetabc_tile (ng, tile, &
1306 & lbi, ubi, lbj, ubj, &
1307 & imins, imaxs, jmins, jmaxs, &
1308 & krhs, kstp, kstp, &
1309 & zeta, &
1310 & ad_zeta)
1311 END IF
1312# endif
1313!
1314! Adjoint of free-surface initialization.
1315!
1316 IF (.not.(any(ad_lbc(:,isfsur,ng)%radiation).or. &
1317 & any(ad_lbc(:,isfsur,ng)%Chapman_explicit).or. &
1318 & any(ad_lbc(:,isfsur,ng)%Chapman_implicit))) THEN
1319 imin=istrb
1320 imax=iendb
1321 jmin=jstrb
1322 jmax=jendb
1323 ELSE
1324 imin=istrt
1325 imax=iendt
1326 jmin=jstrt
1327 jmax=jendt
1328 END IF
1329 DO j=jmin,jmax
1330 DO i=imin,imax
1331# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1332!^ tl_zeta(i,j,kstp)=tl_cff1 ! HGA: kstp or knew?
1333!^
1334 ad_cff1=ad_cff1+ad_zeta(i,j,kstp)
1335 ad_zeta(i,j,kstp)=0.0_r8
1336# else
1337# ifdef SOLVE3D
1338!^ tl_zeta(i,j,kstp)=tl_cff1
1339!^ tl_zeta(i,j,knew)=tl_cff1
1340!^
1341 ad_cff1=ad_cff1+ad_zeta(i,j,knew)+ad_zeta(i,j,kstp)
1342 ad_zeta(i,j,knew)=0.0_r8
1343 ad_zeta(i,j,kstp)=0.0_r8
1344# else
1345!^ tl_zeta(i,j,kstp)=tl_cff1
1346!^ tl_zeta(i,j,krhs)=tl_cff1
1347!^
1348 ad_cff1=ad_cff1+ad_zeta(i,j,krhs)+ad_zeta(i,j,kstp)
1349 ad_zeta(i,j,krhs)=0.0_r8
1350 ad_zeta(i,j,kstp)=0.0_r8
1351# endif
1352# endif
1353# ifdef MASKING
1354!^ tl_cff1=tl_cff1*rmask(i,j)
1355!^
1356 ad_cff1=ad_cff1*rmask(i,j)
1357# endif
1358!^ tl_cff1=tl_zeta(i,j,kstp)
1359!^
1360 ad_zeta(i,j,kstp)=ad_zeta(i,j,kstp)+ad_cff1
1361 ad_cff1=0.0_r8
1362 END DO
1363 END DO
1364!
1365!-----------------------------------------------------------------------
1366! Load free-surface adjoint solution into IO arrays.
1367!-----------------------------------------------------------------------
1368!
1369 DO j=jstrt,jendt
1370 DO i=istrt,iendt
1371 ad_zeta_sol(i,j)=ad_zeta(i,j,kstp)
1372 END DO
1373 END DO
1374!
1375 RETURN
1376 END SUBROUTINE ad_ini_zeta_tile
1377
1378# ifdef SOLVE3D
1379!
1380!***********************************************************************
1381 SUBROUTINE ad_set_zeta_timeavg (ng, tile, model)
1382!***********************************************************************
1383!
1384 USE mod_stepping
1385!
1386! Imported variable declarations.
1387!
1388 integer, intent(in) :: ng, tile, model
1389!
1390! Local variable declarations.
1391!
1392 character (len=*), parameter :: myfile = &
1393 & __FILE__//", ad_set_zeta_timeavg"
1394!
1395# include "tile.h"
1396!
1397# ifdef PROFILE
1398 CALL wclock_on (ng, model, 2, __line__, myfile)
1399# endif
1400 CALL ad_set_zeta_timeavg_tile (ng, tile, model, &
1401 & lbi, ubi, lbj, ubj, &
1402 & kstp(ng), &
1403 & coupling(ng) % ad_Zt_avg1, &
1404 & ocean(ng) % ad_zeta)
1405# ifdef PROFILE
1406 CALL wclock_off (ng, model, 2, __line__, myfile)
1407# endif
1408!
1409 RETURN
1410 END SUBROUTINE ad_set_zeta_timeavg
1411!
1412!***********************************************************************
1413 SUBROUTINE ad_set_zeta_timeavg_tile (ng, tile, model, &
1414 & LBi, UBi, LBj, UBj, &
1415 & kstp, &
1416 & ad_Zt_avg1, &
1417 & ad_zeta)
1418!***********************************************************************
1419!
1420! Imported variable declarations.
1421!
1422 integer, intent(in) :: ng, tile, model
1423 integer, intent(in) :: LBi, UBi, LBj, UBj
1424 integer, intent(in) :: kstp
1425!
1426# ifdef ASSUMED_SHAPE
1427 real(r8), intent(inout) :: ad_Zt_avg1(LBi:,LBj:)
1428 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
1429# else
1430 real(r8), intent(inout) :: ad_Zt_avg1(LBi:UBi,LBj:UBj)
1431 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
1432# endif
1433!
1434! Local variable declarations.
1435!
1436 integer :: i, j
1437!
1438# include "set_bounds.h"
1439!
1440!-----------------------------------------------------------------------
1441! Initialize fast-time averaged free-surface (Zt_avg1) with the inital
1442! free-surface.
1443!-----------------------------------------------------------------------
1444!
1445# ifdef DISTRIBUTE
1446!^ CALL mp_exchange2d (ng, tile, model, 1, &
1447!^ & LBi, UBi, LBj, UBj, &
1448!^ & NghostPoints, &
1449!^ & EWperiodic(ng), NSperiodic(ng), &
1450!^ & tl_Zt_avg1)
1451!^
1452 CALL ad_mp_exchange2d (ng, tile, model, 1, &
1453 & lbi, ubi, lbj, ubj, &
1454 & nghostpoints, &
1455 & ewperiodic(ng), nsperiodic(ng), &
1456 & ad_zt_avg1)
1457!
1458# endif
1459 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1460!^ CALL exchange_r2d_tile (ng, tile, &
1461!^ & LBi, UBi, LBj, UBj, &
1462!^ & tl_Zt_avg1)
1463!^
1464 CALL ad_exchange_r2d_tile (ng, tile, &
1465 & lbi, ubi, lbj, ubj, &
1466 & ad_zt_avg1)
1467 END IF
1468!
1469 DO j=jstrt,jendt
1470 DO i=istrt,iendt
1471!> tl_Zt_avg1(i,j)=tl_zeta(i,j,kstp)
1472!>
1473 ad_zeta(i,j,kstp)=ad_zeta(i,j,kstp)+ad_zt_avg1(i,j)
1474 ad_zt_avg1(i,j)=0.0_r8
1475 END DO
1476 END DO
1477!
1478 RETURN
1479 END SUBROUTINE ad_set_zeta_timeavg_tile
1480# endif
1481!
1482!***********************************************************************
1483 SUBROUTINE ad_out_fields (ng, tile, model)
1484!***********************************************************************
1485!
1486 USE mod_stepping
1487!
1488! Imported variable declarations.
1489!
1490 integer, intent(in) :: ng, tile, model
1491!
1492! Local variable declarations.
1493!
1494 character (len=*), parameter :: myfile = &
1495 & __FILE__//", ad_out_fields"
1496!
1497# include "tile.h"
1498!
1499# ifdef PROFILE
1500 CALL wclock_on (ng, iadm, 2, __line__, myfile)
1501# endif
1502 CALL ad_out_fields_tile (ng, tile, model, &
1503 & lbi, ubi, lbj, ubj, &
1504 & imins, imaxs, jmins, jmaxs, &
1505 & kstp(ng), krhs(ng), knew(ng), &
1506 & nstp(ng), nnew(ng), &
1507# ifdef MASKING
1508 & grid(ng) % rmask, &
1509 & grid(ng) % umask, &
1510 & grid(ng) % vmask, &
1511# endif
1512# ifdef SOLVE3D
1513 & ocean(ng) % ad_u, &
1514 & ocean(ng) % ad_u_sol, &
1515 & ocean(ng) % ad_v, &
1516 & ocean(ng) % ad_v_sol, &
1517 & ocean(ng) % ad_t, &
1518 & ocean(ng) % ad_t_sol, &
1519# endif
1520 & ocean(ng) % zeta, &
1521 & ocean(ng) % ubar, &
1522 & ocean(ng) % vbar, &
1523 & ocean(ng) % ad_ubar_sol, &
1524 & ocean(ng) % ad_ubar, &
1525 & ocean(ng) % ad_vbar_sol, &
1526 & ocean(ng) % ad_vbar, &
1527 & ocean(ng) % ad_zeta)
1528# ifdef PROFILE
1529 CALL wclock_off (ng, iadm, 2, __line__, myfile)
1530# endif
1531!
1532 RETURN
1533 END SUBROUTINE ad_out_fields
1534!
1535!***********************************************************************
1536 SUBROUTINE ad_out_fields_tile (ng, tile, model, &
1537 & LBi, UBi, LBj, UBj, &
1538 & IminS, ImaxS, JminS, JmaxS, &
1539 & kstp, krhs, knew, &
1540 & nstp, nnew, &
1541# ifdef MASKING
1542 & rmask, umask, vmask, &
1543# endif
1544# ifdef SOLVE3D
1545 & ad_u, ad_u_sol, &
1546 & ad_v, ad_v_sol, &
1547 & ad_t, ad_t_sol, &
1548# endif
1549 & zeta, ubar, vbar, &
1550 & ad_ubar_sol, ad_ubar, &
1551 & ad_vbar_sol, ad_vbar, ad_zeta)
1552!***********************************************************************
1553!
1554! Imported variable declarations.
1555!
1556 integer, intent(in) :: ng, tile, model
1557 integer, intent(in) :: LBi, UBi, LBj, UBj
1558 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
1559 integer, intent(in) :: kstp, krhs, knew
1560 integer, intent(in) :: nstp, nnew
1561!
1562# ifdef ASSUMED_SHAPE
1563# ifdef MASKING
1564 real(r8), intent(in) :: rmask(LBi:,LBj:)
1565 real(r8), intent(in) :: umask(LBi:,LBj:)
1566 real(r8), intent(in) :: vmask(LBi:,LBj:)
1567# endif
1568 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
1569 real(r8), intent(in) :: vbar(LBi:,LBj:,:)
1570 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
1571
1572 real(r8), intent(inout) :: ad_ubar_sol(LBi:,LBj:)
1573 real(r8), intent(inout) :: ad_vbar_sol(LBi:,LBj:)
1574
1575 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
1576 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
1577 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
1578# ifdef SOLVE3D
1579 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
1580 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
1581 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
1582 real(r8), intent(inout) :: ad_t_sol(LBi:,LBj:,:,:)
1583 real(r8), intent(inout) :: ad_u_sol(LBi:,LBj:,:)
1584 real(r8), intent(inout) :: ad_v_sol(LBi:,LBj:,:)
1585# endif
1586
1587# else
1588
1589# ifdef MASKING
1590 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
1591 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
1592 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
1593# endif
1594 real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
1595 real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
1596 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
1597
1598 real(r8), intent(inout) :: ad_ubar_sol(LBi:UBi,LBj:UBj)
1599 real(r8), intent(inout) :: ad_vbar_sol(LBi:UBi,LBj:UBj)
1600
1601 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
1602 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
1603 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
1604# ifdef SOLVE3D
1605 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
1606 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
1607 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
1608 real(r8), intent(inout) :: ad_t_sol(LBi:UBi,LBj:UBj,N(ng),NT(ng))
1609 real(r8), intent(inout) :: ad_u_sol(LBi:UBi,LBj:UBj,N(ng))
1610 real(r8), intent(inout) :: ad_v_sol(LBi:UBi,LBj:UBj,N(ng))
1611# endif
1612# endif
1613!
1614! Local variable declarations.
1615!
1616 integer :: i, ic, itrc, j, k, kbed, kout
1617
1618 real(r8) :: cff1
1619 real(r8) :: adfac, ad_cff1, ad_cff2
1620
1621# include "set_bounds.h"
1622!
1623 kout=knew
1624# ifndef SOLVE3D
1625 IF (iic(ng).eq.ntend(ng)) kout=krhs
1626# endif
1627!
1628# ifdef SOLVE3D
1629# ifdef DISTRIBUTE
1630# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1631 CALL ad_mp_exchange2d (ng, tile, model, 2, &
1632 & lbi, ubi, lbj, ubj, &
1633 & nghostpoints, &
1634 & ewperiodic(ng), nsperiodic(ng), &
1635 & ad_ubar(:,:,knew), ad_vbar(:,:,knew))
1636# else
1637 CALL ad_mp_exchange2d (ng, tile, model, 4, &
1638 & lbi, ubi, lbj, ubj, &
1639 & nghostpoints, &
1640 & ewperiodic(ng), nsperiodic(ng), &
1641 & ad_ubar(:,:,kstp), ad_vbar(:,:,kstp), &
1642 & ad_ubar(:,:,kout), ad_vbar(:,:,kout))
1643# endif
1644# endif
1645!
1646 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1647# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1648 CALL ad_exchange_v2d_tile (ng, tile, &
1649 & lbi, ubi, lbj, ubj, &
1650 & ad_vbar(:,:,knew))
1651 CALL ad_exchange_u2d_tile (ng, tile, &
1652 & lbi, ubi, lbj, ubj, &
1653 & ad_ubar(:,:,knew))
1654# else
1655 CALL ad_exchange_v2d_tile (ng, tile, &
1656 & lbi, ubi, lbj, ubj, &
1657 & ad_vbar(:,:,kout))
1658 CALL ad_exchange_u2d_tile (ng, tile, &
1659 & lbi, ubi, lbj, ubj, &
1660 & ad_ubar(:,:,kout))
1661
1662 CALL ad_exchange_v2d_tile (ng, tile, &
1663 & lbi, ubi, lbj, ubj, &
1664 & ad_vbar(:,:,kstp))
1665 CALL ad_exchange_u2d_tile (ng, tile, &
1666 & lbi, ubi, lbj, ubj, &
1667 & ad_ubar(:,:,kstp))
1668# endif
1669 END IF
1670!
1671 IF (.not.(any(ad_lbc(:,isubar,ng)%radiation).or. &
1672 & any(ad_lbc(:,isvbar,ng)%radiation).or. &
1673 & any(ad_lbc(:,isubar,ng)%Flather).or. &
1674 & any(ad_lbc(:,isvbar,ng)%Flather))) THEN
1675 CALL ad_v2dbc_tile (ng, tile, &
1676 & lbi, ubi, lbj, ubj, &
1677 & imins, imaxs, jmins, jmaxs, &
1678 & krhs, kstp, knew, &
1679 & ubar, vbar, zeta, &
1680 & ad_ubar, ad_vbar, ad_zeta)
1681 CALL ad_u2dbc_tile (ng, tile, &
1682 & lbi, ubi, lbj, ubj, &
1683 & imins, imaxs, jmins, jmaxs, &
1684 & krhs, kstp, knew, &
1685 & ubar, vbar, zeta, &
1686 & ad_ubar, ad_vbar, ad_zeta)
1687# if !(defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3)
1688 CALL ad_v2dbc_tile (ng, tile, &
1689 & lbi, ubi, lbj, ubj, &
1690 & imins, imaxs, jmins, jmaxs, &
1691 & krhs, kstp, kstp, &
1692 & ubar, vbar, zeta, &
1693 & ad_ubar, ad_vbar, ad_zeta)
1694 CALL ad_u2dbc_tile (ng, tile, &
1695 & lbi, ubi, lbj, ubj, &
1696 & imins, imaxs, jmins, jmaxs, &
1697 & krhs, kstp, kstp, &
1698 & ubar, vbar, zeta, &
1699 & ad_ubar, ad_vbar, ad_zeta)
1700# endif
1701 END IF
1702!
1703! Load 2D adjoint momentum solution into IO arrays.
1704!
1705 DO j=jstrt,jendt
1706 DO i=istrp,iendt
1707# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1708 ad_ubar_sol(i,j)=ad_ubar(i,j,knew)
1709# else
1710 ad_ubar_sol(i,j)=ad_ubar(i,j,kstp)+ad_ubar(i,j,kout)
1711# endif
1712 END DO
1713 IF (j.ge.jstrp) THEN
1714 DO i=istrt,iendt
1715# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1716 ad_vbar_sol(i,j)=ad_vbar(i,j,knew)
1717# else
1718 ad_vbar_sol(i,j)=ad_vbar(i,j,kstp)+ad_vbar(i,j,kout)
1719# endif
1720 END DO
1721 END IF
1722 END DO
1723# else
1724# ifdef DISTRIBUTE
1725# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1726 CALL ad_mp_exchange2d (ng, tile, model, 2, &
1727 & lbi, ubi, lbj, ubj, &
1728 & nghostpoints, &
1729 & ewperiodic(ng), nsperiodic(ng), &
1730 & ad_ubar(:,:,knew), ad_vbar(:,:,knew))
1731# else
1732 CALL ad_mp_exchange2d (ng, tile, model, 4, &
1733 & lbi, ubi, lbj, ubj, &
1734 & nghostpoints, &
1735 & ewperiodic(ng), nsperiodic(ng), &
1736 & ad_ubar(:,:,kstp), ad_vbar(:,:,kstp), &
1737 & ad_ubar(:,:,kout), ad_vbar(:,:,kout))
1738# endif
1739# endif
1740!
1741 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1742# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1743 CALL ad_exchange_v2d_tile (ng, tile, &
1744 & lbi, ubi, lbj, ubj, &
1745 & ad_vbar(:,:,knew))
1746 CALL ad_exchange_u2d_tile (ng, tile, &
1747 & lbi, ubi, lbj, ubj, &
1748 & ad_ubar(:,:,knew))
1749# else
1750 CALL ad_exchange_v2d_tile (ng, tile, &
1751 & lbi, ubi, lbj, ubj, &
1752 & ad_vbar(:,:,kout))
1753 CALL ad_exchange_u2d_tile (ng, tile, &
1754 & lbi, ubi, lbj, ubj, &
1755 & ad_ubar(:,:,kout))
1756
1757 CALL ad_exchange_v2d_tile (ng, tile, &
1758 & lbi, ubi, lbj, ubj, &
1759 & ad_vbar(:,:,kstp))
1760 CALL ad_exchange_u2d_tile (ng, tile, &
1761 & lbi, ubi, lbj, ubj, &
1762 & ad_ubar(:,:,kstp))
1763# endif
1764 END IF
1765!
1766 IF (.not.(any(ad_lbc(:,isubar,ng)%radiation).or. &
1767 & any(ad_lbc(:,isvbar,ng)%radiation).or. &
1768 & any(ad_lbc(:,isubar,ng)%Flather).or. &
1769 & any(ad_lbc(:,isvbar,ng)%Flather))) THEN
1770# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1771 CALL ad_v2dbc_tile (ng, tile, &
1772 & lbi, ubi, lbj, ubj, &
1773 & imins, imaxs, jmins, jmaxs, &
1774 & krhs, kstp, knew, &
1775 & ubar, vbar, zeta, &
1776 & ad_ubar, ad_vbar, ad_zeta)
1777 CALL ad_u2dbc_tile (ng, tile, &
1778 & lbi, ubi, lbj, ubj, &
1779 & imins, imaxs, jmins, jmaxs, &
1780 & krhs, kstp, knew, &
1781 & ubar, vbar, zeta, &
1782 & ad_ubar, ad_vbar, ad_zeta)
1783# else
1784 CALL ad_v2dbc_tile (ng, tile, &
1785 & lbi, ubi, lbj, ubj, &
1786 & imins, imaxs, jmins, jmaxs, &
1787 & krhs, kstp, kout, &
1788 & ubar, vbar, zeta, &
1789 & ad_ubar, ad_vbar, ad_zeta)
1790 CALL ad_u2dbc_tile (ng, tile, &
1791 & lbi, ubi, lbj, ubj, &
1792 & imins, imaxs, jmins, jmaxs, &
1793 & krhs, kstp, kout, &
1794 & ubar, vbar, zeta, &
1795 & ad_ubar, ad_vbar, ad_zeta)
1796
1797 CALL ad_v2dbc_tile (ng, tile, &
1798 & lbi, ubi, lbj, ubj, &
1799 & imins, imaxs, jmins, jmaxs, &
1800 & krhs, kstp, kstp, &
1801 & ubar, vbar, zeta, &
1802 & ad_ubar, ad_vbar, ad_zeta)
1803 CALL ad_u2dbc_tile (ng, tile, &
1804 & lbi, ubi, lbj, ubj, &
1805 & imins, imaxs, jmins, jmaxs, &
1806 & krhs, kstp, kstp, &
1807 & ubar, vbar, zeta, &
1808 & ad_ubar, ad_vbar, ad_zeta)
1809# endif
1810 END IF
1811!
1812! Load 2D adjoint momentum solution into IO arrays.
1813!
1814 DO j=jstrt,jendt
1815 DO i=istrp,iendt
1816# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1817 ad_ubar_sol(i,j)=ad_ubar(i,j,knew)
1818# else
1819 ad_ubar_sol(i,j)=ad_ubar(i,j,kstp)+ad_ubar(i,j,kout)
1820# endif
1821 END DO
1822 IF (j.ge.jstrp) THEN
1823 DO i=istrt,iendt
1824# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
1825 ad_vbar_sol(i,j)=ad_vbar(i,j,knew)
1826# else
1827 ad_vbar_sol(i,j)=ad_vbar(i,j,kstp)+ad_vbar(i,j,kout)
1828# endif
1829 END DO
1830 END IF
1831 END DO
1832
1833# endif
1834!
1835# ifdef SOLVE3D
1836# ifdef DISTRIBUTE
1837 CALL ad_mp_exchange3d (ng, tile, model, 4, &
1838 & lbi, ubi, lbj, ubj, 1, n(ng), &
1839 & nghostpoints, &
1840 & ewperiodic(ng), nsperiodic(ng), &
1841 & ad_u(:,:,:,nstp), ad_v(:,:,:,nstp), &
1842 & ad_u(:,:,:,nnew), ad_v(:,:,:,nnew))
1843# endif
1844 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1845 CALL ad_exchange_v3d_tile (ng, tile, &
1846 & lbi, ubi, lbj, ubj, 1, n(ng), &
1847 & ad_v(:,:,:,nstp))
1848 CALL ad_exchange_u3d_tile (ng, tile, &
1849 & lbi, ubi, lbj, ubj, 1, n(ng), &
1850 & ad_u(:,:,:,nstp))
1851 CALL ad_exchange_v3d_tile (ng, tile, &
1852 & lbi, ubi, lbj, ubj, 1, n(ng), &
1853 & ad_v(:,:,:,nnew))
1854 CALL ad_exchange_u3d_tile (ng, tile, &
1855 & lbi, ubi, lbj, ubj, 1, n(ng), &
1856 & ad_u(:,:,:,nnew))
1857 END IF
1858 CALL ad_v3dbc_tile (ng, tile, &
1859 & lbi, ubi, lbj, ubj, n(ng), &
1860 & imins, imaxs, jmins, jmaxs, &
1861 & nstp, nnew, &
1862 & ad_v)
1863 CALL ad_v3dbc_tile (ng, tile, &
1864 & lbi, ubi, lbj, ubj, n(ng), &
1865 & imins, imaxs, jmins, jmaxs, &
1866 & nstp, nstp, &
1867 & ad_v)
1868 CALL ad_u3dbc_tile (ng, tile, &
1869 & lbi, ubi, lbj, ubj, n(ng), &
1870 & imins, imaxs, jmins, jmaxs, &
1871 & nstp, nnew, &
1872 & ad_u)
1873 CALL ad_u3dbc_tile (ng, tile, &
1874 & lbi, ubi, lbj, ubj, n(ng), &
1875 & imins, imaxs, jmins, jmaxs, &
1876 & nstp, nstp, &
1877 & ad_u)
1878!
1879! Add second piece of the 3D adjoint momentum solution into IO arrays.
1880! The first is loaded in "ad_step3d_uv".
1881!
1882 DO j=jstrb,jendb
1883 IF (j.ge.jstrm) THEN
1884 DO k=1,n(ng)
1885 DO i=istrb,iendb
1886 ad_v_sol(i,j,k)=ad_v_sol(i,j,k)+ad_v(i,j,k,nnew)
1887 END DO
1888 END DO
1889 END IF
1890 DO k=1,n(ng)
1891 DO i=istrm,iendb
1892 ad_u_sol(i,j,k)=ad_u_sol(i,j,k)+ad_u(i,j,k,nnew)
1893 END DO
1894 END DO
1895 END DO
1896# ifdef DISTRIBUTE
1897 CALL ad_mp_exchange4d (ng, tile, model, 2, &
1898 & lbi, ubi, lbj, ubj, 1, n(ng), 1, nt(ng), &
1899 & nghostpoints, &
1900 & ewperiodic(ng), nsperiodic(ng), &
1901 & ad_t(:,:,:,nstp,:), &
1902 & ad_t(:,:,:,nnew,:))
1903# endif
1904!
1905 ic=0
1906 DO itrc=1,nt(ng)
1907 IF (ltracerclm(itrc,ng).and.lnudgetclm(itrc,ng)) THEN
1908 ic=ic+1 ! OBC nudging coefficient index
1909 END IF
1910 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1911 CALL ad_exchange_r3d_tile (ng, tile, &
1912 & lbi, ubi, lbj, ubj, 1, n(ng), &
1913 & ad_t(:,:,:,nstp,itrc))
1914 CALL ad_exchange_r3d_tile (ng, tile, &
1915 & lbi, ubi, lbj, ubj, 1, n(ng), &
1916 & ad_t(:,:,:,nnew,itrc))
1917 END IF
1918 CALL ad_t3dbc_tile (ng, tile, itrc, ic, &
1919 & lbi, ubi, lbj, ubj, n(ng), nt(ng), &
1920 & imins, imaxs, jmins, jmaxs, &
1921 & nstp, nnew, &
1922 & ad_t)
1923 CALL ad_t3dbc_tile (ng, tile, itrc, ic, &
1924 & lbi, ubi, lbj, ubj, n(ng), nt(ng), &
1925 & imins, imaxs, jmins, jmaxs, &
1926 & nstp, nstp, &
1927 & ad_t)
1928 DO k=1,n(ng)
1929 DO j=jstrb,jendb
1930 DO i=istrb,iendb
1931 ad_t_sol(i,j,k,itrc)=ad_t(i,j,k,nstp,itrc)+ &
1932 & ad_t(i,j,k,nnew,itrc)
1933 END DO
1934 END DO
1935 END DO
1936 END DO
1937# endif
1938!
1939 RETURN
1940 END SUBROUTINE ad_out_fields_tile
1941!
1942!***********************************************************************
1943 SUBROUTINE ad_out_zeta (ng, tile, model)
1944!***********************************************************************
1945!
1946 USE mod_stepping
1947!
1948! Imported variable declarations.
1949!
1950 integer, intent(in) :: ng, tile, model
1951!
1952! Local variable declarations.
1953!
1954 character (len=*), parameter :: myfile = &
1955 & __FILE__//", ad_out_zeta"
1956!
1957# include "tile.h"
1958!
1959# ifdef PROFILE
1960 CALL wclock_on (ng, iadm, 2, __line__, myfile)
1961# endif
1962 CALL ad_out_zeta_tile (ng, tile, model, &
1963 & lbi, ubi, lbj, ubj, &
1964 & imins, imaxs, jmins, jmaxs, &
1965 & kstp(ng), krhs(ng), knew(ng), &
1966# ifdef MASKING
1967 & grid(ng) % rmask, &
1968# endif
1969# ifdef WET_DRY_NOT_YET
1970 & grid(ng) % h, &
1971# endif
1972# ifdef SOLVE3D
1973# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
1974 & sedbed(ng) % ad_bed, &
1975 & sedbed(ng) % ad_bed_thick0, &
1976 & sedbed(ng) % ad_bed_thick, &
1977# endif
1978 & coupling(ng) % ad_Zt_avg1, &
1979# endif
1980 & ocean(ng) % zeta, &
1981 & ocean(ng) % ad_zeta_sol, &
1982 & ocean(ng) % ad_zeta)
1983# ifdef PROFILE
1984 CALL wclock_off (ng, iadm, 2, __line__, myfile)
1985# endif
1986!
1987 RETURN
1988 END SUBROUTINE ad_out_zeta
1989!
1990!***********************************************************************
1991 SUBROUTINE ad_out_zeta_tile (ng, tile, model, &
1992 & LBi, UBi, LBj, UBj, &
1993 & IminS, ImaxS, JminS, JmaxS, &
1994 & kstp, krhs, knew, &
1995# ifdef MASKING
1996 & rmask, &
1997# endif
1998# ifdef WET_DRY_NOT_YET
1999 & h, &
2000# endif
2001# ifdef SOLVE3D
2002# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
2003 & ad_bed, &
2004 & ad_bed_thick0, ad_bed_thick, &
2005# endif
2006
2007 & ad_Zt_avg1, &
2008# endif
2009 & zeta, ad_zeta_sol, ad_zeta)
2010!***********************************************************************
2011!
2012!
2013! Imported variable declarations.
2014!
2015 integer, intent(in) :: ng, tile, model
2016 integer, intent(in) :: LBi, UBi, LBj, UBj
2017 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
2018 integer, intent(in) :: kstp, krhs, knew
2019!
2020# ifdef ASSUMED_SHAPE
2021# ifdef MASKING
2022 real(r8), intent(in) :: rmask(LBi:,LBj:)
2023# endif
2024# ifdef WET_DRY_NOT_YET
2025 real(r8), intent(in) :: h(LBi:,LBj:)
2026# endif
2027 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
2028# ifdef SOLVE3D
2029# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
2030 real(r8), intent(inout) :: ad_bed(LBi:,LBj:,:,:)
2031 real(r8), intent(inout) :: ad_bed_thick0(LBi:,LBj:)
2032 real(r8), intent(inout) :: ad_bed_thick(LBi:,LBj:,:)
2033# endif
2034 real(r8), intent(inout) :: ad_Zt_avg1(LBi:,LBj:)
2035# endif
2036 real(r8), intent(inout) :: ad_zeta_sol(LBi:,LBj:)
2037 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
2038
2039# else
2040
2041# ifdef MASKING
2042 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
2043# endif
2044# ifdef WET_DRY_NOT_YET
2045 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
2046# endif
2047 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
2048# ifdef SOLVE3D
2049# if defined SOLVE3D && defined SEDIMENT && defined SED_MORPH
2050 real(r8), intent(inout) :: ad_bed(LBi:UBi,LBj:UBj,Nbed,MBEDP)
2051 real(r8), intent(inout) :: ad_bed_thick0(LBi:UBi,LBj:UBj)
2052 real(r8), intent(inout) :: ad_bed_thick(LBi:UBi,LBj:UBj,3)
2053# endif
2054 real(r8), intent(inout) :: ad_Zt_avg1(LBi:UBi,LBj:UBj)
2055# endif
2056 real(r8), intent(inout) :: ad_zeta_sol(LBi:UBi,LBj:UBj)
2057 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
2058# endif
2059!
2060! Local variable declarations.
2061!
2062 integer :: Imin, Imax, Jmin, Jmax
2063 integer :: i, j, kbed, kout
2064
2065 real(r8) :: ad_cff1
2066
2067# include "set_bounds.h"
2068!
2069 kout=knew
2070# ifndef SOLVE3D
2071 IF (iic(ng).eq.ntend(ng)) kout=krhs
2072# endif
2073!
2074!-----------------------------------------------------------------------
2075! Load free-surface adjoint solution into IO arrays.
2076!-----------------------------------------------------------------------
2077!
2078# ifdef SOLVE3D
2079# ifdef DISTRIBUTE
2080 CALL ad_mp_exchange2d (ng, tile, model, 1, &
2081 & lbi, ubi, lbj, ubj, &
2082 & nghostpoints, &
2083 & ewperiodic(ng), nsperiodic(ng), &
2084 & ad_zt_avg1)
2085!
2086# endif
2087
2088 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2089 CALL ad_exchange_r2d_tile (ng, tile, &
2090 & lbi, ubi, lbj, ubj, &
2091 & ad_zt_avg1)
2092 END IF
2093# endif
2094!
2095# ifdef DISTRIBUTE
2096# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
2097 CALL ad_mp_exchange2d (ng, tile, model, 2, &
2098 & lbi, ubi, lbj, ubj, &
2099 & nghostpoints, &
2100 & ewperiodic(ng), nsperiodic(ng), &
2101 & ad_zeta(:,:,knew))
2102# else
2103# ifdef SOLVE3D
2104 CALL ad_mp_exchange2d (ng, tile, model, 2, &
2105 & lbi, ubi, lbj, ubj, &
2106 & nghostpoints, &
2107 & ewperiodic(ng), nsperiodic(ng), &
2108 & ad_zeta(:,:,kstp), &
2109 & ad_zeta(:,:,kout))
2110# else
2111 CALL ad_mp_exchange2d (ng, tile, model, 2, &
2112 & lbi, ubi, lbj, ubj, &
2113 & nghostpoints, &
2114 & ewperiodic(ng), nsperiodic(ng), &
2115 & ad_zeta(:,:,kstp), &
2116 & ad_zeta(:,:,kout))
2117# endif
2118# endif
2119!
2120# endif
2121
2122 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2123# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
2124 CALL ad_exchange_r2d_tile (ng, tile, &
2125 & lbi, ubi, lbj, ubj, &
2126 & ad_zeta(:,:,knew))
2127# else
2128# ifdef SOLVE3D
2129 CALL ad_exchange_r2d_tile (ng, tile, &
2130 & lbi, ubi, lbj, ubj, &
2131 & ad_zeta(:,:,kout))
2132# else
2133 CALL ad_exchange_r2d_tile (ng, tile, &
2134 & lbi, ubi, lbj, ubj, &
2135 & ad_zeta(:,:,kout))
2136# endif
2137 CALL ad_exchange_r2d_tile (ng, tile, &
2138 & lbi, ubi, lbj, ubj, &
2139 & ad_zeta(:,:,kstp))
2140# endif
2141 END IF
2142!
2143 IF (.not.(any(ad_lbc(:,isfsur,ng)%radiation).or. &
2144 & any(ad_lbc(:,isfsur,ng)%Chapman_explicit).or. &
2145 & any(ad_lbc(:,isfsur,ng)%Chapman_implicit))) THEN
2146# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
2147 CALL ad_zetabc_tile (ng, tile, &
2148 & lbi, ubi, lbj, ubj, &
2149 & imins, imaxs, jmins, jmaxs, &
2150 & krhs, kstp, knew, &
2151 & zeta, &
2152 & ad_zeta)
2153# else
2154 CALL ad_zetabc_tile (ng, tile, &
2155 & lbi, ubi, lbj, ubj, &
2156 & imins, imaxs, jmins, jmaxs, &
2157 & krhs, kstp, kout, &
2158 & zeta, &
2159 & ad_zeta)
2160 CALL ad_zetabc_tile (ng, tile, &
2161 & lbi, ubi, lbj, ubj, &
2162 & imins, imaxs, jmins, jmaxs, &
2163 & krhs, kstp, kstp, &
2164 & zeta, &
2165 & ad_zeta)
2166# endif
2167 END IF
2168!
2169 DO j=jstrt,jendt
2170 DO i=istrt,iendt
2171# if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
2172 ad_zeta_sol(i,j)=ad_zeta(i,j,knew)
2173# else
2174# ifdef SOLVE3D
2175 ad_zeta_sol(i,j)=ad_zeta(i,j,kout)+ad_zeta(i,j,kstp)+ &
2176 & ad_zt_avg1(i,j)
2177# else
2178 ad_zeta_sol(i,j)=ad_zeta(i,j,kout)+ad_zeta(i,j,kstp)
2179# endif
2180# endif
2181 END DO
2182 END DO
2183!
2184 RETURN
2185 END SUBROUTINE ad_out_zeta_tile
2186#endif
2187 END MODULE ad_ini_fields_mod
ad_exchange_2d_mod
Definition ad_exchange_2d.F:2
ad_exchange_2d_mod::ad_exchange_u2d_tile
subroutine ad_exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_exchange_2d.F:816
ad_exchange_2d_mod::ad_exchange_v2d_tile
subroutine ad_exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_exchange_2d.F:1201
ad_exchange_2d_mod::ad_exchange_r2d_tile
subroutine ad_exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_exchange_2d.F:431
ad_exchange_3d_mod
Definition ad_exchange_3d.F:2
ad_exchange_3d_mod::ad_exchange_v3d_tile
subroutine ad_exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:1283
ad_exchange_3d_mod::ad_exchange_r3d_tile
subroutine ad_exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:461
ad_exchange_3d_mod::ad_exchange_u3d_tile
subroutine ad_exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:872
ad_ini_fields_mod
Definition ad_ini_fields.F:2
ad_ini_fields_mod::ad_ini_fields
subroutine, public ad_ini_fields(ng, tile, model)
Definition ad_ini_fields.F:67
ad_ini_fields_mod::ad_out_fields_tile
subroutine ad_out_fields_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kstp, krhs, knew, nstp, nnew, rmask, umask, vmask, ad_u, ad_u_sol, ad_v, ad_v_sol, ad_t, ad_t_sol, zeta, ubar, vbar, ad_ubar_sol, ad_ubar, ad_vbar_sol, ad_vbar, ad_zeta)
Definition ad_ini_fields.F:1552
ad_ini_fields_mod::ad_set_zeta_timeavg_tile
subroutine ad_set_zeta_timeavg_tile(ng, tile, model, lbi, ubi, lbj, ubj, kstp, ad_zt_avg1, ad_zeta)
Definition ad_ini_fields.F:1418
ad_ini_fields_mod::ad_out_zeta
subroutine, public ad_out_zeta(ng, tile, model)
Definition ad_ini_fields.F:1944
ad_ini_fields_mod::ad_ini_fields_tile
subroutine ad_ini_fields_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kstp, krhs, knew, nstp, nnew, rmask, umask, vmask, hz, ad_hz, ad_t, u, ad_u, v, ad_v, ubar, ad_ubar_sol, ad_ubar, vbar, ad_vbar_sol, ad_vbar, zeta, ad_zeta)
Definition ad_ini_fields.F:141
ad_ini_fields_mod::ad_set_zeta_timeavg
subroutine, public ad_set_zeta_timeavg(ng, tile, model)
Definition ad_ini_fields.F:1382
ad_ini_fields_mod::ad_ini_zeta
subroutine, public ad_ini_zeta(ng, tile, model)
Definition ad_ini_fields.F:971
ad_ini_fields_mod::ad_ini_zeta_tile
subroutine ad_ini_zeta_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kstp, krhs, knew, rmask, h, ad_bed, ad_bed_thick0, ad_bed_thick, ad_zt_avg1, zeta, ad_zeta_sol, ad_zeta)
Definition ad_ini_fields.F:1037
ad_ini_fields_mod::ad_out_zeta_tile
subroutine ad_out_zeta_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kstp, krhs, knew, rmask, h, ad_bed, ad_bed_thick0, ad_bed_thick, ad_zt_avg1, zeta, ad_zeta_sol, ad_zeta)
Definition ad_ini_fields.F:2010
ad_ini_fields_mod::ad_out_fields
subroutine, public ad_out_fields(ng, tile, model)
Definition ad_ini_fields.F:1484
ad_set_depth_mod
Definition ad_set_depth.F:2
ad_set_depth_mod::ad_set_depth_tile
subroutine, public ad_set_depth_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nstp, nnew, h, ad_h, zice, zt_avg1, ad_zt_avg1, ad_hz, ad_z_r, ad_z_w)
Definition ad_set_depth.F:90
ad_t3dbc_mod
Definition ad_t3dbc_im.F:2
ad_t3dbc_mod::ad_t3dbc_tile
subroutine, public ad_t3dbc_tile(ng, tile, itrc, ic, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nout, ad_t)
Definition ad_t3dbc_im.F:57
ad_u2dbc_mod
Definition ad_u2dbc_im.F:2
ad_u2dbc_mod::ad_u2dbc_tile
subroutine, public ad_u2dbc_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, krhs, kstp, kout, ubar, vbar, zeta, ad_ubar, ad_vbar, ad_zeta)
Definition ad_u2dbc_im.F:65
ad_u3dbc_mod
Definition ad_u3dbc_im.F:2
ad_u3dbc_mod::ad_u3dbc_tile
subroutine, public ad_u3dbc_tile(ng, tile, lbi, ubi, lbj, ubj, ubk, imins, imaxs, jmins, jmaxs, nstp, nout, ad_u)
Definition ad_u3dbc_im.F:57
ad_v2dbc_mod
Definition ad_v2dbc_im.F:2
ad_v2dbc_mod::ad_v2dbc_tile
subroutine, public ad_v2dbc_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, krhs, kstp, kout, ubar, vbar, zeta, ad_ubar, ad_vbar, ad_zeta)
Definition ad_v2dbc_im.F:65
ad_v3dbc_mod
Definition ad_v3dbc_im.F:2
ad_v3dbc_mod::ad_v3dbc_tile
subroutine, public ad_v3dbc_tile(ng, tile, lbi, ubi, lbj, ubj, ubk, imins, imaxs, jmins, jmaxs, nstp, nout, ad_v)
Definition ad_v3dbc_im.F:57
ad_zetabc_mod
Definition ad_zetabc.F:2
ad_zetabc_mod::ad_zetabc_tile
subroutine, public ad_zetabc_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, krhs, kstp, kout, zeta, ad_zeta)
Definition ad_zetabc.F:57
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::isvbar
integer isvbar
Definition mod_ncparam.F:505
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_ncparam::isubar
integer isubar
Definition mod_ncparam.F:504
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param
Definition mod_param.F:2
mod_param::ad_lbc
type(t_lbc), dimension(:,:,:), allocatable ad_lbc
Definition mod_param.F:378
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::iadm
integer, parameter iadm
Definition mod_param.F:665
mod_scalars
Definition mod_scalars.F:2
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
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::ntend
integer, dimension(:), allocatable ntend
Definition mod_scalars.F:379
mod_scalars::ltracerclm
logical, dimension(:,:), allocatable ltracerclm
Definition mod_scalars.F:528
mod_scalars::lnudgetclm
logical, dimension(:,:), allocatable lnudgetclm
Definition mod_scalars.F:535
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::ithck
integer, parameter ithck
Definition sediment_mod.h:116
mod_stepping
Definition mod_stepping.F:2
mod_stepping::kstp
integer, dimension(:), allocatable kstp
Definition mod_stepping.F:66
mod_stepping::knew
integer, dimension(:), allocatable knew
Definition mod_stepping.F:64
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
mod_stepping::krhs
integer, dimension(:), allocatable krhs
Definition mod_stepping.F:65
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::ad_mp_exchange3d
subroutine ad_mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
Definition mp_exchange.F:5451
mp_exchange_mod::ad_mp_exchange4d
subroutine ad_mp_exchange4d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c)
Definition mp_exchange.F:7058
mp_exchange_mod::ad_mp_exchange2d
subroutine ad_mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
Definition mp_exchange.F:4058
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