ROMS
Loading...
Searching...
No Matches
ad_bc_bry3d.F
Go to the documentation of this file.
1#include "cppdefs.h"
3#ifdef ADJOINT
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This package applies adjoint gradient conditions for generic 3D !
13! boundary fields. !
14! !
15! Routines: !
16! !
17! ad_bc_r3d_bry_tile Boundary conditions for field at RHO-points !
18! ad_bc_u3d_bry_tile Boundary conditions for field at U-points !
19! ad_bc_v3d_bry_tile Boundary conditions for field at V-points !
20! !
21!=======================================================================
22!
23 implicit none
24
25 CONTAINS
26!
27!***********************************************************************
28 SUBROUTINE ad_bc_r3d_bry_tile (ng, tile, boundary, &
29 & LBij, UBij, LBk, UBk, &
30 & ad_A)
31!***********************************************************************
32!
33 USE mod_param
34 USE mod_scalars
35!
36! Imported variable declarations.
37!
38 integer, intent(in) :: ng, tile, boundary
39 integer, intent(in) :: LBij, UBij, LBk, UBk
40
41# ifdef ASSUMED_SHAPE
42 real(r8), intent(inout) :: ad_A(LBij:,LBk:)
43# else
44 real(r8), intent(inout) :: ad_A(LBij:UBij,LBk:UBk)
45# endif
46!
47! Local variable declarations.
48!
49 integer :: k
50
51# include "set_bounds.h"
52!
53!-----------------------------------------------------------------------
54! Adjoint Southern and Northern edges: gradient boundary conditions.
55!-----------------------------------------------------------------------
56!
57 IF (boundary.eq.inorth) THEN
58 IF (domain(ng)%NorthEast_Corner(tile)) THEN
59 DO k=lbk,ubk
60!^ tl_A(Iend+1,k)=tl_A(Iend,k)
61!^
62 ad_a(iend,k)=ad_a(iend,k)+ad_a(iend+1,k)
63 ad_a(iend+1,k)=0.0_r8
64 END DO
65 END IF
66 IF (domain(ng)%NorthWest_Corner(tile)) THEN
67 DO k=lbk,ubk
68!^ tl_A(Istr-1,k)=tl_A(Istr,k)
69!^
70 ad_a(istr,k)=ad_a(istr,k)+ad_a(istr-1,k)
71 ad_a(istr-1,k)=0.0_r8
72 END DO
73 END IF
74 END IF
75
76 IF (boundary.eq.isouth) THEN
77 IF (domain(ng)%SouthEast_Corner(tile)) THEN
78 DO k=lbk,ubk
79!^ tl_A(Iend+1,k)=tl_A(Iend,k)
80!^
81 ad_a(iend,k)=ad_a(iend,k)+ad_a(iend+1,k)
82 ad_a(iend+1,k)=0.0_r8
83 END DO
84 END IF
85 IF (domain(ng)%SouthWest_Corner(tile)) THEN
86 DO k=lbk,ubk
87!^ tl_A(Istr-1,k)=tl_A(Istr,k)
88!^
89 ad_a(istr,k)=ad_a(istr,k)+ad_a(istr-1,k)
90 ad_a(istr-1,k)=0.0_r8
91 END DO
92 END IF
93 END IF
94!
95!-----------------------------------------------------------------------
96! Adjoint Western and Eastern edges: gradient boundary conditions.
97!-----------------------------------------------------------------------
98!
99 IF (boundary.eq.ieast) THEN
100 IF (domain(ng)%NorthEast_Corner(tile)) THEN
101 DO k=lbk,ubk
102!^ tl_A(Jend+1,k)=tl_A(Jend,k)
103!^
104 ad_a(jend,k)=ad_a(jend,k)+ad_a(jend+1,k)
105 ad_a(jend+1,k)=0.0_r8
106 END DO
107 END IF
108 IF (domain(ng)%SouthEast_Corner(tile)) THEN
109 DO k=lbk,ubk
110!^ tl_A(Jstr-1,k)=tl_A(Jstr,k)
111!^
112 ad_a(jstr,k)=ad_a(jstr,k)+ad_a(jstr-1,k)
113 ad_a(jstr-1,k)=0.0_r8
114 END DO
115 END IF
116 END IF
117
118 IF (boundary.eq.iwest) THEN
119 IF (domain(ng)%NorthWest_Corner(tile)) THEN
120 DO k=lbk,ubk
121!^ tl_A(Jend+1,k)=tl_A(Jend,k)
122!^
123 ad_a(jend,k)=ad_a(jend,k)+ad_a(jend+1,k)
124 ad_a(jend+1,k)=0.0_r8
125 END DO
126 END IF
127 IF (domain(ng)%SouthWest_Corner(tile)) THEN
128 DO k=lbk,ubk
129!^ tl_A(Jstr-1,k)=tl_A(Jstr,k)
130!^
131 ad_a(jstr,k)=ad_a(jstr,k)+ad_a(jstr-1,k)
132 ad_a(jstr-1,k)=0.0_r8
133 END DO
134 END IF
135 END IF
136
137 RETURN
138 END SUBROUTINE ad_bc_r3d_bry_tile
139
140!
141!***********************************************************************
142 SUBROUTINE ad_bc_u3d_bry_tile (ng, tile, boundary, &
143 & LBij, UBij, LBk, UBk, &
144 & ad_A)
145!***********************************************************************
146!
147 USE mod_param
148 USE mod_scalars
149!
150! Imported variable declarations.
151!
152 integer, intent(in) :: ng, tile, boundary
153 integer, intent(in) :: LBij, UBij, LBk, UBk
154
155# ifdef ASSUMED_SHAPE
156 real(r8), intent(inout) :: ad_A(LBij:,LBk:)
157# else
158 real(r8), intent(inout) :: ad_A(LBij:UBij,LBk:UBk)
159# endif
160!
161! Local variable declarations.
162!
163 integer :: k
164
165# include "set_bounds.h"
166!
167!-----------------------------------------------------------------------
168! Adjoint Southern and Northern edges: gradient boundary conditions.
169!-----------------------------------------------------------------------
170!
171 IF (boundary.eq.inorth) THEN
172 IF (domain(ng)%NorthEast_Corner(tile)) THEN
173 DO k=lbk,ubk
174!^ tl_A(Iend+1,k)=tl_A(Iend,k)
175!^
176 ad_a(iend,k)=ad_a(iend,k)+ad_a(iend+1,k)
177 ad_a(iend+1,k)=0.0_r8
178 END DO
179 END IF
180 IF (domain(ng)%NorthWest_Corner(tile)) THEN
181 DO k=lbk,ubk
182!^ tl_A(IstrU-1,k)=tl_A(IstrU,k)
183!^
184 ad_a(istru,k)=ad_a(istru,k)+ad_a(istru-1,k)
185 ad_a(istru-1,k)=0.0_r8
186 END DO
187 END IF
188 END IF
189
190 IF (boundary.eq.isouth) THEN
191 IF (domain(ng)%SouthEast_Corner(tile)) THEN
192 DO k=lbk,ubk
193!^ tl_A(Iend+1,k)=tl_A(Iend,k)
194!^
195 ad_a(iend,k)=ad_a(iend,k)+ad_a(iend+1,k)
196 ad_a(iend+1,k)=0.0_r8
197 END DO
198 END IF
199 IF (domain(ng)%SouthWest_Corner(tile)) THEN
200 DO k=lbk,ubk
201!^ tl_A(IstrU-1,k)=tl_A(IstrU,k)
202!^
203 ad_a(istru,k)=ad_a(istru,k)+ad_a(istru-1,k)
204 ad_a(istru-1,k)=0.0_r8
205 END DO
206 END IF
207 END IF
208!
209!-----------------------------------------------------------------------
210! Adjoint Western and Eastern edges: gradient boundary conditions.
211!-----------------------------------------------------------------------
212!
213 IF (boundary.eq.ieast) THEN
214 IF (domain(ng)%NorthEast_Corner(tile)) THEN
215 DO k=lbk,ubk
216!^ tl_A(Jend+1,k)=tl_A(Jend,k)
217!^
218 ad_a(jend,k)=ad_a(jend,k)+ad_a(jend+1,k)
219 ad_a(jend+1,k)=0.0_r8
220 END DO
221 END IF
222 IF (domain(ng)%SouthEast_Corner(tile)) THEN
223 DO k=lbk,ubk
224!^ tl_A(Jstr-1,k)=tl_A(Jstr,k)
225!^
226 ad_a(jstr,k)=ad_a(jstr,k)+ad_a(jstr-1,k)
227 ad_a(jstr-1,k)=0.0_r8
228 END DO
229 END IF
230 END IF
231
232 IF (boundary.eq.iwest) THEN
233 IF (domain(ng)%NorthWest_Corner(tile)) THEN
234 DO k=lbk,ubk
235!^ tl_A(Jend+1,k)=tl_A(Jend,k)
236!^
237 ad_a(jend,k)=ad_a(jend,k)+ad_a(jend+1,k)
238 ad_a(jend+1,k)=0.0_r8
239 END DO
240 END IF
241 IF (domain(ng)%SouthWest_Corner(tile)) THEN
242 DO k=lbk,ubk
243!^ tl_A(Jstr-1,k)=tl_A(Jstr,k)
244!^
245 ad_a(jstr,k)=ad_a(jstr,k)+ad_a(jstr-1,k)
246 ad_a(jstr-1,k)=0.0_r8
247 END DO
248 END IF
249 END IF
250
251 RETURN
252 END SUBROUTINE ad_bc_u3d_bry_tile
253
254!
255!***********************************************************************
256 SUBROUTINE ad_bc_v3d_bry_tile (ng, tile, boundary, &
257 & LBij, UBij, LBk, UBk, &
258 & ad_A)
259!***********************************************************************
260!
261 USE mod_param
262 USE mod_scalars
263!
264! Imported variable declarations.
265!
266 integer, intent(in) :: ng, tile, boundary
267 integer, intent(in) :: LBij, UBij, LBk, UBk
268
269# ifdef ASSUMED_SHAPE
270 real(r8), intent(inout) :: ad_A(LBij:,LBk:)
271# else
272 real(r8), intent(inout) :: ad_A(LBij:UBij,LBk:UBk)
273# endif
274!
275! Local variable declarations.
276!
277 integer :: k
278
279# include "set_bounds.h"
280!
281!-----------------------------------------------------------------------
282! Adjoint Southern and Northern edges: gradient boundary conditions.
283!-----------------------------------------------------------------------
284!
285 IF (boundary.eq.inorth) THEN
286 IF (domain(ng)%NorthEast_Corner(tile)) THEN
287 DO k=lbk,ubk
288!^ tl_A(Iend+1,k)=tl_A(Iend,k)
289!^
290 ad_a(iend,k)=ad_a(iend,k)+ad_a(iend+1,k)
291 ad_a(iend+1,k)=0.0_r8
292 END DO
293 END IF
294 IF (domain(ng)%NorthWest_Corner(tile)) THEN
295 DO k=lbk,ubk
296!^ tl_A(Istr-1,k)=tl_A(Istr,k)
297!^
298 ad_a(istr,k)=ad_a(istr,k)+ad_a(istr-1,k)
299 ad_a(istr-1,k)=0.0_r8
300 END DO
301 END IF
302 END IF
303
304 IF (boundary.eq.isouth) THEN
305 IF (domain(ng)%SouthEast_Corner(tile)) THEN
306 DO k=lbk,ubk
307!^ tl_A(Iend+1,k)=tl_A(Iend,k)
308!^
309 ad_a(iend,k)=ad_a(iend,k)+ad_a(iend+1,k)
310 ad_a(iend+1,k)=0.0_r8
311 END DO
312 END IF
313 IF (domain(ng)%SouthWest_Corner(tile)) THEN
314 DO k=lbk,ubk
315!^ tl_A(Istr-1,k)=tl_A(Istr,k)
316!^
317 ad_a(istr,k)=ad_a(istr,k)+ad_a(istr-1,k)
318 ad_a(istr-1,k)=0.0_r8
319 END DO
320 END IF
321 END IF
322!
323!-----------------------------------------------------------------------
324! Adjoint Western and Eastern edges: gradient boundary conditions.
325!-----------------------------------------------------------------------
326!
327 IF (boundary.eq.ieast) THEN
328 IF (domain(ng)%NorthEast_Corner(tile)) THEN
329 DO k=lbk,ubk
330!^ tl_A(Jend+1,k)=tl_A(Jend,k)
331!^
332 ad_a(jend,k)=ad_a(jend,k)+ad_a(jend+1,k)
333 ad_a(jend+1,k)=0.0_r8
334 END DO
335 END IF
336 IF (domain(ng)%SouthEast_Corner(tile)) THEN
337 DO k=lbk,ubk
338!^ tl_A(JstrV-1,k)=tl_A(JstrV,k)
339!^
340 ad_a(jstrv,k)=ad_a(jstrv,k)+ad_a(jstrv-1,k)
341 ad_a(jstrv-1,k)=0.0_r8
342 END DO
343 END IF
344 END IF
345
346 IF (boundary.eq.iwest) THEN
347 IF (domain(ng)%NorthWest_Corner(tile)) THEN
348 DO k=lbk,ubk
349!^ tl_A(Jend+1,k)=tl_A(Jend,k)
350!^
351 ad_a(jend,k)=ad_a(jend,k)+ad_a(jend+1,k)
352 ad_a(jend+1,k)=0.0_r8
353 END DO
354 END IF
355 IF (domain(ng)%SouthWest_Corner(tile)) THEN
356 DO k=lbk,ubk
357!^ tl_A(JstrV-1,k)=tl_A(JstrV,k)
358!^
359 ad_a(jstrv,k)=ad_a(jstrv,k)+ad_a(jstrv-1,k)
360 ad_a(jstrv-1,k)=0.0_r8
361 END DO
362 END IF
363 END IF
364
365 RETURN
366 END SUBROUTINE ad_bc_v3d_bry_tile
367#endif
368 END MODULE ad_bc_bry3d_mod
subroutine ad_bc_u3d_bry_tile(ng, tile, boundary, lbij, ubij, lbk, ubk, ad_a)
subroutine ad_bc_v3d_bry_tile(ng, tile, boundary, lbij, ubij, lbk, ubk, ad_a)
subroutine ad_bc_r3d_bry_tile(ng, tile, boundary, lbij, ubij, lbk, ubk, ad_a)
Definition ad_bc_bry3d.F:31
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
integer, parameter iwest
integer, parameter isouth
integer, parameter ieast
integer, parameter inorth