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

Functions/Subroutines

subroutine, public ad_uv3dmix4 (ng, tile)
 
subroutine ad_uv3dmix4_geo_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, nnew, pmask, rmask, umask, vmask, om_p, om_r, om_u, om_v, on_p, on_r, on_u, on_v, pm, pn, hz, ad_hz, z_r, ad_z_r, uvis3d_r, vvis3d_r, ad_uvis3d_r, ad_vvis3d_r, visc3d_r, ad_visc3d_r, visc4_p, visc4_r, u, v, ad_u, ad_v, ad_rufrc, ad_rvfrc)
 
subroutine ad_uv3dmix4_s_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, nnew, pmask, hz, ad_hz, om_p, om_r, on_p, on_r, pm, pmon_p, pmon_r, pn, pnom_p, pnom_r, visc4_p, visc4_r, u, v, ad_rufrc, ad_rvfrc, ad_u, ad_v)
 

Function/Subroutine Documentation

◆ ad_uv3dmix4()

subroutine public ad_uv3dmix4_mod::ad_uv3dmix4 ( integer, intent(in) ng,
integer, intent(in) tile )

Definition at line 42 of file ad_uv3dmix4_geo.h.

43!***********************************************************************
44!
45 USE mod_param
46 USE mod_ncparam
47 USE mod_coupling
48#ifdef DIAGNOSTICS_UV
49!! USE mod_diags
50#endif
51 USE mod_grid
52 USE mod_mixing
53 USE mod_ocean
54 USE mod_stepping
55!
56! Imported variable declarations.
57!
58 integer, intent(in) :: ng, tile
59!
60! Local variable declarations.
61!
62 character (len=*), parameter :: MyFile = &
63 & __FILE__
64!
65#include "tile.h"
66!
67#ifdef PROFILE
68 CALL wclock_on (ng, iadm, 33, __line__, myfile)
69#endif
70 CALL ad_uv3dmix4_geo_tile (ng, tile, &
71 & lbi, ubi, lbj, ubj, &
72 & imins, imaxs, jmins, jmaxs, &
73 & nrhs(ng), nnew(ng), &
74#ifdef MASKING
75 & grid(ng) % pmask, &
76 & grid(ng) % rmask, &
77 & grid(ng) % umask, &
78 & grid(ng) % vmask, &
79#endif
80 & grid(ng) % om_p, &
81 & grid(ng) % om_r, &
82 & grid(ng) % om_u, &
83 & grid(ng) % om_v, &
84 & grid(ng) % on_p, &
85 & grid(ng) % on_r, &
86 & grid(ng) % on_u, &
87 & grid(ng) % on_v, &
88 & grid(ng) % pm, &
89 & grid(ng) % pn, &
90 & grid(ng) % Hz, &
91 & grid(ng) % ad_Hz, &
92 & grid(ng) % z_r, &
93 & grid(ng) % ad_z_r, &
94#ifdef VISC_3DCOEF
95# ifdef UV_U3ADV_SPLIT
96 & mixing(ng) % Uvis3d_r, &
97 & mixing(ng) % Vvis3d_r, &
98 & mixing(ng) % ad_Uvis3d_r, &
99 & mixing(ng) % ad_Vvis3d_r, &
100# else
101 & mixing(ng) % visc3d_r, &
102 & mixing(ng) % ad_visc3d_r, &
103# endif
104#else
105 & mixing(ng) % visc4_p, &
106 & mixing(ng) % visc4_r, &
107#endif
108#ifdef DIAGNOSTICS_UV
109!! & DIAGS(ng) % DiaRUfrc, &
110!! & DIAGS(ng) % DiaRVfrc, &
111!! & DIAGS(ng) % DiaU3wrk, &
112!! & DIAGS(ng) % DiaV3wrk, &
113#endif
114 & ocean(ng) % u, &
115 & ocean(ng) % v, &
116 & ocean(ng) % ad_u, &
117 & ocean(ng) % ad_v, &
118 & coupling(ng) % ad_rufrc, &
119 & coupling(ng) % ad_rvfrc)
120#ifdef PROFILE
121 CALL wclock_off (ng, iadm, 33, __line__, myfile)
122#endif
123!
124 RETURN
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_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_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::iadm
integer, parameter iadm
Definition mod_param.F:665
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nrhs
integer, dimension(:), allocatable nrhs
Definition mod_stepping.F:70
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
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 ad_uv3dmix4_geo_tile(), mod_coupling::coupling, mod_grid::grid, mod_param::iadm, mod_mixing::mixing, mod_stepping::nnew, mod_stepping::nrhs, mod_ocean::ocean, wclock_off(), and wclock_on().

Referenced by ad_rhs3d_mod::ad_rhs3d().

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

◆ ad_uv3dmix4_geo_tile()

subroutine ad_uv3dmix4_mod::ad_uv3dmix4_geo_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) nrhs,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) umask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) vmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_u,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_v,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_u,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_v,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pm,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pn,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(inout) ad_hz,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(inout) ad_z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) uvis3d_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) vvis3d_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(inout) ad_uvis3d_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(inout) ad_vvis3d_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) visc3d_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(inout) ad_visc3d_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) visc4_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) visc4_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(in) u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(in) v,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) ad_u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) ad_v,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) ad_rufrc,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) ad_rvfrc )
private

Definition at line 128 of file ad_uv3dmix4_geo.h.

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

References mod_param::ad_lbc, mod_scalars::compositegrid, mod_param::domain, mod_scalars::dt, mod_scalars::ewperiodic, mod_scalars::gamma2, mod_scalars::ieast, mod_scalars::inorth, mod_scalars::isouth, mod_ncparam::isuvel, mod_ncparam::isvvel, mod_scalars::iwest, and mod_scalars::nsperiodic.

Referenced by ad_uv3dmix4().

Here is the caller graph for this function:

◆ ad_uv3dmix4_s_tile()

subroutine ad_uv3dmix4_mod::ad_uv3dmix4_s_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) nrhs,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmask,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(inout) ad_hz,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pm,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmon_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmon_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pn,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pnom_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pnom_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) visc4_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) visc4_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) v,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) ad_rufrc,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) ad_rvfrc,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) ad_u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) ad_v )
private

Definition at line 114 of file ad_uv3dmix4_s.h.

