ROMS
Loading...
Searching...
No Matches
ad_convolution.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE ad_convolution_mod
3#if defined ADJOINT && defined FOUR_DVAR
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group Andrew M. Moore !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This routine performs a spatial convolution of the adjoint state !
13! solution to model the background error correlations, C, using !
14! a generalized diffusion operator. This allows the observational !
15! information to spread spatially in 4DVAR data assimilation. !
16! !
17! The background error covariance is defined as: !
18! !
19! B = S C S !
20! !
21! C = C^(1/2) C^(T/2) !
22! !
23! C^(1/2) = G L^(1/2) W^(-1/2) TLM !
24! C^(T/2) = W^(-1/2) L^(T/2) G ADM !
25! !
26! where !
27! !
28! B : background-error covariance matrix !
29! S : diagonal matrix of background-error standard deviations !
30! C : symmetric matrix of background-error correlations !
31! G : normalization coefficients matrix used to ensure that the !
32! diagonal variances of C are equal to unity. !
33! L : tangent linear and adjoint diffusion operators !
34! W : diagonal matrix of local area or volume metrics used to !
35! convert L into a symmetric matrix: LW^(-1). !
36! !
37! Here, T/2 denote the transpose if a squared-root factor. !
38! !
39! This routine is used to provide a better preconditioning of the !
40! minimization problem, which is expressed as a function of a new !
41! state vector, v, given by: !
42! !
43! v = B^(-1/2) delta_x (v-space) !
44! or !
45! delta_x = B^(1/2) v !
46! !
47! where !
48! !
49! B = tranpose{B^(1/2)} B^(1/2) !
50! !
51! Therefore, the cost function, J, gradient becomes: !
52! !
53! GRAD_v(J) = v + transpose{B^(1/2)} GRAD_x(J) !
54! !
55! In incremental 4DVAR, these spatial convolutions constitutes a !
56! smoothing action on the correlation operator and they are used !
57! to transform between model space to minimization space and vice !
58! versa: !
59! !
60! ad_convolution compute GRAD_v(J) from GRAD_x(J) !
61! tl_convolution compute x from v !
62! !
63! The minimization of of J in the descent algorithm is in v-space. !
64! !
65! Reference: !
66! !
67! Weaver, A. and P. Courtier, 2001: Correlation modeling on the !
68! sphere using a generalized diffusion equation, Q.J.R. Meteo. !
69! Soc, 127, 1815-1846. !
70! !
71!======================================================================!
72!
73 USE mod_kinds
74
75 implicit none
76
77 PRIVATE
78 PUBLIC :: ad_convolution
79
80 CONTAINS
81!
82!***********************************************************************
83 SUBROUTINE ad_convolution (ng, tile, Linp, Lweak, ifac)
84!***********************************************************************
85!
86 USE mod_param
87# ifdef ADJUST_BOUNDARY
88 USE mod_boundary
89# endif
90# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
91 USE mod_forces
92# endif
93 USE mod_grid
94 USE mod_mixing
95 USE mod_ocean
96# if defined SEDIMENT && defined SED_MORPH && defined SOLVE3D
97 USE mod_sedbed
98# endif
99 USE mod_stepping
100!
101! Imported variable declarations.
102!
103 logical, intent(in) :: lweak
104
105 integer, intent(in) :: ng, tile, linp, ifac
106!
107! Local variable declarations.
108!
109# include "tile.h"
110!
111 CALL ad_convolution_tile (ng, tile, &
112 & lbi, ubi, lbj, ubj, lbij, ubij, &
113 & imins, imaxs, jmins, jmaxs, &
114 & nstp(ng), nnew(ng), linp, lweak, ifac, &
115 & grid(ng) % pm, &
116 & grid(ng) % om_p, &
117 & grid(ng) % om_r, &
118 & grid(ng) % om_u, &
119 & grid(ng) % om_v, &
120 & grid(ng) % pn, &
121 & grid(ng) % on_p, &
122 & grid(ng) % on_r, &
123 & grid(ng) % on_u, &
124 & grid(ng) % on_v, &
125 & grid(ng) % pmon_p, &
126 & grid(ng) % pmon_r, &
127 & grid(ng) % pmon_u, &
128 & grid(ng) % pnom_p, &
129 & grid(ng) % pnom_r, &
130 & grid(ng) % pnom_v, &
131# ifdef MASKING
132 & grid(ng) % rmask, &
133 & grid(ng) % pmask, &
134 & grid(ng) % umask, &
135 & grid(ng) % vmask, &
136# endif
137# ifdef SOLVE3D
138 & grid(ng) % h, &
139# ifdef ICESHELF
140 & grid(ng) % zice, &
141# endif
142# if defined SEDIMENT && defined SED_MORPH
143 & sedbed(ng) % bed_thick, &
144# endif
145 & grid(ng) % Hz, &
146 & grid(ng) % z_r, &
147 & grid(ng) % z_w, &
148# endif
149 & mixing(ng) % Kh, &
150# ifdef SOLVE3D
151 & mixing(ng) % Kv, &
152# endif
153# ifdef ADJUST_BOUNDARY
154# ifdef SOLVE3D
155 & boundary(ng) % b_t_obc, &
156 & boundary(ng) % b_u_obc, &
157 & boundary(ng) % b_v_obc, &
158# endif
159 & boundary(ng) % b_ubar_obc, &
160 & boundary(ng) % b_vbar_obc, &
161 & boundary(ng) % b_zeta_obc, &
162# endif
163# ifdef ADJUST_WSTRESS
164 & forces(ng) % b_sustr, &
165 & forces(ng) % b_svstr, &
166# endif
167# if defined ADJUST_STFLUX && defined SOLVE3D
168 & forces(ng) % b_stflx, &
169# endif
170# ifdef SOLVE3D
171 & ocean(ng) % b_t, &
172 & ocean(ng) % b_u, &
173 & ocean(ng) % b_v, &
174# endif
175 & ocean(ng) % b_zeta, &
176 & ocean(ng) % b_ubar, &
177 & ocean(ng) % b_vbar, &
178# ifdef ADJUST_BOUNDARY
179# ifdef SOLVE3D
180 & boundary(ng) % ad_t_obc, &
181 & boundary(ng) % ad_u_obc, &
182 & boundary(ng) % ad_v_obc, &
183# endif
184 & boundary(ng) % ad_ubar_obc, &
185 & boundary(ng) % ad_vbar_obc, &
186 & boundary(ng) % ad_zeta_obc, &
187# endif
188# ifdef ADJUST_WSTRESS
189 & forces(ng) % ad_ustr, &
190 & forces(ng) % ad_vstr, &
191# endif
192# if defined ADJUST_STFLUX && defined SOLVE3D
193 & forces(ng) % ad_tflux, &
194# endif
195# ifdef SOLVE3D
196 & ocean(ng) % ad_t, &
197 & ocean(ng) % ad_u, &
198 & ocean(ng) % ad_v, &
199# endif
200 & ocean(ng) % ad_ubar, &
201 & ocean(ng) % ad_vbar, &
202 & ocean(ng) % ad_zeta)
203 RETURN
204 END SUBROUTINE ad_convolution
205!
206!***********************************************************************
207 SUBROUTINE ad_convolution_tile (ng, tile, &
208 & LBi, UBi, LBj, UBj, LBij, UBij, &
209 & IminS, ImaxS, JminS, JmaxS, &
210 & nstp, nnew, Linp, Lweak, ifac, &
211 & pm, om_p, om_r, om_u, om_v, &
212 & pn, on_p, on_r, on_u, on_v, &
213 & pmon_p, pmon_r, pmon_u, &
214 & pnom_p, pnom_r, pnom_v, &
215# ifdef MASKING
216 & rmask, pmask, umask, vmask, &
217# endif
218# ifdef SOLVE3D
219 & h, &
220# ifdef ICESHELF
221 & zice, &
222# endif
223# if defined SEDIMENT && defined SED_MORPH
224 & bed_thick, &
225# endif
226 & Hz, z_r, z_w, &
227# endif
228 & Kh, &
229# ifdef SOLVE3D
230 & Kv, &
231# endif
232# ifdef ADJUST_BOUNDARY
233# ifdef SOLVE3D
234 & VnormRobc, VnormUobc, VnormVobc, &
235# endif
236 & HnormRobc, HnormUobc, HnormVobc, &
237# endif
238# ifdef ADJUST_WSTRESS
239 & HnormSUS, HnormSVS, &
240# endif
241# if defined ADJUST_STFLUX && defined SOLVE3D
242 & HnormSTF, &
243# endif
244# ifdef SOLVE3D
245 & VnormR, VnormU, VnormV, &
246# endif
247 & HnormR, HnormU, HnormV, &
248# ifdef ADJUST_BOUNDARY
249# ifdef SOLVE3D
250 & ad_t_obc, ad_u_obc, ad_v_obc, &
251# endif
252 & ad_ubar_obc, ad_vbar_obc, &
253 & ad_zeta_obc, &
254# endif
255# ifdef ADJUST_WSTRESS
256 & ad_ustr, ad_vstr, &
257# endif
258# if defined ADJUST_STFLUX && defined SOLVE3D
259 & ad_tflux, &
260# endif
261# ifdef SOLVE3D
262 & ad_t, ad_u, ad_v, &
263# endif
264 & ad_ubar, ad_vbar, ad_zeta)
265!***********************************************************************
266!
267 USE mod_param
268 USE mod_fourdvar
269 USE mod_ncparam
270 USE mod_scalars
271!
272 USE ad_conv_2d_mod
273# ifdef SOLVE3D
274 USE ad_conv_3d_mod
275# endif
276# ifdef ADJUST_BOUNDARY
277 USE ad_conv_bry2d_mod
278# ifdef SOLVE3D
279 USE ad_conv_bry3d_mod
280# endif
281# endif
282# ifdef DISTRIBUTE
283 USE mp_exchange_mod
284# endif
285 USE set_depth_mod
286!
287! Imported variable declarations.
288!
289 logical, intent(in) :: Lweak
290
291 integer, intent(in) :: ng, tile
292 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
293 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
294 integer, intent(in) :: nstp, nnew, Linp, ifac
295!
296# ifdef ASSUMED_SHAPE
297 real(r8), intent(in) :: pm(LBi:,LBj:)
298 real(r8), intent(in) :: om_p(LBi:,LBj:)
299 real(r8), intent(in) :: om_r(LBi:,LBj:)
300 real(r8), intent(in) :: om_u(LBi:,LBj:)
301 real(r8), intent(in) :: om_v(LBi:,LBj:)
302 real(r8), intent(in) :: pn(LBi:,LBj:)
303 real(r8), intent(in) :: on_p(LBi:,LBj:)
304 real(r8), intent(in) :: on_r(LBi:,LBj:)
305 real(r8), intent(in) :: on_u(LBi:,LBj:)
306 real(r8), intent(in) :: on_v(LBi:,LBj:)
307 real(r8), intent(in) :: pmon_p(LBi:,LBj:)
308 real(r8), intent(in) :: pmon_r(LBi:,LBj:)
309 real(r8), intent(in) :: pmon_u(LBi:,LBj:)
310 real(r8), intent(in) :: pnom_p(LBi:,LBj:)
311 real(r8), intent(in) :: pnom_r(LBi:,LBj:)
312 real(r8), intent(in) :: pnom_v(LBi:,LBj:)
313# ifdef MASKING
314 real(r8), intent(in) :: rmask(LBi:,LBj:)
315 real(r8), intent(in) :: pmask(LBi:,LBj:)
316 real(r8), intent(in) :: umask(LBi:,LBj:)
317 real(r8), intent(in) :: vmask(LBi:,LBj:)
318# endif
319 real(r8), intent(in) :: Kh(LBi:,LBj:)
320# ifdef SOLVE3D
321 real(r8), intent(in) :: Kv(LBi:,LBj:,0:)
322# ifdef ICESHELF
323 real(r8), intent(in) :: zice(LBi:,LBj:)
324# endif
325# if defined SEDIMENT && defined SED_MORPH
326 real(r8), intent(inout):: bed_thick(LBi:,LBj:,:)
327# endif
328 real(r8), intent(inout) :: h(LBi:,LBj:)
329# endif
330# ifdef ADJUST_BOUNDARY
331# ifdef SOLVE3D
332 real(r8), intent (in) :: VnormRobc(LBij:,:,:,:)
333 real(r8), intent (in) :: VnormUobc(LBij:,:,:)
334 real(r8), intent (in) :: VnormVobc(LBij:,:,:)
335# endif
336 real(r8), intent (in) :: HnormRobc(LBij:,:)
337 real(r8), intent (in) :: HnormUobc(LBij:,:)
338 real(r8), intent (in) :: HnormVobc(LBij:,:)
339# endif
340# ifdef ADJUST_WSTRESS
341 real(r8), intent(in) :: HnormSUS(LBi:,LBj:)
342 real(r8), intent(in) :: HnormSVS(LBi:,LBj:)
343# endif
344# if defined ADJUST_STFLUX && defined SOLVE3D
345 real(r8), intent(in) :: HnormSTF(LBi:,LBj:,:)
346# endif
347# ifdef SOLVE3D
348 real(r8), intent(in) :: VnormR(LBi:,LBj:,:,:,:)
349 real(r8), intent(in) :: VnormU(LBi:,LBj:,:,:)
350 real(r8), intent(in) :: VnormV(LBi:,LBj:,:,:)
351# endif
352 real(r8), intent(in) :: HnormR(LBi:,LBj:,:)
353 real(r8), intent(in) :: HnormU(LBi:,LBj:,:)
354 real(r8), intent(in) :: HnormV(LBi:,LBj:,:)
355# ifdef ADJUST_BOUNDARY
356# ifdef SOLVE3D
357 real(r8), intent(inout) :: ad_t_obc(LBij:,:,:,:,:,:)
358 real(r8), intent(inout) :: ad_u_obc(LBij:,:,:,:,:)
359 real(r8), intent(inout) :: ad_v_obc(LBij:,:,:,:,:)
360# endif
361 real(r8), intent(inout) :: ad_ubar_obc(LBij:,:,:,:)
362 real(r8), intent(inout) :: ad_vbar_obc(LBij:,:,:,:)
363 real(r8), intent(inout) :: ad_zeta_obc(LBij:,:,:,:)
364# endif
365# ifdef ADJUST_WSTRESS
366 real(r8), intent(inout) :: ad_ustr(LBi:,LBj:,:,:)
367 real(r8), intent(inout) :: ad_vstr(LBi:,LBj:,:,:)
368# endif
369# if defined ADJUST_STFLUX && defined SOLVE3D
370 real(r8), intent(inout) :: ad_tflux(LBi:,LBj:,:,:,:)
371# endif
372# ifdef SOLVE3D
373 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
374 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
375 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
376# endif
377 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
378 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
379 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
380# ifdef SOLVE3D
381 real(r8), intent(out) :: Hz(LBi:,LBj:,:)
382 real(r8), intent(out) :: z_r(LBi:,LBj:,:)
383 real(r8), intent(out) :: z_w(LBi:,LBj:,0:)
384# endif
385# else
386 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
387 real(r8), intent(in) :: om_p(LBi:UBi,LBj:UBj)
388 real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj)
389 real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj)
390 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
391 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
392 real(r8), intent(in) :: on_p(LBi:UBi,LBj:UBj)
393 real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj)
394 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
395 real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj)
396 real(r8), intent(in) :: pmon_p(LBi:UBi,LBj:UBj)
397 real(r8), intent(in) :: pmon_r(LBi:UBi,LBj:UBj)
398 real(r8), intent(in) :: pmon_u(LBi:UBi,LBj:UBj)
399 real(r8), intent(in) :: pnom_p(LBi:UBi,LBj:UBj)
400 real(r8), intent(in) :: pnom_r(LBi:UBi,LBj:UBj)
401 real(r8), intent(in) :: pnom_v(LBi:UBi,LBj:UBj)
402# ifdef MASKING
403 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
404 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
405 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
406 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
407# endif
408 real(r8), intent(in) :: Kh(LBi:UBi,LBj:UBj)
409# ifdef SOLVE3D
410 real(r8), intent(in) :: Kv(LBi:UBi,LBj:UBj,0:N(ng))
411# ifdef ICESHELF
412 real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
413# endif
414# if defined SEDIMENT && defined SED_MORPH
415 real(r8), intent(inout):: bed_thick(LBi:UBi,LBj:UBj,3)
416# endif
417 real(r8), intent(inout) :: h(LBi:UBi,LBj:UBj)
418# endif
419# ifdef ADJUST_BOUNDARY
420# ifdef SOLVE3D
421 real(r8), intent (in) :: VnormRobc(LBij:UBij,N(ng),4,NT(ng))
422 real(r8), intent (in) :: VnormUobc(LBij:UBij,N(ng),4)
423 real(r8), intent (in) :: VnormVobc(LBij:UBij,N(ng),4)
424# endif
425 real(r8), intent (in) :: HnormRobc(LBij:UBij,4)
426 real(r8), intent (in) :: HnormUobc(LBij:UBij,4)
427 real(r8), intent (in) :: HnormVobc(LBij:UBij,4)
428# endif
429# ifdef ADJUST_WSTRESS
430 real(r8), intent(in) :: HnormSUS(LBi:UBi,LBj:UBj)
431 real(r8), intent(in) :: HnormSVS(LBi:UBi,LBj:UBj)
432# endif
433# if defined ADJUST_STFLUX && defined SOLVE3D
434 real(r8), intent(in) :: HnormSTF(LBi:UBi,LBj:UBj,NT(ng))
435# endif
436# ifdef SOLVE3D
437 real(r8), intent(in) :: VnormR(LBi:UBi,LBj:UBj,N(ng),NSA,NT(ng))
438 real(r8), intent(in) :: VnormU(LBi:UBi,LBj:UBj,NSA,N(ng))
439 real(r8), intent(in) :: VnormV(LBi:UBi,LBj:UBj,NSA,N(ng))
440# endif
441 real(r8), intent(in) :: HnormR(LBi:UBi,LBj:UBj,NSA)
442 real(r8), intent(in) :: HnormU(LBi:UBi,LBj:UBj,NSA)
443 real(r8), intent(in) :: HnormV(LBi:UBi,LBj:UBj,NSA)
444# ifdef ADJUST_BOUNDARY
445# ifdef SOLVE3D
446 real(r8), intent(inout) :: ad_t_obc(LBij:UBij,N(ng),4, &
447 & Nbrec(ng),2,NT(ng))
448 real(r8), intent(inout) :: ad_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
449 real(r8), intent(inout) :: ad_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
450# endif
451 real(r8), intent(inout) :: ad_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
452 real(r8), intent(inout) :: ad_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
453 real(r8), intent(inout) :: ad_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
454# endif
455# ifdef ADJUST_WSTRESS
456 real(r8), intent(inout) :: ad_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
457 real(r8), intent(inout) :: ad_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
458# endif
459# if defined ADJUST_STFLUX && defined SOLVE3D
460 real(r8), intent(inout) :: ad_tflux(LBi:UBi,LBj:UBj, &
461 & Nfrec(ng),2,NT(ng))
462# endif
463# ifdef SOLVE3D
464 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
465 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
466 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
467# endif
468 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
469 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
470 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
471# ifdef SOLVE3D
472 real(r8), intent(out) :: Hz(LBi:UBi,LBj:UBj,N(ng))
473 real(r8), intent(out) :: z_r(LBi:UBi,LBj:UBj,N(ng))
474 real(r8), intent(out) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
475# endif
476# endif
477!
478! Local variable declarations.
479!
480# ifdef ADJUST_BOUNDARY
481 logical, dimension(4) :: Lconvolve
482# endif
483 integer :: i, ib, ir, is, it, j, k, rec
484 real(r8) :: cff
485# ifdef SOLVE3D
486 real(r8) :: fac
487# endif
488# ifdef SOLVE3D
489 real(r8), dimension(LBi:UBi,LBj:UBj) :: work
490# endif
491!
492# include "set_bounds.h"
493!
494!-----------------------------------------------------------------------
495! Determine error covariance normalization factors to use.
496!-----------------------------------------------------------------------
497!
498 IF (lweak) THEN
499 rec=2 ! weak constraint
500 ELSE
501 rec=1 ! strong constraint
502 END IF
503
504# ifdef ADJUST_BOUNDARY
505!
506! Set switch to convolve boundary segments by the appropriate
507! tiles.
508!
509 lconvolve(iwest )=domain(ng)%Western_Edge (tile)
510 lconvolve(ieast )=domain(ng)%Eastern_Edge (tile)
511 lconvolve(isouth)=domain(ng)%Southern_Edge(tile)
512 lconvolve(inorth)=domain(ng)%Northern_Edge(tile)
513# endif
514
515# ifdef SOLVE3D
516!
517!-----------------------------------------------------------------------
518! Compute time invariant depths (use zero free-surface).
519!-----------------------------------------------------------------------
520!
521 DO i=lbi,ubi
522 DO j=lbj,ubj
523 work(i,j)=0.0_r8
524 END DO
525 END DO
526
527 CALL set_depth_tile (ng, tile, iadm, &
528 & lbi, ubi, lbj, ubj, &
529 & imins, imaxs, jmins, jmaxs, &
530 & nstp, nnew, &
531 & h, &
532# ifdef ICESHELF
533 & zice, &
534# endif
535# if defined SEDIMENT && defined SED_MORPH
536 & bed_thick, &
537# endif
538 & work, &
539 & hz, z_r, z_w)
540# endif
541!
542!-----------------------------------------------------------------------
543! Multiply adjoint state by its corresponding normalization factor.
544!-----------------------------------------------------------------------
545!
546# ifdef DISTRIBUTE
547 CALL ad_mp_exchange2d (ng, tile, iadm, 3, &
548 & lbi, ubi, lbj, ubj, &
549 & nghostpoints, &
550 & ewperiodic(ng), nsperiodic(ng), &
551 & ad_zeta(:,:,linp), &
552 & ad_ubar(:,:,linp), &
553 & ad_vbar(:,:,linp))
554# endif
555!
556! Adjoint free-surface.
557!
558 DO j=jstrt,jendt
559 DO i=istrt,iendt
560 ad_zeta(i,j,linp)=ad_zeta(i,j,linp)*hnormr(i,j,rec)
561 END DO
562 END DO
563!
564! Adjoint 2D momentum.
565!
566 DO j=jstrt,jendt
567 DO i=istrp,iendt
568 ad_ubar(i,j,linp)=ad_ubar(i,j,linp)*hnormu(i,j,rec)
569 END DO
570 END DO
571 DO j=jstrp,jendt
572 DO i=istrt,iendt
573 ad_vbar(i,j,linp)=ad_vbar(i,j,linp)*hnormv(i,j,rec)
574 END DO
575 END DO
576# ifdef SOLVE3D
577!
578! Adjoint 3D momentum.
579!
580# ifdef DISTRIBUTE
581 CALL ad_mp_exchange3d (ng, tile, iadm, 2, &
582 & lbi, ubi, lbj, ubj, 1, n(ng), &
583 & nghostpoints, &
584 & ewperiodic(ng), nsperiodic(ng), &
585 & ad_u(:,:,:,linp), &
586 & ad_v(:,:,:,linp))
587# endif
588 DO k=1,n(ng)
589 DO j=jstrt,jendt
590 DO i=istrp,iendt
591 ad_u(i,j,k,linp)=ad_u(i,j,k,linp)*vnormu(i,j,k,rec)
592 END DO
593 END DO
594 DO j=jstrp,jendt
595 DO i=istrt,iendt
596 ad_v(i,j,k,linp)=ad_v(i,j,k,linp)*vnormv(i,j,k,rec)
597 END DO
598 END DO
599 END DO
600!
601! Adjoint tracers.
602!
603# ifdef DISTRIBUTE
604 CALL ad_mp_exchange4d (ng, tile, iadm, 1, &
605 & lbi, ubi, lbj, ubj, 1, n(ng), 1, nt(ng), &
606 & nghostpoints, &
607 & ewperiodic(ng), nsperiodic(ng), &
608 & ad_t(:,:,:,linp,:))
609# endif
610 DO it=1,nt(ng)
611 DO k=1,n(ng)
612 DO j=jstrt,jendt
613 DO i=istrt,iendt
614 ad_t(i,j,k,linp,it)=ad_t(i,j,k,linp,it)* &
615 & vnormr(i,j,k,rec,it)
616 END DO
617 END DO
618 END DO
619 END DO
620# endif
621
622# ifdef ADJUST_BOUNDARY
623!
624! Adjoint free-surface open boundaries.
625!
626 DO ir=1,nbrec(ng)
627 DO ib=1,4
628 IF (.not.lweak.and.lobc(ib,isfsur,ng)) THEN
629# ifdef DISTRIBUTE
630 CALL ad_mp_exchange2d_bry (ng, tile, iadm, 1, ib, &
631 & lbij, ubij, &
632 & nghostpoints, &
633 & ewperiodic(ng), nsperiodic(ng), &
634 & ad_zeta_obc(:,ib,ir,linp))
635# endif
636 IF (lconvolve(ib)) THEN
637 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
638 DO j=jstrt,jendt
639 ad_zeta_obc(j,ib,ir,linp)=ad_zeta_obc(j,ib,ir,linp)* &
640 & hnormrobc(j,ib)
641 END DO
642 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
643 DO i=istrt,iendt
644 ad_zeta_obc(i,ib,ir,linp)=ad_zeta_obc(i,ib,ir,linp)* &
645 & hnormrobc(i,ib)
646 END DO
647 END IF
648 END IF
649 END IF
650 END DO
651 END DO
652!
653! Tangent linear 2D U-momentum open boundaries.
654!
655 DO ir=1,nbrec(ng)
656 DO ib=1,4
657 IF (.not.lweak.and.lobc(ib,isubar,ng)) THEN
658# ifdef DISTRIBUTE
659 CALL ad_mp_exchange2d_bry (ng, tile, iadm, 1, ib, &
660 & lbij, ubij, &
661 & nghostpoints, &
662 & ewperiodic(ng), nsperiodic(ng), &
663 & ad_ubar_obc(:,ib,ir,linp))
664# endif
665 IF (lconvolve(ib)) THEN
666 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
667 DO j=jstrt,jendt
668 ad_ubar_obc(j,ib,ir,linp)=ad_ubar_obc(j,ib,ir,linp)* &
669 & hnormuobc(j,ib)
670 END DO
671 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
672 DO i=istrp,iendt
673 ad_ubar_obc(i,ib,ir,linp)=ad_ubar_obc(i,ib,ir,linp)* &
674 & hnormuobc(i,ib)
675 END DO
676 END IF
677 END IF
678 END IF
679 END DO
680 END DO
681!
682! Tangent linear 2D V-momentum open boundaries.
683!
684 DO ir=1,nbrec(ng)
685 DO ib=1,4
686 IF (.not.lweak.and.lobc(ib,isvbar,ng)) THEN
687# ifdef DISTRIBUTE
688 CALL ad_mp_exchange2d_bry (ng, tile, iadm, 1, ib, &
689 & lbij, ubij, &
690 & nghostpoints, &
691 & ewperiodic(ng), nsperiodic(ng), &
692 & ad_vbar_obc(:,ib,ir,linp))
693# endif
694 IF (lconvolve(ib)) THEN
695 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
696 DO j=jstrp,jendt
697 ad_vbar_obc(j,ib,ir,linp)=ad_vbar_obc(j,ib,ir,linp)* &
698 & hnormvobc(j,ib)
699 END DO
700 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
701 DO i=istrt,iendt
702 ad_vbar_obc(i,ib,ir,linp)=ad_vbar_obc(i,ib,ir,linp)* &
703 & hnormvobc(i,ib)
704 END DO
705 END IF
706 END IF
707 END IF
708 END DO
709 END DO
710
711# ifdef SOLVE3D
712!
713! Tangent linear 3D U-momentum open boundaries.
714!
715 DO ir=1,nbrec(ng)
716 DO ib=1,4
717 IF (.not.lweak.and.lobc(ib,isuvel,ng)) THEN
718# ifdef DISTRIBUTE
719 CALL ad_mp_exchange3d_bry (ng, tile, iadm, 1, ib, &
720 & lbij, ubij, 1, n(ng), &
721 & nghostpoints, &
722 & ewperiodic(ng), nsperiodic(ng), &
723 & ad_u_obc(:,:,ib,ir,linp))
724# endif
725 IF (lconvolve(ib)) THEN
726 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
727 DO k=1,n(ng)
728 DO j=jstrt,jendt
729 ad_u_obc(j,k,ib,ir,linp)=ad_u_obc(j,k,ib,ir,linp)* &
730 & vnormuobc(j,k,ib)
731 END DO
732 END DO
733 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
734 DO k=1,n(ng)
735 DO i=istrp,iendt
736 ad_u_obc(i,k,ib,ir,linp)=ad_u_obc(i,k,ib,ir,linp)* &
737 & vnormuobc(i,k,ib)
738 END DO
739 END DO
740 END IF
741 END IF
742 END IF
743 END DO
744 END DO
745!
746! Tangent linear 3D V-momentum open boundaries.
747!
748 DO ir=1,nbrec(ng)
749 DO ib=1,4
750 IF (.not.lweak.and.lobc(ib,isvvel,ng)) THEN
751# ifdef DISTRIBUTE
752 CALL ad_mp_exchange3d_bry (ng, tile, iadm, 1, ib, &
753 & lbij, ubij, 1, n(ng), &
754 & nghostpoints, &
755 & ewperiodic(ng), nsperiodic(ng), &
756 & ad_v_obc(:,:,ib,ir,linp))
757# endif
758 IF (lconvolve(ib)) THEN
759 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
760 DO k=1,n(ng)
761 DO j=jstrp,jendt
762 ad_v_obc(j,k,ib,ir,linp)=ad_v_obc(j,k,ib,ir,linp)* &
763 & vnormvobc(j,k,ib)
764 END DO
765 END DO
766 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
767 DO k=1,n(ng)
768 DO i=istrt,iendt
769 ad_v_obc(i,k,ib,ir,linp)=ad_v_obc(i,k,ib,ir,linp)* &
770 & vnormvobc(i,k,ib)
771 END DO
772 END DO
773 END IF
774 END IF
775 END IF
776 END DO
777 END DO
778!
779! Tangent linear tracers open boundaries.
780!
781 DO it=1,nt(ng)
782 DO ir=1,nbrec(ng)
783 DO ib=1,4
784 IF (.not.lweak.and.lobc(ib,istvar(it),ng)) THEN
785# ifdef DISTRIBUTE
786 CALL ad_mp_exchange3d_bry (ng, tile, iadm, 1, ib, &
787 & lbij, ubij, 1, n(ng), &
788 & nghostpoints, &
789 & ewperiodic(ng), nsperiodic(ng),&
790 & ad_t_obc(:,:,ib,ir,linp,it))
791# endif
792 IF (lconvolve(ib)) THEN
793 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
794 DO k=1,n(ng)
795 DO j=jstrt,jendt
796 ad_t_obc(j,k,ib,ir,linp,it)= &
797 & ad_t_obc(j,k,ib,ir,linp,it)* &
798 & vnormrobc(j,k,ib,it)
799 END DO
800 END DO
801 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
802 DO k=1,n(ng)
803 DO i=istrt,iendt
804 ad_t_obc(i,k,ib,ir,linp,it)= &
805 & ad_t_obc(i,k,ib,ir,linp,it)* &
806 & vnormrobc(i,k,ib,it)
807 END DO
808 END DO
809 END IF
810 END IF
811 END IF
812 END DO
813 END DO
814 END DO
815# endif
816# endif
817
818# ifdef ADJUST_WSTRESS
819!
820! Adjoint surface momentum stress.
821!
822 IF (.not.lweak) THEN
823# ifdef DISTRIBUTE
824 CALL ad_mp_exchange3d (ng, tile, iadm, 2, &
825 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
826 & nghostpoints, &
827 & ewperiodic(ng), nsperiodic(ng), &
828 & ad_ustr(:,:,:,linp), &
829 & ad_vstr(:,:,:,linp))
830# endif
831 DO k=1,nfrec(ng)
832 DO j=jstrt,jendt
833 DO i=istrp,iendt
834 ad_ustr(i,j,k,linp)=ad_ustr(i,j,k,linp)*hnormsus(i,j)
835 END DO
836 END DO
837 DO j=jstrp,jendt
838 DO i=istrt,iendt
839 ad_vstr(i,j,k,linp)=ad_vstr(i,j,k,linp)*hnormsvs(i,j)
840 END DO
841 END DO
842 END DO
843 END IF
844# endif
845# ifdef ADJUST_STFLUX
846!
847! Adjoint surface tracers flux.
848!
849 IF (.not.lweak) THEN
850 DO it=1,nt(ng)
851 IF (lstflux(it,ng)) THEN
852# ifdef DISTRIBUTE
853 CALL ad_mp_exchange3d (ng, tile, iadm, 1, &
854 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
855 & nghostpoints, &
856 & ewperiodic(ng), nsperiodic(ng), &
857 & ad_tflux(:,:,:,linp,it))
858# endif
859 DO k=1,nfrec(ng)
860 DO j=jstrt,jendt
861 DO i=istrt,iendt
862 ad_tflux(i,j,k,linp,it)=ad_tflux(i,j,k,linp,it)* &
863 & hnormstf(i,j,it)
864 END DO
865 END DO
866 END DO
867 END IF
868 END DO
869 END IF
870# endif
871!
872!-----------------------------------------------------------------------
873! Initial conditions or model error covariance: Convolve adjoint state
874! vector with a generalized adjoint diffusion equation to filter
875! solution with specified horizontal scales. Convert from model space
876! to minimization space (v-space).
877!-----------------------------------------------------------------------
878!
879! Adjoint free-surface.
880!
881 CALL ad_conv_r2d_tile (ng, tile, iadm, &
882 & lbi, ubi, lbj, ubj, &
883 & imins, imaxs, jmins, jmaxs, &
884 & nghostpoints, &
885 & nhsteps(rec,isfsur)/ifac, &
886 & dtsizeh(rec,isfsur), &
887 & kh, &
888 & pm, pn, pmon_u, pnom_v, &
889# ifdef MASKING
890 & rmask, umask, vmask, &
891# endif
892 & ad_zeta(:,:,linp))
893!
894! Adjoint 2D momentum.
895!
896 CALL ad_conv_u2d_tile (ng, tile, iadm, &
897 & lbi, ubi, lbj, ubj, &
898 & imins, imaxs, jmins, jmaxs, &
899 & nghostpoints, &
900 & nhsteps(rec,isubar)/ifac, &
901 & dtsizeh(rec,isubar), &
902 & kh, &
903 & pm, pn, pmon_r, pnom_p, &
904# ifdef MASKING
905 & umask, pmask, &
906# endif
907 & ad_ubar(:,:,linp))
908
909 CALL ad_conv_v2d_tile (ng, tile, iadm, &
910 & lbi, ubi, lbj, ubj, &
911 & imins, imaxs, jmins, jmaxs, &
912 & nghostpoints, &
913 & nhsteps(rec,isvbar)/ifac, &
914 & dtsizeh(rec,isvbar), &
915 & kh, &
916 & pm, pn, pmon_p, pnom_r, &
917# ifdef MASKING
918 & vmask, pmask, &
919# endif
920 & ad_vbar(:,:,linp))
921# ifdef SOLVE3D
922!
923! Adjoint 3D momentum.
924!
925 CALL ad_conv_u3d_tile (ng, tile, iadm, &
926 & lbi, ubi, lbj, ubj, 1, n(ng), &
927 & imins, imaxs, jmins, jmaxs, &
928 & nghostpoints, &
929 & nhsteps(rec,isuvel)/ifac, &
930 & nvsteps(rec,isuvel)/ifac, &
931 & dtsizeh(rec,isuvel), &
932 & dtsizev(rec,isuvel), &
933 & kh, kv, &
934 & pm, pn, &
935# ifdef GEOPOTENTIAL_HCONV
936 & on_r, om_p, &
937# else
938 & pmon_r, pnom_p, &
939# endif
940# ifdef MASKING
941# ifdef GEOPOTENTIAL_HCONV
942 & pmask, rmask, umask, vmask, &
943# else
944 & umask, pmask, &
945# endif
946# endif
947 & hz, z_r, &
948 & ad_u(:,:,:,linp))
949
950 CALL ad_conv_v3d_tile (ng, tile, iadm, &
951 & lbi, ubi, lbj, ubj, 1, n(ng), &
952 & imins, imaxs, jmins, jmaxs, &
953 & nghostpoints, &
954 & nhsteps(rec,isuvel)/ifac, &
955 & nvsteps(rec,isuvel)/ifac, &
956 & dtsizeh(rec,isuvel), &
957 & dtsizev(rec,isuvel), &
958 & kh, kv, &
959 & pm, pn, &
960# ifdef GEOPOTENTIAL_HCONV
961 & on_p, om_r, &
962# else
963 & pmon_p, pnom_r, &
964# endif
965# ifdef MASKING
966# ifdef GEOPOTENTIAL_HCONV
967 & pmask, rmask, umask, vmask, &
968# else
969 & vmask, pmask, &
970# endif
971# endif
972 & hz, z_r, &
973 & ad_v(:,:,:,linp))
974!
975! Adjoint tracers.
976!
977 DO it=1,nt(ng)
978 is=istvar(it)
979 CALL ad_conv_r3d_tile (ng, tile, iadm, &
980 & lbi, ubi, lbj, ubj, 1, n(ng), &
981 & imins, imaxs, jmins, jmaxs, &
982 & nghostpoints, &
983 & nhsteps(rec,is)/ifac, &
984 & nvsteps(rec,is)/ifac, &
985 & dtsizeh(rec,is), &
986 & dtsizev(rec,is), &
987 & kh, kv, &
988 & pm, pn, &
989# ifdef GEOPOTENTIAL_HCONV
990 & on_u, om_v, &
991# else
992 & pmon_u, pnom_v, &
993# endif
994# ifdef MASKING
995 & rmask, umask, vmask, &
996# endif
997 & hz, z_r, &
998 & ad_t(:,:,:,linp,it))
999 END DO
1000# endif
1001
1002# ifdef ADJUST_BOUNDARY
1003!
1004!-----------------------------------------------------------------------
1005! Open boundaries error convariance: Convolve adjoint state boundary
1006! edges with a generalized adjoint diffusion equation to filter
1007! solution with specified horizontal scales. Convert from model space
1008! to minimization space (v-space).
1009!-----------------------------------------------------------------------
1010!
1011! Adjoint free-surface open boundaries.
1012!
1013 DO ir=1,nbrec(ng)
1014 DO ib=1,4
1015 IF (.not.lweak.and.lobc(ib,isfsur,ng)) THEN
1016 CALL ad_conv_r2d_bry_tile (ng, tile, iadm, ib, &
1017 & bounds(ng)%edge(:,r2dvar), &
1018 & lbij, ubij, &
1019 & lbi, ubi, lbj, ubj, &
1020 & imins, imaxs, jmins, jmaxs, &
1021 & nghostpoints, &
1022 & nhstepsb(ib,isfsur)/ifac, &
1023 & dtsizehb(ib,isfsur), &
1024 & kh, &
1025 & pm, pn, pmon_u, pnom_v, &
1026# ifdef MASKING
1027 & rmask, umask, vmask, &
1028# endif
1029 & ad_zeta_obc(:,ib,ir,linp))
1030 END IF
1031 END DO
1032 END DO
1033!
1034! Tangent linear 2D U-momentum open boundaries.
1035!
1036 DO ir=1,nbrec(ng)
1037 DO ib=1,4
1038 IF (.not.lweak.and.lobc(ib,isubar,ng)) THEN
1039 CALL ad_conv_u2d_bry_tile (ng, tile, iadm, ib, &
1040 & bounds(ng)%edge(:,u2dvar), &
1041 & lbij, ubij, &
1042 & lbi, ubi, lbj, ubj, &
1043 & imins, imaxs, jmins, jmaxs, &
1044 & nghostpoints, &
1045 & nhstepsb(ib,isubar)/ifac, &
1046 & dtsizehb(ib,isubar), &
1047 & kh, &
1048 & pm, pn, pmon_r, pnom_p, &
1049# ifdef MASKING
1050 & umask, pmask, &
1051# endif
1052 & ad_ubar_obc(:,ib,ir,linp))
1053 END IF
1054 END DO
1055 END DO
1056!
1057! Tangent linear 2D V-momentum open boundaries.
1058!
1059 DO ir=1,nbrec(ng)
1060 DO ib=1,4
1061 IF (.not.lweak.and.lobc(ib,isvbar,ng)) THEN
1062 CALL ad_conv_v2d_bry_tile (ng, tile, iadm, ib, &
1063 & bounds(ng)%edge(:,v2dvar), &
1064 & lbij, ubij, &
1065 & lbi, ubi, lbj, ubj, &
1066 & imins, imaxs, jmins, jmaxs, &
1067 & nghostpoints, &
1068 & nhstepsb(ib,isvbar)/ifac, &
1069 & dtsizehb(ib,isvbar), &
1070 & kh, &
1071 & pm, pn, pmon_p, pnom_r, &
1072# ifdef MASKING
1073 & vmask, pmask, &
1074# endif
1075 & ad_vbar_obc(:,ib,ir,linp))
1076 END IF
1077 END DO
1078 END DO
1079
1080# ifdef SOLVE3D
1081!
1082! Tangent linear 3D U-momentum open boundaries.
1083!
1084 DO ir=1,nbrec(ng)
1085 DO ib=1,4
1086 IF (.not.lweak.and.lobc(ib,isuvel,ng)) THEN
1087 CALL ad_conv_u3d_bry_tile (ng, tile, iadm, ib, &
1088 & bounds(ng)%edge(:,u2dvar), &
1089 & lbij, ubij, &
1090 & lbi, ubi, lbj, ubj, 1, n(ng), &
1091 & imins, imaxs, jmins, jmaxs, &
1092 & nghostpoints, &
1093 & nhstepsb(ib,isuvel)/ifac, &
1094 & nvstepsb(ib,isuvel)/ifac, &
1095 & dtsizehb(ib,isuvel), &
1096 & dtsizevb(ib,isuvel), &
1097 & kh, kv, &
1098 & pm, pn, pmon_r, pnom_p, &
1099# ifdef MASKING
1100 & umask, pmask, &
1101# endif
1102 & hz, z_r, &
1103 & ad_u_obc(:,:,ib,ir,linp))
1104 END IF
1105 END DO
1106 END DO
1107!
1108! Tangent linear 3D V-momentum open boundaries.
1109!
1110 DO ir=1,nbrec(ng)
1111 DO ib=1,4
1112 IF (.not.lweak.and.lobc(ib,isvvel,ng)) THEN
1113 CALL ad_conv_v3d_bry_tile (ng, tile, iadm, ib, &
1114 & bounds(ng)%edge(:,v2dvar), &
1115 & lbij, ubij, &
1116 & lbi, ubi, lbj, ubj, 1, n(ng), &
1117 & imins, imaxs, jmins, jmaxs, &
1118 & nghostpoints, &
1119 & nhstepsb(ib,isvvel)/ifac, &
1120 & nvstepsb(ib,isvvel)/ifac, &
1121 & dtsizehb(ib,isvvel), &
1122 & dtsizevb(ib,isvvel), &
1123 & kh, kv, &
1124 & pm, pn, pmon_p, pnom_r, &
1125# ifdef MASKING
1126 & vmask, pmask, &
1127# endif
1128 & hz, z_r, &
1129 & ad_v_obc(:,:,ib,ir,linp))
1130 END IF
1131 END DO
1132 END DO
1133!
1134! Tangent linear tracers open boundaries.
1135!
1136 DO it=1,nt(ng)
1137 is=istvar(it)
1138 DO ir=1,nbrec(ng)
1139 DO ib=1,4
1140 IF (.not.lweak.and.lobc(ib,is,ng)) THEN
1141 CALL ad_conv_r3d_bry_tile (ng, tile, iadm, ib, &
1142 & bounds(ng)%edge(:,r2dvar), &
1143 & lbij, ubij, &
1144 & lbi, ubi, lbj, ubj, 1, n(ng), &
1145 & imins, imaxs, jmins, jmaxs, &
1146 & nghostpoints, &
1147 & nhstepsb(ib,is)/ifac, &
1148 & nvstepsb(ib,is)/ifac, &
1149 & dtsizehb(ib,is), &
1150 & dtsizevb(ib,is), &
1151 & kh, kv, &
1152 & pm, pn, pmon_u, pnom_v, &
1153# ifdef MASKING
1154 & rmask, umask, vmask, &
1155# endif
1156 & hz, z_r, &
1157 & ad_t_obc(:,:,ib,ir,linp,it))
1158 END IF
1159 END DO
1160 END DO
1161 END DO
1162# endif
1163# endif
1164
1165# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1166!
1167!-----------------------------------------------------------------------
1168! Surface forcing error covariance: Convolve adjoint state vector with
1169! a generalized adjoint diffusion equation to filter solution with
1170! specified horizontal scales. Convert from model spaceto minimization
1171! space (v-space).
1172!-----------------------------------------------------------------------
1173
1174# ifdef ADJUST_WSTRESS
1175!
1176! Adjoint surface momentum stress.
1177!
1178 IF (.not.lweak) THEN
1179 DO k=1,nfrec(ng)
1180 CALL ad_conv_u2d_tile (ng, tile, iadm, &
1181 & lbi, ubi, lbj, ubj, &
1182 & imins, imaxs, jmins, jmaxs, &
1183 & nghostpoints, &
1184 & nhsteps(rec,isustr)/ifac, &
1185 & dtsizeh(rec,isustr), &
1186 & kh, &
1187 & pm, pn, pmon_r, pnom_p, &
1188# ifdef MASKING
1189 & umask, pmask, &
1190# endif
1191 & ad_ustr(:,:,k,linp))
1192
1193 CALL ad_conv_v2d_tile (ng, tile, iadm, &
1194 & lbi, ubi, lbj, ubj, &
1195 & imins, imaxs, jmins, jmaxs, &
1196 & nghostpoints, &
1197 & nhsteps(rec,isvstr)/ifac, &
1198 & dtsizeh(rec,isvstr), &
1199 & kh, &
1200 & pm, pn, pmon_p, pnom_r, &
1201# ifdef MASKING
1202 & vmask, pmask, &
1203# endif
1204 & ad_vstr(:,:,k,linp))
1205 END DO
1206 END IF
1207# endif
1208# if defined ADJUST_STFLUX && defined SOLVE3D
1209!
1210! Adjoint surface tracers flux.
1211!
1212 IF (.not.lweak) THEN
1213 DO it=1,nt(ng)
1214 IF (lstflux(it,ng)) THEN
1215 is=istsur(it)
1216 DO k=1,nfrec(ng)
1217 CALL ad_conv_r2d_tile (ng, tile, iadm, &
1218 & lbi, ubi, lbj, ubj, &
1219 & imins, imaxs, jmins, jmaxs, &
1220 & nghostpoints, &
1221 & nhsteps(rec,is)/ifac, &
1222 & dtsizeh(rec,is), &
1223 & kh, &
1224 & pm, pn, pmon_u, pnom_v, &
1225# ifdef MASKING
1226 & rmask, umask, vmask, &
1227# endif
1228 & ad_tflux(:,:,k,linp,it))
1229 END DO
1230 END IF
1231 END DO
1232 END IF
1233# endif
1234# endif
1235!
1236!-----------------------------------------------------------------------
1237! Multiply convolved adjoint state by the inverse squared root of its
1238! associated area (2D) or volume (3D).
1239!-----------------------------------------------------------------------
1240!
1241! Adjoint free-surface.
1242!
1243# ifdef DISTRIBUTE
1244 CALL ad_mp_exchange2d (ng, tile, iadm, 3, &
1245 & lbi, ubi, lbj, ubj, &
1246 & nghostpoints, &
1247 & ewperiodic(ng), nsperiodic(ng), &
1248 & ad_zeta(:,:,linp), &
1249 & ad_ubar(:,:,linp), &
1250 & ad_vbar(:,:,linp))
1251# endif
1252 DO j=jstrt,jendt
1253 DO i=istrt,iendt
1254 ad_zeta(i,j,linp)=ad_zeta(i,j,linp)/ &
1255 & sqrt(om_r(i,j)*on_r(i,j))
1256 END DO
1257 END DO
1258!
1259! Adjoint 2D momentum.
1260!
1261 DO j=jstrt,jendt
1262 DO i=istrp,iendt
1263 ad_ubar(i,j,linp)=ad_ubar(i,j,linp)/ &
1264 & sqrt(om_u(i,j)*on_u(i,j))
1265 END DO
1266 END DO
1267 DO j=jstrp,jendt
1268 DO i=istrt,iendt
1269 ad_vbar(i,j,linp)=ad_vbar(i,j,linp)/ &
1270 & sqrt(om_v(i,j)*on_v(i,j))
1271 END DO
1272 END DO
1273# ifdef SOLVE3D
1274!
1275! Adjoint 3D momentum.
1276!
1277# ifdef DISTRIBUTE
1278 CALL ad_mp_exchange3d (ng, tile, iadm, 2, &
1279 & lbi, ubi, lbj, ubj, 1, n(ng), &
1280 & nghostpoints, &
1281 & ewperiodic(ng), nsperiodic(ng), &
1282 & ad_u(:,:,:,linp), &
1283 & ad_v(:,:,:,linp))
1284# endif
1285 DO j=jstrt,jendt
1286 DO i=istrp,iendt
1287 cff=om_u(i,j)*on_u(i,j)*0.5_r8
1288 DO k=1,n(ng)
1289 ad_u(i,j,k,linp)=ad_u(i,j,k,linp)/ &
1290 & sqrt(cff*(hz(i-1,j,k)+hz(i,j,k)))
1291 END DO
1292 END DO
1293 END DO
1294 DO j=jstrp,jendt
1295 DO i=istrt,iendt
1296 cff=om_v(i,j)*on_v(i,j)*0.5_r8
1297 DO k=1,n(ng)
1298 ad_v(i,j,k,linp)=ad_v(i,j,k,linp)/ &
1299 & sqrt(cff*(hz(i,j-1,k)+hz(i,j,k)))
1300 END DO
1301 END DO
1302 END DO
1303!
1304! Adjoint tracers.
1305!
1306# ifdef DISTRIBUTE
1307 CALL ad_mp_exchange4d (ng, tile, iadm, 1, &
1308 & lbi, ubi, lbj, ubj, 1, n(ng), 1, nt(ng), &
1309 & nghostpoints, &
1310 & ewperiodic(ng), nsperiodic(ng), &
1311 & ad_t(:,:,:,linp,:))
1312# endif
1313 DO j=jstrt,jendt
1314 DO i=istrt,iendt
1315 cff=om_r(i,j)*on_r(i,j)
1316 DO k=1,n(ng)
1317 fac=1.0_r8/sqrt(cff*hz(i,j,k))
1318 DO it=1,nt(ng)
1319 ad_t(i,j,k,linp,it)=fac*ad_t(i,j,k,linp,it)
1320 END DO
1321 END DO
1322 END DO
1323 END DO
1324# endif
1325
1326# ifdef ADJUST_BOUNDARY
1327!
1328! Adjoint free-surface open boundaries.
1329!
1330 DO ir=1,nbrec(ng)
1331 DO ib=1,4
1332 IF (.not.lweak.and.lobc(ib,isfsur,ng)) THEN
1333# ifdef DISTRIBUTE
1334 CALL ad_mp_exchange2d_bry (ng, tile, iadm, 1, ib, &
1335 & lbij, ubij, &
1336 & nghostpoints, &
1337 & ewperiodic(ng), nsperiodic(ng), &
1338 & ad_zeta_obc(:,ib,ir,linp))
1339# endif
1340 IF (lconvolve(ib)) THEN
1341 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
1342 i=bounds(ng)%edge(ib,r2dvar)
1343 DO j=jstrt,jendt
1344 ad_zeta_obc(j,ib,ir,linp)=ad_zeta_obc(j,ib,ir,linp)/ &
1345 & sqrt(on_r(i,j))
1346 END DO
1347 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
1348 j=bounds(ng)%edge(ib,r2dvar)
1349 DO i=istrt,iendt
1350 ad_zeta_obc(i,ib,ir,linp)=ad_zeta_obc(i,ib,ir,linp)/ &
1351 & sqrt(om_r(i,j))
1352 END DO
1353 END IF
1354 END IF
1355 END IF
1356 END DO
1357 END DO
1358!
1359! Tangent linear 2D U-momentum open boundaries.
1360!
1361 DO ir=1,nbrec(ng)
1362 DO ib=1,4
1363 IF (.not.lweak.and.lobc(ib,isubar,ng)) THEN
1364# ifdef DISTRIBUTE
1365 CALL ad_mp_exchange2d_bry (ng, tile, iadm, 1, ib, &
1366 & lbij, ubij, &
1367 & nghostpoints, &
1368 & ewperiodic(ng), nsperiodic(ng), &
1369 & ad_ubar_obc(:,ib,ir,linp))
1370# endif
1371 IF (lconvolve(ib)) THEN
1372 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
1373 i=bounds(ng)%edge(ib,u2dvar)
1374 DO j=jstrt,jendt
1375 ad_ubar_obc(j,ib,ir,linp)=ad_ubar_obc(j,ib,ir,linp)/ &
1376 & sqrt(on_u(i,j))
1377 END DO
1378 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
1379 j=bounds(ng)%edge(ib,u2dvar)
1380 DO i=istrp,iendt
1381 ad_ubar_obc(i,ib,ir,linp)=ad_ubar_obc(i,ib,ir,linp)/ &
1382 & sqrt(om_u(i,j))
1383 END DO
1384 END IF
1385 END IF
1386 END IF
1387 END DO
1388 END DO
1389!
1390! Tangent linear 2D V-momentum open boundaries.
1391!
1392 DO ir=1,nbrec(ng)
1393 DO ib=1,4
1394 IF (.not.lweak.and.lobc(ib,isvbar,ng)) THEN
1395# ifdef DISTRIBUTE
1396 CALL ad_mp_exchange2d_bry (ng, tile, iadm, 1, ib, &
1397 & lbij, ubij, &
1398 & nghostpoints, &
1399 & ewperiodic(ng), nsperiodic(ng), &
1400 & ad_vbar_obc(:,ib,ir,linp))
1401# endif
1402 IF (lconvolve(ib)) THEN
1403 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
1404 i=bounds(ng)%edge(ib,v2dvar)
1405 DO j=jstrp,jendt
1406 ad_vbar_obc(j,ib,ir,linp)=ad_vbar_obc(j,ib,ir,linp)/ &
1407 & sqrt(on_v(i,j))
1408 END DO
1409 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
1410 j=bounds(ng)%edge(ib,v2dvar)
1411 DO i=istrt,iendt
1412 ad_vbar_obc(i,ib,ir,linp)=ad_vbar_obc(i,ib,ir,linp)/ &
1413 & sqrt(om_v(i,j))
1414 END DO
1415 END IF
1416 END IF
1417 END IF
1418 END DO
1419 END DO
1420
1421# ifdef SOLVE3D
1422!
1423! Tangent linear 3D U-momentum open boundaries.
1424!
1425 DO ir=1,nbrec(ng)
1426 DO ib=1,4
1427 IF (.not.lweak.and.lobc(ib,isuvel,ng)) THEN
1428# ifdef DISTRIBUTE
1429 CALL ad_mp_exchange3d_bry (ng, tile, iadm, 1, ib, &
1430 & lbij, ubij, 1, n(ng), &
1431 & nghostpoints, &
1432 & ewperiodic(ng), nsperiodic(ng), &
1433 & ad_u_obc(:,:,ib,ir,linp))
1434# endif
1435 IF (lconvolve(ib)) THEN
1436 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
1437 i=bounds(ng)%edge(ib,u2dvar)
1438 DO j=jstrt,jendt
1439 cff=on_u(i,j)*0.5_r8
1440 DO k=1,n(ng)
1441 ad_u_obc(j,k,ib,ir,linp)=ad_u_obc(j,k,ib,ir,linp)/ &
1442 & sqrt(cff* &
1443 & (hz(i-1,j,k)+ &
1444 & hz(i ,j,k)))
1445 END DO
1446 END DO
1447 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
1448 j=bounds(ng)%edge(ib,u2dvar)
1449 DO i=istrp,iendt
1450 cff=om_u(i,j)*0.5_r8
1451 DO k=1,n(ng)
1452 ad_u_obc(i,k,ib,ir,linp)=ad_u_obc(i,k,ib,ir,linp)/ &
1453 & sqrt(cff* &
1454 & (hz(i-1,j,k)+ &
1455 & hz(i ,j,k)))
1456 END DO
1457 END DO
1458 END IF
1459 END IF
1460 END IF
1461 END DO
1462 END DO
1463!
1464! Tangent linear 3D V-momentum open boundaries.
1465!
1466 DO ir=1,nbrec(ng)
1467 DO ib=1,4
1468 IF (.not.lweak.and.lobc(ib,isvvel,ng)) THEN
1469# ifdef DISTRIBUTE
1470 CALL ad_mp_exchange3d_bry (ng, tile, iadm, 1, ib, &
1471 & lbij, ubij, 1, n(ng), &
1472 & nghostpoints, &
1473 & ewperiodic(ng), nsperiodic(ng), &
1474 & ad_v_obc(:,:,ib,ir,linp))
1475# endif
1476 IF (lconvolve(ib)) THEN
1477 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
1478 i=bounds(ng)%edge(ib,v2dvar)
1479 DO j=jstrp,jendt
1480 cff=on_v(i,j)*0.5_r8
1481 DO k=1,n(ng)
1482 ad_v_obc(j,k,ib,ir,linp)=ad_v_obc(j,k,ib,ir,linp)/ &
1483 & sqrt(cff* &
1484 & (hz(i,j-1,k)+ &
1485 & hz(i,j ,k)))
1486 END DO
1487 END DO
1488 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
1489 j=bounds(ng)%edge(ib,v2dvar)
1490 DO i=istrt,iendt
1491 cff=om_v(i,j)*0.5_r8
1492 DO k=1,n(ng)
1493 ad_v_obc(i,k,ib,ir,linp)=ad_v_obc(i,k,ib,ir,linp)/ &
1494 & sqrt(cff* &
1495 & (hz(i,j-1,k)+ &
1496 & hz(i,j ,k)))
1497 END DO
1498 END DO
1499 END IF
1500 END IF
1501 END IF
1502 END DO
1503 END DO
1504!
1505! Tangent linear tracers open boundaries.
1506!
1507 DO it=1,nt(ng)
1508 DO ir=1,nbrec(ng)
1509 DO ib=1,4
1510 IF (.not.lweak.and.lobc(ib,istvar(it),ng)) THEN
1511# ifdef DISTRIBUTE
1512 CALL ad_mp_exchange3d_bry (ng, tile, iadm, 1, ib, &
1513 & lbij, ubij, 1, n(ng), &
1514 & nghostpoints, &
1515 & ewperiodic(ng), nsperiodic(ng),&
1516 & ad_t_obc(:,:,ib,ir,linp,it))
1517# endif
1518 IF (lconvolve(ib)) THEN
1519 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
1520 i=bounds(ng)%edge(ib,r2dvar)
1521 DO j=jstrt,jendt
1522 cff=on_r(i,j)
1523 DO k=1,n(ng)
1524 ad_t_obc(j,k,ib,ir,linp,it)= &
1525 & ad_t_obc(j,k,ib,ir,linp,it)/ &
1526 & sqrt(cff*hz(i,j,k))
1527 END DO
1528 END DO
1529 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
1530 j=bounds(ng)%edge(ib,r2dvar)
1531 DO i=istrt,iendt
1532 cff=om_r(i,j)
1533 DO k=1,n(ng)
1534 ad_t_obc(i,k,ib,ir,linp,it)= &
1535 & ad_t_obc(i,k,ib,ir,linp,it)/ &
1536 & sqrt(cff*hz(i,j,k))
1537 END DO
1538 END DO
1539 END IF
1540 END IF
1541 END IF
1542 END DO
1543 END DO
1544 END DO
1545# endif
1546# endif
1547
1548# ifdef ADJUST_WSTRESS
1549!
1550! Adjoint surface momentum stress.
1551!
1552 IF (.not.lweak) THEN
1553# ifdef DISTRIBUTE
1554 CALL ad_mp_exchange3d (ng, tile, iadm, 2, &
1555 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
1556 & nghostpoints, &
1557 & ewperiodic(ng), nsperiodic(ng), &
1558 & ad_ustr(:,:,:,linp), &
1559 & ad_vstr(:,:,:,linp))
1560# endif
1561 DO k=1,nfrec(ng)
1562 DO j=jstrt,jendt
1563 DO i=istrp,iendt
1564 ad_ustr(i,j,k,linp)=ad_ustr(i,j,k,linp)/ &
1565 & sqrt(om_u(i,j)*on_u(i,j))
1566 END DO
1567 END DO
1568 DO j=jstrp,jendt
1569 DO i=istrt,iendt
1570 ad_vstr(i,j,k,linp)=ad_vstr(i,j,k,linp)/ &
1571 & sqrt(om_v(i,j)*on_v(i,j))
1572 END DO
1573 END DO
1574 END DO
1575 END IF
1576# endif
1577
1578# if defined ADJUST_STFLUX && defined SOLVE3D
1579!
1580! Adjoint surface tracers flux.
1581!
1582 IF (.not.lweak) THEN
1583# ifdef DISTRIBUTE
1584 DO it=1,nt(ng)
1585 IF (lstflux(it,ng)) THEN
1586 CALL ad_mp_exchange3d (ng, tile, iadm, 1, &
1587 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
1588 & nghostpoints, &
1589 & ewperiodic(ng), nsperiodic(ng), &
1590 & ad_tflux(:,:,:,linp,it))
1591 END IF
1592 END DO
1593# endif
1594 DO j=jstrt,jendt
1595 DO i=istrt,iendt
1596 fac=1.0_r8/sqrt(om_r(i,j)*on_r(i,j))
1597 DO it=1,nt(ng)
1598 IF (lstflux(it,ng)) THEN
1599 DO k=1,nfrec(ng)
1600 ad_tflux(i,j,k,linp,it)=fac*ad_tflux(i,j,k,linp,it)
1601 END DO
1602 END IF
1603 END DO
1604 END DO
1605 END DO
1606 END IF
1607# endif
1608
1609 RETURN
1610 END SUBROUTINE ad_convolution_tile
1611#endif
1612 END MODULE ad_convolution_mod
ad_conv_2d_mod
Definition ad_conv_2d.F:3
ad_conv_2d_mod::ad_conv_u2d_tile
subroutine ad_conv_u2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_r, pnom_p, umask, pmask, ad_a)
Definition ad_conv_2d.F:323
ad_conv_2d_mod::ad_conv_r2d_tile
subroutine ad_conv_r2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_u, pnom_v, rmask, umask, vmask, ad_a)
Definition ad_conv_2d.F:70
ad_conv_2d_mod::ad_conv_v2d_tile
subroutine ad_conv_v2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_p, pnom_r, vmask, pmask, ad_a)
Definition ad_conv_2d.F:573
ad_conv_3d_mod
Definition ad_conv_3d.F:3
ad_conv_3d_mod::ad_conv_v3d_tile
subroutine ad_conv_v3d_tile(ng, tile, model, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, on_p, om_r, pmask, rmask, umask, vmask, hz, z_r, ad_a)
Definition ad_conv_3d.F:2014
ad_conv_3d_mod::ad_conv_u3d_tile
subroutine ad_conv_u3d_tile(ng, tile, model, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, on_r, om_p, pmask, rmask, umask, vmask, hz, z_r, ad_a)
Definition ad_conv_3d.F:1027
ad_conv_3d_mod::ad_conv_r3d_tile
subroutine ad_conv_r3d_tile(ng, tile, model, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, on_u, om_v, rmask, umask, vmask, hz, z_r, ad_a)
Definition ad_conv_3d.F:85
ad_conv_bry2d_mod
Definition ad_conv_bry2d.F:2
ad_conv_bry2d_mod::ad_conv_v2d_bry_tile
subroutine ad_conv_v2d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_p, pnom_r, vmask, pmask, ad_a)
Definition ad_conv_bry2d.F:691
ad_conv_bry2d_mod::ad_conv_u2d_bry_tile
subroutine ad_conv_u2d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_r, pnom_p, umask, pmask, ad_a)
Definition ad_conv_bry2d.F:384
ad_conv_bry2d_mod::ad_conv_r2d_bry_tile
subroutine ad_conv_r2d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_u, pnom_v, rmask, umask, vmask, ad_a)
Definition ad_conv_bry2d.F:74
ad_conv_bry3d_mod
Definition ad_conv_bry3d.F:2
ad_conv_bry3d_mod::ad_conv_r3d_bry_tile
subroutine ad_conv_r3d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, pmon_u, pnom_v, rmask, umask, vmask, hz, z_r, ad_a)
Definition ad_conv_bry3d.F:82
ad_conv_bry3d_mod::ad_conv_u3d_bry_tile
subroutine ad_conv_u3d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, pmon_r, pnom_p, umask, pmask, hz, z_r, ad_a)
Definition ad_conv_bry3d.F:1001
ad_conv_bry3d_mod::ad_conv_v3d_bry_tile
subroutine ad_conv_v3d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, pmon_p, pnom_r, vmask, pmask, hz, z_r, ad_a)
Definition ad_conv_bry3d.F:1928
ad_convolution_mod
Definition ad_convolution.F:2
ad_convolution_mod::ad_convolution
subroutine, public ad_convolution(ng, tile, linp, lweak, ifac)
Definition ad_convolution.F:84
ad_convolution_mod::ad_convolution_tile
subroutine ad_convolution_tile(ng, tile, lbi, ubi, lbj, ubj, lbij, ubij, imins, imaxs, jmins, jmaxs, nstp, nnew, linp, lweak, ifac, pm, om_p, om_r, om_u, om_v, pn, on_p, on_r, on_u, on_v, pmon_p, pmon_r, pmon_u, pnom_p, pnom_r, pnom_v, rmask, pmask, umask, vmask, h, zice, bed_thick, hz, z_r, z_w, kh, kv, vnormrobc, vnormuobc, vnormvobc, hnormrobc, hnormuobc, hnormvobc, hnormsus, hnormsvs, hnormstf, vnormr, vnormu, vnormv, hnormr, hnormu, hnormv, ad_t_obc, ad_u_obc, ad_v_obc, ad_ubar_obc, ad_vbar_obc, ad_zeta_obc, ad_ustr, ad_vstr, ad_tflux, ad_t, ad_u, ad_v, ad_ubar, ad_vbar, ad_zeta)
Definition ad_convolution.F:265
mod_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_fourdvar
Definition mod_fourdvar.F:2
mod_fourdvar::nhsteps
integer, dimension(:,:), allocatable nhsteps
Definition mod_fourdvar.F:609
mod_fourdvar::nvsteps
integer, dimension(:,:), allocatable nvsteps
Definition mod_fourdvar.F:610
mod_fourdvar::dtsizehb
real(r8), dimension(:,:), allocatable dtsizehb
Definition mod_fourdvar.F:628
mod_fourdvar::dtsizeh
real(r8), dimension(:,:), allocatable dtsizeh
Definition mod_fourdvar.F:622
mod_fourdvar::nvstepsb
integer, dimension(:,:), allocatable nvstepsb
Definition mod_fourdvar.F:616
mod_fourdvar::dtsizevb
real(r8), dimension(:,:), allocatable dtsizevb
Definition mod_fourdvar.F:629
mod_fourdvar::dtsizev
real(r8), dimension(:,:), allocatable dtsizev
Definition mod_fourdvar.F:623
mod_fourdvar::nhstepsb
integer, dimension(:,:), allocatable nhstepsb
Definition mod_fourdvar.F:615
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_kinds
Definition mod_kinds.F:2
mod_mixing
Definition mod_mixing.F:2
mod_mixing::mixing
type(t_mixing), dimension(:), allocatable mixing
Definition mod_mixing.F:399
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::isvvel
integer isvvel
Definition mod_ncparam.F:507
mod_ncparam::isvbar
integer isvbar
Definition mod_ncparam.F:505
mod_ncparam::isvstr
integer isvstr
Definition mod_ncparam.F:511
mod_ncparam::istvar
integer, dimension(:), allocatable istvar
Definition mod_ncparam.F:520
mod_ncparam::isuvel
integer isuvel
Definition mod_ncparam.F:506
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_ncparam::isustr
integer isustr
Definition mod_ncparam.F:510
mod_ncparam::isubar
integer isubar
Definition mod_ncparam.F:504
mod_ncparam::istsur
integer, dimension(:), allocatable istsur
Definition mod_ncparam.F:519
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::bounds
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::iadm
integer, parameter iadm
Definition mod_param.F:665
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719
mod_scalars
Definition mod_scalars.F:2
mod_scalars::lobc
logical, dimension(:,:,:), allocatable lobc
Definition mod_scalars.F:1127
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::lstflux
logical, dimension(:,:), allocatable lstflux
Definition mod_scalars.F:1156
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
mod_sedbed
Definition sedbed_mod.h:1
mod_sedbed::sedbed
type(t_sedbed), dimension(:), allocatable sedbed
Definition sedbed_mod.h:157
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::ad_mp_exchange3d
subroutine ad_mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
Definition mp_exchange.F:5451
mp_exchange_mod::ad_mp_exchange4d
subroutine ad_mp_exchange4d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c)
Definition mp_exchange.F:7058
mp_exchange_mod::ad_mp_exchange2d
subroutine ad_mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
Definition mp_exchange.F:4058
mp_exchange_mod::ad_mp_exchange3d_bry
subroutine ad_mp_exchange3d_bry(ng, tile, model, nvar, boundary, lbij, ubij, lbk, ubk, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
Definition mp_exchange.F:6303
mp_exchange_mod::ad_mp_exchange2d_bry
subroutine ad_mp_exchange2d_bry(ng, tile, model, nvar, boundary, lbij, ubij, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
Definition mp_exchange.F:4808
set_depth_mod
Definition set_depth.F:2
set_depth_mod::set_depth_tile
subroutine, public set_depth_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nstp, nnew, h, zice, zt_avg1, hz, z_r, z_w)
Definition set_depth.F:86