132!***********************************************************************
133!
134 USE mod_param
135 USE mod_scalars
136!
137! Imported variable declarations.
138!
139 integer, intent(in) :: ng, tile
140 integer, intent(in) :: LBi, UBi, LBj, UBj
141 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
142 integer, intent(in) :: nrhs, nnew
143
144#ifdef ASSUMED_SHAPE
145# ifdef MASKING
146 real(r8), intent(in) :: pmask(LBi:,LBj:)
147# endif
148 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
149 real(r8), intent(in) :: om_p(LBi:,LBj:)
150 real(r8), intent(in) :: om_r(LBi:,LBj:)
151 real(r8), intent(in) :: on_p(LBi:,LBj:)
152 real(r8), intent(in) :: on_r(LBi:,LBj:)
153 real(r8), intent(in) :: pm(LBi:,LBj:)
154 real(r8), intent(in) :: pmon_p(LBi:,LBj:)
155 real(r8), intent(in) :: pmon_r(LBi:,LBj:)
156 real(r8), intent(in) :: pn(LBi:,LBj:)
157 real(r8), intent(in) :: pnom_p(LBi:,LBj:)
158 real(r8), intent(in) :: pnom_r(LBi:,LBj:)
159 real(r8), intent(in) :: visc4_p(LBi:,LBj:)
160 real(r8), intent(in) :: visc4_r(LBi:,LBj:)
161
162 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
163 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
164
165!!# ifdef DIAGNOSTICS_UV
166!! real(r8), intent(inout) :: DiaRUfrc(LBi:,LBj:,:,:)
167!! real(r8), intent(inout) :: DiaRVfrc(LBi:,LBj:,:,:)
168!! real(r8), intent(inout) :: DiaU3wrk(LBi:,LBj:,:,:)
169!! real(r8), intent(inout) :: DiaV3wrk(LBi:,LBj:,:,:)
170!!# endif
171
172 real(r8), intent(inout) :: ad_Hz(LBi:,LBj:,:)
173 real(r8), intent(inout) :: ad_rufrc(LBi:,LBj:)
174 real(r8), intent(inout) :: ad_rvfrc(LBi:,LBj:)
175 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
176 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
177
178#else
179
180# ifdef MASKING
181 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
182# endif
183 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
184 real(r8), intent(in) :: om_p(LBi:UBi,LBj:UBj)
185 real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj)
186 real(r8), intent(in) :: on_p(LBi:UBi,LBj:UBj)
187 real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj)
188 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
189 real(r8), intent(in) :: pmon_p(LBi:UBi,LBj:UBj)
190 real(r8), intent(in) :: pmon_r(LBi:UBi,LBj:UBj)
191 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
192 real(r8), intent(in) :: pnom_p(LBi:UBi,LBj:UBj)
193 real(r8), intent(in) :: pnom_r(LBi:UBi,LBj:UBj)
194 real(r8), intent(in) :: visc4_p(LBi:UBi,LBj:UBj)
195 real(r8), intent(in) :: visc4_r(LBi:UBi,LBj:UBj)
196
197 real(r8), intent(inout) :: u(LBi:UBi,LBj:UBj,N(ng),2)
198 real(r8), intent(inout) :: v(LBi:UBi,LBj:UBj,N(ng),2)
199
200!!# ifdef DIAGNOSTICS_UV
201!! real(r8), intent(inout) :: DiaRUfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
202!! real(r8), intent(inout) :: DiaRVfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
203!! real(r8), intent(inout) :: DiaU3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
204!! real(r8), intent(inout) :: DiaV3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
205!!# endif
206
207 real(r8), intent(inout) :: ad_Hz(LBi:UBi,LBj:UBj,N(ng))
208 real(r8), intent(inout) :: ad_rufrc(LBi:UBi,LBj:UBj)
209 real(r8), intent(inout) :: ad_rvfrc(LBi:UBi,LBj:UBj)
210 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
211 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
212#endif
213!
214! Local variable declarations.
215!
216 integer :: IminU, IminV, ImaxU, ImaxV
217 integer :: JminU, JminV, JmaxU, JmaxV
218 integer :: i, j, k
219
220 real(r8) :: cff, cff1, cff2
221 real(r8) :: ad_cff, ad_cff1, ad_cff2
222 real(r8) :: adfac, adfac1, adfac2, adfac3, adfac4
223
224 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: LapU
225 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: LapV
226 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFe
227 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFe
228 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFx
229 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFx
230
231 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_LapU
232 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_LapV
233 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_UFe
234 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_VFe
235 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_UFx
236 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_VFx
237
238#include "set_bounds.h"
239!
240!-----------------------------------------------------------------------
241! Initialize adjoint private variables.
242!-----------------------------------------------------------------------
243!
244 ad_cff=0.0_r8
245 ad_cff1=0.0_r8
246 ad_cff2=0.0_r8
247
248 ad_lapu(imins:imaxs,jmins:jmaxs)=0.0_r8
249 ad_lapv(imins:imaxs,jmins:jmaxs)=0.0_r8
250
251 ad_ufe(imins:imaxs,jmins:jmaxs)=0.0_r8
252 ad_vfe(imins:imaxs,jmins:jmaxs)=0.0_r8
253 ad_ufx(imins:imaxs,jmins:jmaxs)=0.0_r8
254 ad_vfx(imins:imaxs,jmins:jmaxs)=0.0_r8
255!
256!-----------------------------------------------------------------------
257! Compute adjoint horizontal biharmonic viscosity along constant
258! S-surfaces. The biharmonic operator is computed by applying the
259! harmonic operator twice.
260!-----------------------------------------------------------------------
261!
262! Set local I- and J-ranges.
263!
264 IF (ewperiodic(ng)) THEN
265 iminu=istr-1
266 imaxu=iend+1
267 iminv=istr-1
268 imaxv=iend+1
269 ELSE
270 iminu=max(2,istru-1)
271 imaxu=min(iend+1,lm(ng))
272 iminv=max(1,istr-1)
273 imaxv=min(iend+1,lm(ng))
274 END IF
275 IF (nsperiodic(ng)) THEN
276 jminu=jstr-1
277 jmaxu=jend+1
278 jminv=jstr-1
279 jmaxv=jend+1
280 ELSE
281 jminu=max(1,jstr-1)
282 jmaxu=min(jend+1,mm(ng))
283 jminv=max(2,jstrv-1)
284 jmaxv=min(jend+1,mm(ng))
285 END IF
286!
287! Computed required BASIC STATE flux-components of the horizontal
288! divergence of the stress tensor in XI- and ETA-directions.
289!
290 k_loop : DO k=1,n(ng)
291 DO j=-1+jminv,jmaxv
292 DO i=-1+iminu,imaxu
293 cff=visc4_r(i,j)*0.5_r8* &
294 & (pmon_r(i,j)* &
295 & ((pn(i ,j)+pn(i+1,j))*u(i+1,j,k,nrhs)- &
296 & (pn(i-1,j)+pn(i ,j))*u(i ,j,k,nrhs))- &
297 & pnom_r(i,j)* &
298 & ((pm(i,j )+pm(i,j+1))*v(i,j+1,k,nrhs)- &
299 & (pm(i,j-1)+pm(i,j ))*v(i,j ,k,nrhs)))
300 ufx(i,j)=on_r(i,j)*on_r(i,j)*cff
301 vfe(i,j)=om_r(i,j)*om_r(i,j)*cff
302 END DO
303 END DO
304 DO j=jminu,jmaxu+1
305 DO i=iminv,imaxv+1
306 cff=visc4_p(i,j)*0.5_r8* &
307 & (pmon_p(i,j)* &
308 & ((pn(i ,j-1)+pn(i ,j))*v(i ,j,k,nrhs)- &
309 & (pn(i-1,j-1)+pn(i-1,j))*v(i-1,j,k,nrhs))+ &
310 & pnom_p(i,j)* &
311 & ((pm(i-1,j )+pm(i,j ))*u(i,j ,k,nrhs)- &
312 & (pm(i-1,j-1)+pm(i,j-1))*u(i,j-1,k,nrhs)))
313#ifdef MASKING
314 cff=cff*pmask(i,j)
315#endif
316 ufe(i,j)=om_p(i,j)*om_p(i,j)*cff
317 vfx(i,j)=on_p(i,j)*on_p(i,j)*cff
318 END DO
319 END DO
320!
321! Compute BASIC STATE first harmonic operator (m s^-3/2).
322!
323 DO j=jminu,jmaxu
324 DO i=iminu,imaxu
325 lapu(i,j)=0.125_r8* &
326 & (pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))* &
327 & ((pn(i-1,j)+pn(i,j))*(ufx(i,j )-ufx(i-1,j))+ &
328 & (pm(i-1,j)+pm(i,j))*(ufe(i,j+1)-ufe(i ,j)))
329 END DO
330 END DO
331 DO j=jminv,jmaxv
332 DO i=iminv,imaxv
333 lapv(i,j)=0.125_r8* &
334 & (pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))* &
335 & ((pn(i,j-1)+pn(i,j))*(vfx(i+1,j)-vfx(i,j ))- &
336 & (pm(i,j-1)+pm(i,j))*(vfe(i ,j)-vfe(i,j-1)))
337 END DO
338 END DO
339!
340! Apply boundary conditions (other than periodic) to the BASIC STATE
341! first harmonic operator. These are gradient or closed (free slip or
342! no slip) boundary conditions.
343!
344 IF (.not.(compositegrid(iwest,ng).or.ewperiodic(ng))) THEN
345 IF (domain(ng)%Western_Edge(tile)) THEN
346 IF (ad_lbc(iwest,isuvel,ng)%closed) THEN
347 DO j=jminu,jmaxu
348 lapu(istr,j)=0.0_r8
349 END DO
350 ELSE
351 DO j=jminu,jmaxu
352 lapu(istr,j)=lapu(istr+1,j)
353 END DO
354 END IF
355 IF (ad_lbc(iwest,isvvel,ng)%closed) THEN
356 DO j=jminv,jmaxv
357 lapv(istr-1,j)=gamma2(ng)*lapv(istr,j)
358 END DO
359 ELSE
360 DO j=jminv,jmaxv
361 lapv(istr-1,j)=0.0_r8
362 END DO
363 END IF
364 END IF
365 END IF
366!
367 IF (.not.(compositegrid(ieast,ng).or.ewperiodic(ng))) THEN
368 IF (domain(ng)%Eastern_Edge(tile)) THEN
369 IF (ad_lbc(ieast,isuvel,ng)%closed) THEN
370 DO j=jminu,jmaxu
371 lapu(iend+1,j)=0.0_r8
372 END DO
373 ELSE
374 DO j=jminu,jmaxu
375 lapu(iend+1,j)=lapu(iend,j)
376 END DO
377 END IF
378 IF (ad_lbc(ieast,isvvel,ng)%closed) THEN
379 DO j=jminv,jmaxv
380 lapv(iend+1,j)=gamma2(ng)*lapv(iend,j)
381 END DO
382 ELSE
383 DO j=jminv,jmaxv
384 lapv(iend+1,j)=0.0_r8
385 END DO
386 END IF
387 END IF
388 END IF
389!
390 IF (.not.(compositegrid(isouth,ng).or.nsperiodic(ng))) THEN
391 IF (domain(ng)%Southern_Edge(tile)) THEN
392 IF (ad_lbc(isouth,isuvel,ng)%closed) THEN
393 DO i=iminu,imaxu
394 lapu(i,jstr-1)=gamma2(ng)*lapu(i,jstr)
395 END DO
396 ELSE
397 DO i=iminu,imaxu
398 lapu(i,jstr-1)=0.0_r8
399 END DO
400 END IF
401 IF (ad_lbc(isouth,isvvel,ng)%closed) THEN
402 DO i=iminv,imaxv
403 lapv(i,jstr)=0.0_r8
404 END DO
405 ELSE
406 DO i=iminv,imaxv
407 lapv(i,jstr)=lapv(i,jstr+1)
408 END DO
409 END IF
410 END IF
411 END IF
412!
413 IF (.not.(compositegrid(inorth,ng).or.nsperiodic(ng))) THEN
414 IF (domain(ng)%Northern_Edge(tile)) THEN
415 IF (ad_lbc(inorth,isuvel,ng)%closed) THEN
416 DO i=iminu,imaxu
417 lapu(i,jend+1)=gamma2(ng)*lapu(i,jend)
418 END DO
419 ELSE
420 DO i=iminu,imaxu
421 lapu(i,jend+1)=0.0_r8
422 END DO
423 END IF
424 IF (ad_lbc(inorth,isvvel,ng)%closed) THEN
425 DO i=iminv,imaxv
426 lapv(i,jend+1)=0.0_r8
427 END DO
428 ELSE
429 DO i=iminv,imaxv
430 lapv(i,jend+1)=lapv(i,jend)
431 END DO
432 END IF
433 END IF
434 END IF
435!
436 IF (.not.(compositegrid(isouth,ng).or.nsperiodic(ng).or. &
437 & compositegrid(iwest ,ng).or.ewperiodic(ng))) THEN
438 IF (domain(ng)%SouthWest_Corner(tile)) THEN
439 lapu(istr ,jstr-1)=0.5_r8* &
440 & (lapu(istr+1,jstr-1)+ &
441 & lapu(istr ,jstr ))
442 lapv(istr-1,jstr )=0.5_r8* &
443 & (lapv(istr-1,jstr+1)+ &
444 & lapv(istr ,jstr ))
445 END IF
446 END IF
447
448 IF (.not.(compositegrid(isouth,ng).or.nsperiodic(ng).or. &
449 & compositegrid(ieast ,ng).or.ewperiodic(ng))) THEN
450 IF (domain(ng)%SouthEast_Corner(tile)) THEN
451 lapu(iend+1,jstr-1)=0.5_r8* &
452 & (lapu(iend ,jstr-1)+ &
453 & lapu(iend+1,jstr ))
454 lapv(iend+1,jstr )=0.5_r8* &
455 & (lapv(iend ,jstr )+ &
456 & lapv(iend+1,jstr+1))
457 END IF
458 END IF
459
460 IF (.not.(compositegrid(inorth,ng).or.nsperiodic(ng).or. &
461 & compositegrid(iwest ,ng).or.ewperiodic(ng))) THEN
462 IF (domain(ng)%NorthWest_Corner(tile)) THEN
463 lapu(istr ,jend+1)=0.5_r8* &
464 & (lapu(istr+1,jend+1)+ &
465 & lapu(istr ,jend ))
466 lapv(istr-1,jend+1)=0.5_r8* &
467 & (lapv(istr ,jend+1)+ &
468 & lapv(istr-1,jend ))
469 END IF
470 END IF
471
472 IF (.not.(compositegrid(inorth,ng).or.nsperiodic(ng).or. &
473 & compositegrid(ieast ,ng).or.ewperiodic(ng))) THEN
474 IF (domain(ng)%NorthEast_Corner(tile)) THEN
475 lapu(iend+1,jend+1)=0.5_r8* &
476 & (lapu(iend ,jend+1)+ &
477 & lapu(iend+1,jend ))
478 lapv(iend+1,jend+1)=0.5_r8* &
479 & (lapv(iend ,jend+1)+ &
480 & lapv(iend+1,jend ))
481 END IF
482 END IF
483!
484! Time-step adjoint biharmonic, S-surfaces viscosity term. Notice that
485! momentum at this stage is HzU and HzV and has units m2/s.
486!
487 DO j=jstrv,jend
488 DO i=istr,iend
489 cff=0.25_r8*(pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))
490!!#ifdef DIAGNOSTICS_UV
491!! DiaRVfrc(i,j,3,M2hvis)=DiaRVfrc(i,j,3,M2hvis)-cff1
492!! DiaV3wrk(i,j,k,M3hvis)=-cff2
493!!#endif
494!^ tl_v(i,j,k,nnew)=tl_v(i,j,k,nnew)-tl_cff2
495!^
496 ad_cff2=ad_cff2-ad_v(i,j,k,nnew)
497!^ tl_rvfrc(i,j)=tl_rvfrc(i,j)-tl_cff1
498!^
499 ad_cff1=ad_cff1-ad_rvfrc(i,j)
500!^ tl_cff2=dt(ng)*cff*tl_cff1
501!^
502 ad_cff1=ad_cff1+dt(ng)*cff*ad_cff2
503 ad_cff2=0.0_r8
504!^ tl_cff1=0.5_r8*((pn(i,j-1)+pn(i,j))* &
505!^ & (tl_VFx(i+1,j)-tl_VFx(i,j ))- &
506!^ & (pm(i,j-1)+pm(i,j))* &
507!^ & (tl_VFe(i ,j)-tl_VFe(i,j-1)))
508!^
509 adfac=0.5_r8*ad_cff1
510 adfac1=adfac*(pn(i,j-1)+pn(i,j))
511 adfac2=adfac*(pm(i,j-1)+pm(i,j))
512 ad_vfx(i ,j )=ad_vfx(i ,j )-adfac1
513 ad_vfx(i+1,j )=ad_vfx(i+1,j )+adfac1
514 ad_vfe(i ,j-1)=ad_vfe(i ,j-1)+adfac2
515 ad_vfe(i ,j )=ad_vfe(i ,j )-adfac2
516 ad_cff1=0.0_r8
517 END DO
518 END DO
519 DO j=jstr,jend
520 DO i=istru,iend
521 cff=0.25_r8*(pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))
522!!#ifdef DIAGNOSTICS_UV
523!! DiaRUfrc(i,j,3,M2hvis)=DiaRUfrc(i,j,3,M2hvis)-cff1
524!! DiaU3wrk(i,j,k,M3hvis)=-cff2
525!!#endif
526!^ tl_u(i,j,k,nnew)=tl_u(i,j,k,nnew)-tl_cff2
527!^
528 ad_cff2=ad_cff2-ad_u(i,j,k,nnew)
529!^ tl_rufrc(i,j)=tl_rufrc(i,j)-tl_cff1
530!^
531 ad_cff1=ad_cff1-ad_rufrc(i,j)
532!^ tl_cff2=dt(ng)*cff*tl_cff1
533!^
534 ad_cff1=ad_cff1+dt(ng)*cff*ad_cff2
535 ad_cff2=0.0_r8
536!^ tl_cff1=0.5_r8*((pn(i-1,j)+pn(i,j))* &
537!^ & (tl_UFx(i,j )-tl_UFx(i-1,j))+ &
538!^ & (pm(i-1,j)+pm(i,j))* &
539!^ & (tl_UFe(i,j+1)-tl_UFe(i ,j)))
540!^
541 adfac=0.5_r8*ad_cff1
542 adfac1=adfac*(pn(i-1,j)+pn(i,j))
543 adfac2=adfac*(pm(i-1,j)+pm(i,j))
544 ad_ufx(i-1,j )=ad_ufx(i-1,j )-adfac1
545 ad_ufx(i ,j )=ad_ufx(i ,j )+adfac1
546 ad_ufe(i ,j )=ad_ufe(i ,j )-adfac2
547 ad_ufe(i ,j+1)=ad_ufe(i ,j+1)+adfac2
548 ad_cff1=0.0_r8
549 END DO
550 END DO
551!
552! Compute flux-components of the adjoint horizontal divergence of the
553! harmonic stress tensor (m4/s2) in XI- and ETA-directions.
554!
555 DO j=jstr,jend+1
556 DO i=istr,iend+1
557!^ tl_VFx(i,j)=on_p(i,j)*on_p(i,j)*tl_cff
558!^
559 ad_cff=ad_cff+on_p(i,j)*on_p(i,j)*ad_vfx(i,j)
560 ad_vfx(i,j)=0.0_r8
561!^ tl_UFe(i,j)=om_p(i,j)*om_p(i,j)*tl_cff
562!^
563 ad_cff=ad_cff+om_p(i,j)*om_p(i,j)*ad_ufe(i,j)
564 ad_ufe(i,j)=0.0_r8
565#ifdef MASKING
566!^ tl_cff=tl_cff*pmask(i,j)
567!^
568 ad_cff=ad_cff*pmask(i,j)
569#endif
570!^ tl_cff=visc4_p(i,j)*0.125_r8* &
571!^ & ((tl_Hz(i-1,j ,k)+tl_Hz(i,j ,k)+ &
572!^ & tl_Hz(i-1,j-1,k)+tl_Hz(i,j-1,k))* &
573!^ & (pmon_p(i,j)* &
574!^ & ((pn(i ,j-1)+pn(i ,j))*LapV(i ,j)- &
575!^ & (pn(i-1,j-1)+pn(i-1,j))*LapV(i-1,j))+ &
576!^ & pnom_p(i,j)* &
577!^ & ((pm(i-1,j )+pm(i,j ))*LapU(i,j )- &
578!^ & (pm(i-1,j-1)+pm(i,j-1))*LapU(i,j-1)))+ &
579!^ & (Hz(i-1,j ,k)+Hz(i,j ,k)+ &
580!^ & Hz(i-1,j-1,k)+Hz(i,j-1,k))* &
581!^ & (pmon_p(i,j)* &
582!^ & ((pn(i ,j-1)+pn(i ,j))*tl_LapV(i ,j)- &
583!^ & (pn(i-1,j-1)+pn(i-1,j))*tl_LapV(i-1,j))+ &
584!^ & pnom_p(i,j)* &
585!^ & ((pm(i-1,j )+pm(i,j ))*tl_LapU(i,j )- &
586!^ & (pm(i-1,j-1)+pm(i,j-1))*tl_LapU(i,j-1))))
587!^
588 adfac=visc4_p(i,j)*0.125_r8*ad_cff
589 adfac1=adfac*(pmon_p(i,j)* &
590 & ((pn(i ,j-1)+pn(i ,j))*lapv(i ,j)- &
591 & (pn(i-1,j-1)+pn(i-1,j))*lapv(i-1,j))+ &
592 & pnom_p(i,j)* &
593 & ((pm(i-1,j )+pm(i,j ))*lapu(i,j )- &
594 & (pm(i-1,j-1)+pm(i,j-1))*lapu(i,j-1)))
595 adfac2=adfac*(hz(i-1,j ,k)+hz(i,j ,k)+ &
596 & hz(i-1,j-1,k)+hz(i,j-1,k))
597 adfac3=adfac2*pmon_p(i,j)
598 adfac4=adfac2*pnom_p(i,j)
599 ad_hz(i-1,j-1,k)=ad_hz(i-1,j-1,k)+adfac1
600 ad_hz(i-1,j ,k)=ad_hz(i-1,j ,k)+adfac1
601 ad_hz(i ,j-1,k)=ad_hz(i ,j-1,k)+adfac1
602 ad_hz(i ,j ,k)=ad_hz(i ,j ,k)+adfac1
603 ad_lapv(i-1,j)=ad_lapv(i-1,j)- &
604 & (pn(i-1,j-1)+pn(i-1,j))*adfac3
605 ad_lapv(i ,j)=ad_lapv(i ,j)+ &
606 & (pn(i ,j-1)+pn(i ,j))*adfac3
607 ad_lapu(i,j-1)=ad_lapu(i,j-1)- &
608 & (pm(i-1,j-1)+pm(i,j-1))*adfac4
609 ad_lapu(i,j )=ad_lapu(i,j )+ &
610 & (pm(i-1,j )+pm(i,j ))*adfac4
611 ad_cff=0.0_r8
612 END DO
613 END DO
614!
615 DO j=jstrv-1,jend
616 DO i=istru-1,iend
617!^ tl_VFe(i,j)=om_r(i,j)*om_r(i,j)*tl_cff
618!^
619 ad_cff=ad_cff+om_r(i,j)*om_r(i,j)*ad_vfe(i,j)
620 ad_vfe(i,j)=0.0_r8
621!^ tl_UFx(i,j)=on_r(i,j)*on_r(i,j)*tl_cff
622!^
623 ad_cff=ad_cff+on_r(i,j)*on_r(i,j)*ad_ufx(i,j)
624 ad_ufx(i,j)=0.0_r8
625!^ tl_cff=visc4_r(i,j)*0.5_r8* &
626!^ & (tl_Hz(i,j,k)*
627!^ & (pmon_r(i,j)* &
628!^ & ((pn(i ,j)+pn(i+1,j))*LapU(i+1,j)- &
629!^ & (pn(i-1,j)+pn(i ,j))*LapU(i ,j))- &
630!^ & pnom_r(i,j)* &
631!^ & ((pm(i,j )+pm(i,j+1))*LapV(i,j+1)- &
632!^ & (pm(i,j-1)+pm(i,j ))*LapV(i,j )))+ &
633!^ & Hz(i,j,k)* &
634!^ & (pmon_r(i,j)* &
635!^ & ((pn(i ,j)+pn(i+1,j))*tl_LapU(i+1,j)- &
636!^ & (pn(i-1,j)+pn(i ,j))*tl_LapU(i ,j))- &
637!^ & pnom_r(i,j)* &
638!^ & ((pm(i,j )+pm(i,j+1))*tl_LapV(i,j+1)- &
639!^ & (pm(i,j-1)+pm(i,j ))*tl_LapV(i,j ))))
640!^
641 adfac=visc4_r(i,j)*0.5_r8*ad_cff
642 adfac1=adfac*hz(i,j,k)
643 adfac2=adfac1*pmon_r(i,j)
644 adfac3=adfac1*pnom_r(i,j)
645 ad_hz(i,j,k)=ad_hz(i,j,k)+ &
646 & (pmon_r(i,j)* &
647 & ((pn(i ,j)+pn(i+1,j))*lapu(i+1,j)- &
648 & (pn(i-1,j)+pn(i ,j))*lapu(i ,j))- &
649 & pnom_r(i,j)* &
650 & ((pm(i,j )+pm(i,j+1))*lapv(i,j+1)- &
651 & (pm(i,j-1)+pm(i,j ))*lapv(i,j )))*adfac
652 ad_lapu(i ,j)=ad_lapu(i ,j)- &
653 & (pn(i-1,j)+pn(i ,j))*adfac2
654 ad_lapu(i+1,j)=ad_lapu(i+1,j)+ &
655 & (pn(i ,j)+pn(i+1,j))*adfac2
656 ad_lapv(i,j )=ad_lapv(i,j )+ &
657 & (pm(i,j-1)+pm(i,j ))*adfac3
658 ad_lapv(i,j+1)=ad_lapv(i,j+1)- &
659 & (pm(i,j )+pm(i,j+1))*adfac3
660 ad_cff=0.0_r8
661 END DO
662 END DO
663!
664! Apply boundary conditions (other than periodic) to the first
665! adjoint harmonic operator. These are gradient or closed
666! (free slip or no slip) boundary conditions.
667!
668 IF (.not.(compositegrid(inorth,ng).or.nsperiodic(ng).or. &
669 & compositegrid(ieast ,ng).or.ewperiodic(ng))) THEN
670 IF (domain(ng)%NorthEast_Corner(tile)) THEN
671!^ tl_LapV(Iend+1,Jend+1)=0.5_r8* &
672!^ & (tl_LapV(Iend ,Jend+1)+ &
673!^ & tl_LapV(Iend+1,Jend ))
674!^
675 adfac=0.5_r8*ad_lapv(iend+1,jend+1)
676 ad_lapv(iend ,jend+1)=ad_lapv(iend ,jend+1)+adfac
677 ad_lapv(iend+1,jend )=ad_lapv(iend+1,jend )+adfac
678 ad_lapv(iend+1,jend+1)=0.0_r8
679!^ tl_LapU(Iend+1,Jend+1)=0.5_r8* &
680!^ & (tl_LapU(Iend ,Jend+1)+ &
681!^ & tl_LapU(Iend+1,Jend ))
682!^
683 adfac=0.5_r8*ad_lapu(iend+1,jend+1)
684 ad_lapu(iend ,jend+1)=ad_lapu(iend ,jend+1)+adfac
685 ad_lapu(iend+1,jend )=ad_lapu(iend+1,jend )+adfac
686 ad_lapu(iend+1,jend+1)=0.0_r8
687 END IF
688 END IF
689
690 IF (.not.(compositegrid(inorth,ng).or.nsperiodic(ng).or. &
691 & compositegrid(iwest ,ng).or.ewperiodic(ng))) THEN
692 IF (domain(ng)%NorthWest_Corner(tile)) THEN
693!^ tl_LapV(Istr-1,Jend+1)=0.5_r8* &
694!^ & (tl_LapV(Istr ,Jend+1)+ &
695!^ & tl_LapV(Istr-1,Jend ))
696!^
697 adfac=0.5_r8*ad_lapv(istr-1,jend+1)
698 ad_lapv(istr ,jend+1)=ad_lapv(istr ,jend+1)+adfac
699 ad_lapv(istr-1,jend )=ad_lapv(istr-1,jend )+adfac
700 ad_lapv(istr-1,jend+1)=0.0_r8
701!^ tl_LapU(Istr ,Jend+1)=0.5_r8* &
702!^ & (tl_LapU(Istr+1,Jend+1)+ &
703!^ & tl_LapU(Istr ,Jend ))
704!^
705 adfac=0.5_r8*ad_lapu(istr,jend+1)
706 ad_lapu(istr+1,jend+1)=ad_lapu(istr+1,jend+1)+adfac
707 ad_lapu(istr ,jend )=ad_lapu(istr ,jend )+adfac
708 ad_lapu(istr ,jend+1)=0.0_r8
709 END IF
710 END IF
711
712 IF (.not.(compositegrid(isouth,ng).or.nsperiodic(ng).or. &
713 & compositegrid(ieast ,ng).or.ewperiodic(ng))) THEN
714 IF (domain(ng)%SouthEast_Corner(tile)) THEN
715!^ tl_LapV(Iend+1,Jstr )=0.5_r8* &
716!^ & (tl_LapV(Iend ,Jstr )+ &
717!^ & tl_LapV(Iend+1,Jstr+1))
718!^
719 adfac=0.5_r8*ad_lapv(iend+1,jstr)
720 ad_lapv(iend ,jstr )=ad_lapv(iend ,jstr )+adfac
721 ad_lapv(iend+1,jstr+1)=ad_lapv(iend+1,jstr+1)+adfac
722 ad_lapv(iend+1,jstr )=0.0_r8
723!^ tl_LapU(Iend+1,Jstr-1)=0.5_r8* &
724!^ & (tl_LapU(Iend ,Jstr-1)+ &
725!^ & tl_LapU(Iend+1,Jstr ))
726!^
727 adfac=0.5_r8*ad_lapu(iend+1,jstr-1)
728 ad_lapu(iend ,jstr-1)=ad_lapu(iend ,jstr-1)+adfac
729 ad_lapu(iend+1,jstr )=ad_lapu(iend+1,jstr )+adfac
730 ad_lapu(iend+1,jstr-1)=0.0_r8
731 END IF
732 END IF
733
734 IF (.not.(compositegrid(isouth,ng).or.nsperiodic(ng).or. &
735 & compositegrid(iwest ,ng).or.ewperiodic(ng))) THEN
736 IF (domain(ng)%SouthWest_Corner(tile)) THEN
737!^ tl_LapV(Istr-1,Jstr )=0.5_r8* &
738!^ & (tl_LapV(Istr-1,Jstr+1)+ &
739!^ & tl_LapV(Istr ,Jstr ))
740!^
741 adfac=0.5_r8*ad_lapv(istr-1,jstr)
742 ad_lapv(istr-1,jstr+1)=ad_lapv(istr-1,jstr+1)+adfac
743 ad_lapv(istr ,jstr )=ad_lapv(istr ,jstr )+adfac
744 ad_lapv(istr-1,jstr )=0.0_r8
745!^ tl_LapU(Istr ,Jstr-1)=0.5_r8* &
746!^ & (tl_LapU(Istr+1,Jstr-1)+ &
747!^ & tl_LapU(Istr ,Jstr ))
748!^
749 adfac=0.5_r8*ad_lapu(istr,jstr-1)
750 ad_lapu(istr+1,jstr-1)=ad_lapu(istr+1,jstr-1)+adfac
751 ad_lapu(istr ,jstr )=ad_lapu(istr ,jstr )+adfac
752 ad_lapu(istr ,jstr-1)=0.0_r8
753 END IF
754 END IF
755!
756 IF (.not.(compositegrid(inorth,ng).or.nsperiodic(ng))) THEN
757 IF (domain(ng)%Northern_Edge(tile)) THEN
758 IF (ad_lbc(inorth,isvvel,ng)%closed) THEN
759 DO i=iminv,imaxv
760!^ tl_LapV(i,Jend+1)=0.0_r8
761!^
762 ad_lapv(i,jend+1)=0.0_r8
763 END DO
764 ELSE
765 DO i=iminv,imaxv
766!^ tl_LapV(i,Jend+1)=tl_LapV(i,Jend)
767!^
768 ad_lapv(i,jend)=ad_lapv(i,jend)+ad_lapv(i,jend+1)
769 ad_lapv(i,jend+1)=0.0_r8
770 END DO
771 END IF
772 IF (ad_lbc(inorth,isuvel,ng)%closed) THEN
773 DO i=iminu,imaxu
774!^ tl_LapU(i,Jend+1)=gamma2(ng)*tl_LapU(i,Jend)
775!^
776 ad_lapu(i,jend)=ad_lapu(i,jend)+ &
777 & gamma2(ng)*ad_lapu(i,jend+1)
778 ad_lapu(i,jend+1)=0.0_r8
779 END DO
780 ELSE
781 DO i=iminu,imaxu
782!^ tl_LapU(i,Jend+1)=0.0_r8
783!^
784 ad_lapu(i,jend+1)=0.0_r8
785 END DO
786 END IF
787 END IF
788 END IF
789!
790 IF (.not.(compositegrid(isouth,ng).or.nsperiodic(ng))) THEN
791 IF (domain(ng)%Southern_Edge(tile)) THEN
792 IF (ad_lbc(isouth,isvvel,ng)%closed) THEN
793 DO i=iminv,imaxv
794!^ tl_LapV(i,JstrV-1)=0.0_r8
795!^
796 ad_lapv(i,jstrv-1)=0.0_r8
797 END DO
798 ELSE
799 DO i=iminv,imaxv
800!^ tl_LapV(i,JstrV-1)=tl_LapV(i,JstrV)
801!^
802 ad_lapv(i,jstrv)=ad_lapv(i,jstrv)+ad_lapv(i,jstrv-1)
803 ad_lapv(i,jstrv-1)=0.0_r8
804 END DO
805 END IF
806 IF (ad_lbc(isouth,isuvel,ng)%closed) THEN
807 DO i=iminu,imaxu
808!^ tl_LapU(i,Jstr-1)=gamma2(ng)*tl_LapU(i,Jstr)
809!^
810 ad_lapu(i,jstr)=ad_lapu(i,jstr)+ &
811 & gamma2(ng)*ad_lapu(i,jstr-1)
812 ad_lapu(i,jstr-1)=0.0_r8
813 END DO
814 ELSE
815 DO i=iminu,imaxu
816!^ tl_LapU(i,Jstr-1)=0.0_r8
817!^
818 ad_lapu(i,jstr-1)=0.0_r8
819 END DO
820 END IF
821 END IF
822 END IF
823!
824 IF (.not.(compositegrid(ieast,ng).or.ewperiodic(ng))) THEN
825 IF (domain(ng)%Eastern_Edge(tile)) THEN
826 IF (ad_lbc(ieast,isvvel,ng)%closed) THEN
827 DO j=jminv,jmaxv
828!^ tl_LapV(Iend+1,j)=gamma2(ng)*tl_LapV(Iend,j)
829!^
830 ad_lapv(iend,j)=ad_lapv(iend,j)+ &
831 & gamma2(ng)*ad_lapv(iend+1,j)
832 ad_lapv(iend+1,j)=0.0_r8
833 END DO
834 ELSE
835 DO j=jminv,jmaxv
836!^ tl_LapV(Iend+1,j)=0.0_r8
837!^
838 ad_lapv(iend+1,j)=0.0_r8
839 END DO
840 END IF
841 IF (ad_lbc(ieast,isuvel,ng)%closed) THEN
842 DO j=jminu,jmaxu
843!^ tl_LapU(Iend+1,j)=0.0_r8
844!^
845 ad_lapu(iend+1,j)=0.0_r8
846 END DO
847 ELSE
848 DO j=jminu,jmaxu
849!^ tl_LapU(Iend+1,j)=tl_LapU(Iend,j)
850!^
851 ad_lapu(iend,j)=ad_lapu(iend,j)+ad_lapu(iend+1,j)
852 ad_lapu(iend+1,j)=0.0_r8
853 END DO
854 END IF
855 END IF
856 END IF
857!
858 IF (.not.(compositegrid(iwest,ng).or.ewperiodic(ng))) THEN
859 IF (domain(ng)%Western_Edge(tile)) THEN
860 IF (ad_lbc(iwest,isvvel,ng)%closed) THEN
861 DO j=jminv,jmaxv
862!^ tl_LapV(Istr-1,j)=gamma2(ng)*tl_LapV(Istr,j)
863!^
864 ad_lapv(istr,j)=ad_lapv(istr,j)+ &
865 & gamma2(ng)*ad_lapv(istr-1,j)
866 ad_lapv(istr-1,j)=0.0_r8
867 END DO
868 ELSE
869 DO j=jminv,jmaxv
870!^ tl_LapV(Istr-1,j)=0.0_r8
871!^
872 ad_lapv(istr-1,j)=0.0_r8
873 END DO
874 END IF
875 IF (ad_lbc(iwest,isuvel,ng)%closed) THEN
876 DO j=jminu,jmaxu
877!^ tl_LapU(IstrU-1,j)=0.0_r8
878!^
879 ad_lapu(istru-1,j)=0.0_r8
880 END DO
881 ELSE
882 DO j=jminu,jmaxu
883!^ tl_LapU(IstrU-1,j)=tl_LapU(IstrU,j)
884!^
885 ad_lapu(istru,j)=ad_lapu(istru,j)+ad_lapu(istru-1,j)
886 ad_lapu(istru-1,j)=0.0_r8
887 END DO
888 END IF
889 END IF
890 END IF
891!
892! Compute adjoint first harmonic operator (m s^-3/2).
893!
894 DO j=jminv,jmaxv
895 DO i=iminv,imaxv
896 cff=0.125_r8*(pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))
897!^ tl_LapV(i,j)=cff* &
898!^ & ((pn(i,j-1)+pn(i,j))* &
899!^ & (tl_VFx(i+1,j)-tl_VFx(i,j ))- &
900!^ & (pm(i,j-1)+pm(i,j))* &
901!^ & (tl_VFe(i ,j)-tl_VFe(i,j-1)))
902!^
903 adfac=cff*ad_lapv(i,j)
904 adfac1=adfac*(pn(i,j-1)+pn(i,j))
905 adfac2=adfac*(pm(i,j-1)+pm(i,j))
906 ad_vfx(i ,j)=ad_vfx(i ,j)-adfac1
907 ad_vfx(i+1,j)=ad_vfx(i+1,j)+adfac1
908 ad_vfe(i,j-1)=ad_vfe(i,j-1)+adfac2
909 ad_vfe(i, j)=ad_vfe(i, j)-adfac2
910 ad_lapv(i,j)=0.0_r8
911 END DO
912 END DO
913 DO j=jminu,jmaxu
914 DO i=iminu,imaxu
915 cff=0.125_r8*(pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))
916!^ tl_LapU(i,j)=cff* &
917!^ & ((pn(i-1,j)+pn(i,j))* &
918!^ & (tl_UFx(i,j )-tl_UFx(i-1,j))+ &
919!^ & (pm(i-1,j)+pm(i,j))* &
920!^ & (tl_UFe(i,j+1)-tl_UFe(i ,j)))
921!^
922 adfac=cff*ad_lapu(i,j)
923 adfac1=adfac*(pn(i-1,j)+pn(i,j))
924 adfac2=adfac*(pm(i-1,j)+pm(i,j))
925 ad_ufx(i-1,j)=ad_ufx(i-1,j)-adfac1
926 ad_ufx(i ,j )=ad_ufx(i ,j)+adfac1
927 ad_ufe(i,j )=ad_ufe(i,j )-adfac2
928 ad_ufe(i,j+1)=ad_ufe(i,j+1)+adfac2
929 ad_lapu(i,j)=0.0_r8
930 END DO
931 END DO
932!
933! Compute flux-components of the horizontal divergence of the stress
934! tensor (m4 s^-3/2) in XI- and ETA-directions. It is assumed here
935! that "visc4_r" and "visc4_p" are the squared root of the biharmonic
936! viscosity coefficient. For momentum balance purposes, the
937! thickness "Hz" appears only when computing the second harmonic
938! operator.
939!
940 DO j=jminu,jmaxu+1
941 DO i=iminv,imaxv+1
942!^ tl_VFx(i,j)=on_p(i,j)*on_p(i,j)*tl_cff
943!^
944 ad_cff=ad_cff+on_p(i,j)*on_p(i,j)*ad_vfx(i,j)
945 ad_vfx(i,j)=0.0_r8
946!^ tl_UFe(i,j)=om_p(i,j)*om_p(i,j)*tl_cff
947!^
948 ad_cff=ad_cff+om_p(i,j)*om_p(i,j)*ad_ufe(i,j)
949 ad_ufe(i,j)=0.0_r8
950#ifdef MASKING
951!^ tl_cff=tl_cff*pmask(i,j)
952!^
953 ad_cff=ad_cff*pmask(i,j)
954#endif
955!^ tl_cff=visc4_p(i,j)*0.5_r8* &
956!^ & (pmon_p(i,j)* &
957!^ & ((pn(i ,j-1)+pn(i ,j))*tl_v(i ,j,k,nrhs)- &
958!^ & (pn(i-1,j-1)+pn(i-1,j))*tl_v(i-1,j,k,nrhs))+ &
959!^ & pnom_p(i,j)* &
960!^ & ((pm(i-1,j )+pm(i,j ))*tl_u(i,j ,k,nrhs)- &
961!^ & (pm(i-1,j-1)+pm(i,j-1))*tl_u(i,j-1,k,nrhs)))
962!^
963 adfac=visc4_p(i,j)*0.5_r8*ad_cff
964 adfac1=adfac*pmon_p(i,j)
965 adfac2=adfac*pnom_p(i,j)
966 ad_v(i-1,j,k,nrhs)=ad_v(i-1,j,k,nrhs)- &
967 & (pn(i-1,j-1)+pn(i-1,j))*adfac1
968 ad_v(i ,j,k,nrhs)=ad_v(i ,j,k,nrhs)+ &
969 & (pn(i ,j-1)+pn(i ,j))*adfac1
970 ad_u(i,j ,k,nrhs)=ad_u(i,j ,k,nrhs)+ &
971 & (pm(i-1,j )+pm(i,j ))*adfac2
972 ad_u(i,j-1,k,nrhs)=ad_u(i,j-1,k,nrhs)- &
973 & (pm(i-1,j-1)+pm(i,j-1))*adfac2
974 ad_cff=0.0_r8
975 END DO
976 END DO
977 DO j=-1+jminv,jmaxv
978 DO i=-1+iminu,imaxu
979!^ tl_VFe(i,j)=om_r(i,j)*om_r(i,j)*tl_cff
980!^
981 ad_cff=ad_cff+om_r(i,j)*om_r(i,j)*ad_vfe(i,j)
982 ad_vfe(i,j)=0.0_r8
983!^ tl_UFx(i,j)=on_r(i,j)*on_r(i,j)*tl_cff
984!^
985 ad_cff=ad_cff+on_r(i,j)*on_r(i,j)*ad_ufx(i,j)
986 ad_ufx(i,j)=0.0_r8
987!^ tl_cff=visc4_r(i,j)*0.5_r8* &
988!^ & (pmon_r(i,j)* &
989!^ & ((pn(i ,j)+pn(i+1,j))*tl_u(i+1,j,k,nrhs)- &
990!^ & (pn(i-1,j)+pn(i ,j))*tl_u(i ,j,k,nrhs))- &
991!^ & pnom_r(i,j)* &
992!^ & ((pm(i,j )+pm(i,j+1))*tl_v(i,j+1,k,nrhs)- &
993!^ & (pm(i,j-1)+pm(i,j ))*tl_v(i,j ,k,nrhs)))
994!^
995 adfac=visc4_r(i,j)*0.5_r8*ad_cff
996 adfac1=adfac*pmon_r(i,j)
997 adfac2=adfac*pnom_r(i,j)
998 ad_u(i ,j,k,nrhs)=ad_u(i ,j,k,nrhs)- &
999 & (pn(i-1,j)+pn(i ,j))*adfac1
1000 ad_u(i+1,j,k,nrhs)=ad_u(i+1,j,k,nrhs)+ &
1001 & (pn(i ,j)+pn(i+1,j))*adfac1
1002 ad_v(i,j ,k,nrhs)=ad_v(i,j ,k,nrhs)+ &
1003 & (pm(i,j-1)+pm(i,j ))*adfac2
1004 ad_v(i,j+1,k,nrhs)=ad_v(i,j+1,k,nrhs)- &
1005 & (pm(i,j )+pm(i,j+1))*adfac2
1006 ad_cff=0.0_r8
1007 END DO
1008 END DO
1009 END DO k_loop
1010!
1011 RETURN
mod_param::lm
integer, dimension(:), allocatable lm
Definition mod_param.F:455
mod_param::mm
integer, dimension(:), allocatable mm
Definition mod_param.F:456

References mod_param::ad_lbc, mod_scalars::compositegrid, mod_param::domain, mod_scalars::dt, mod_scalars::ewperiodic, mod_scalars::gamma2, mod_scalars::ieast, mod_scalars::inorth, mod_scalars::isouth, mod_scalars::iwest, mod_param::lm, mod_param::mm, and mod_scalars::nsperiodic.