ROMS
Loading...
Searching...
No Matches
ad_set_massflux.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE ad_set_massflux_mod
3
4#if defined ADJOINT && defined SOLVE3D
5!
6!git $Id$
7!================================================== Hernan G. Arango ===
8! Copyright (c) 2002-2025 The ROMS Group Andrew M. Moore !
9! Licensed under a MIT/X style license !
10! See License_ROMS.md !
11!=======================================================================
12! !
13! This routine computes adjoint horizontal mass fluxes, Hz*u/n and !
14! Hz*v/m. !
15! !
16! BASIC STATE variables required: Hz, u, v !
17! Dependend variables: ad_Huon, ad_Hvom !
18! Independend variables: ad_Hz, ad_u, ad_v !
19! !
20!=======================================================================
21!
22 implicit none
23!
24 PRIVATE
25 PUBLIC :: ad_set_massflux
26!
27 CONTAINS
28!
29!***********************************************************************
30 SUBROUTINE ad_set_massflux (ng, tile, model)
31!***********************************************************************
32!
33 USE mod_param
34 USE mod_grid
35 USE mod_ocean
36 USE mod_stepping
37!
38! Imported variable declarations.
39!
40 integer, intent(in) :: ng, tile, model
41!
42! Local variable declarations.
43!
44 character (len=*), parameter :: myfile = &
45 & __FILE__
46!
47# include "tile.h"
48!
49# ifdef PROFILE
50 CALL wclock_on (ng, model, 12, __line__, myfile)
51# endif
52 CALL ad_set_massflux_tile (ng, tile, model, &
53 & lbi, ubi, lbj, ubj, &
54 & imins, imaxs, jmins, jmaxs, &
55 & nrhs(ng), &
56 & ocean(ng) % u, &
57 & ocean(ng) % v, &
58 & ocean(ng) % ad_u, &
59 & ocean(ng) % ad_v, &
60# ifdef WEC_MELLOR
61 & ocean(ng) % u_stokes, &
62 & ocean(ng) % v_stokes, &
63 & ocean(ng) % ad_u_stokes, &
64 & ocean(ng) % ad_v_stokes, &
65# endif
66 & grid(ng) % Hz, &
67 & grid(ng) % ad_Hz, &
68 & grid(ng) % om_v, &
69 & grid(ng) % on_u, &
70 & grid(ng) % ad_Huon, &
71 & grid(ng) % ad_Hvom)
72# ifdef PROFILE
73 CALL wclock_off (ng, model, 12, __line__, myfile)
74# endif
75!
76 RETURN
77 END SUBROUTINE ad_set_massflux
78
79!
80!***********************************************************************
81 SUBROUTINE ad_set_massflux_tile (ng, tile, model, &
82 & LBi, UBi, LBj, UBj, &
83 & IminS, ImaxS, JminS, JmaxS, &
84 & nrhs, &
85 & u, v, &
86 & ad_u, ad_v, &
87# ifdef WEC_MELLOR
88 & u_stokes, v_stokes, &
89 & ad_u_stokes, ad_v_stokes, &
90# endif
91 & Hz, ad_Hz, &
92 & om_v, on_u, &
93 & ad_Huon, ad_Hvom)
94!***********************************************************************
95!
96 USE mod_param
97 USE mod_scalars
98!
99 USE ad_exchange_3d_mod
100# ifdef DISTRIBUTE
101 USE mp_exchange_mod, ONLY : ad_mp_exchange3d
102# endif
103!
104! Imported variable declarations.
105!
106 integer, intent(in) :: ng, tile, model
107 integer, intent(in) :: LBi, UBi, LBj, UBj
108 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
109 integer, intent(in) :: nrhs
110!
111# ifdef ASSUMED_SHAPE
112 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
113 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
114# ifdef WEC_MELLOR
115 real(r8), intent(in) :: u_stokes(LBi:,LBj:,:)
116 real(r8), intent(in) :: v_stokes(LBi:,LBj:,:)
117# endif
118 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
119 real(r8), intent(in) :: om_v(LBi:,LBj:)
120 real(r8), intent(in) :: on_u(LBi:,LBj:)
121
122 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
123 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
124# ifdef WEC_MELLOR
125 real(r8), intent(inout) :: ad_u_stokes(LBi:,LBj:,:)
126 real(r8), intent(inout) :: ad_v_stokes(LBi:,LBj:,:)
127# endif
128 real(r8), intent(inout) :: ad_Hz(LBi:,LBj:,:)
129
130 real(r8), intent(inout) :: ad_Huon(LBi:,LBj:,:)
131 real(r8), intent(inout) :: ad_Hvom(LBi:,LBj:,:)
132# else
133 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
134 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
135# ifdef WEC_MELLOR
136 real(r8), intent(in) :: u_stokes(LBi:UBi,LBj:UBj,N(ng))
137 real(r8), intent(in) :: v_stokes(LBi:UBi,LBj:UBj,N(ng))
138# endif
139 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
140 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
141 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
142
143 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
144 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
145# ifdef WEC_MELLOR
146 real(r8), intent(inout) :: ad_u_stokes(LBi:UBi,LBj:UBj,N(ng))
147 real(r8), intent(inout) :: ad_v_stokes(LBi:UBi,LBj:UBj,N(ng))
148# endif
149 real(r8), intent(inout) :: ad_Hz(LBi:UBi,LBj:UBj,N(ng))
150
151 real(r8), intent(inout) :: ad_Huon(LBi:UBi,LBj:UBj,N(ng))
152 real(r8), intent(inout) :: ad_Hvom(LBi:UBi,LBj:UBj,N(ng))
153# endif
154!
155! Local variable declarations.
156!
157 integer :: i, j, k
158
159 real(r8) :: adfac, adfac1
160
161# include "set_bounds.h"
162!
163!-----------------------------------------------------------------------
164! Compute horizontal mass fluxes, Hz*u/n and Hz*v/m.
165!-----------------------------------------------------------------------
166!
167! Exchange boundary information.
168!
169# ifdef DISTRIBUTE
170!^ CALL mp_exchange3d (ng, tile, model, 2, &
171!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
172!^ & NghostPoints, &
173!^ & EWperiodic(ng), NSperiodic(ng), &
174!^ & tl_Huon, tl_Hvom)
175!^
176 CALL ad_mp_exchange3d (ng, tile, model, 2, &
177 & lbi, ubi, lbj, ubj, 1, n(ng), &
178 & nghostpoints, &
179 & ewperiodic(ng), nsperiodic(ng), &
180 & ad_huon, ad_hvom)
181!
182# endif
183
184 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
185!^ CALL exchange_v3d_tile (ng, tile, &
186!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
187!^ & tl_Hvom)
188!^
189 CALL ad_exchange_v3d_tile (ng, tile, &
190 & lbi, ubi, lbj, ubj, 1, n(ng), &
191 & ad_hvom)
192!^ CALL exchange_u3d_tile (ng, tile, &
193!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
194!^ & tl_Huon)
195!^
196 CALL ad_exchange_u3d_tile (ng, tile, &
197 & lbi, ubi, lbj, ubj, 1, n(ng), &
198 & ad_huon)
199 END IF
200!
201! Compute adjoint horizontal mass fluxes.
202!
203 DO k=1,n(ng)
204 DO j=jstrp,jendt
205 DO i=istrt,iendt
206# ifdef WEC_MELLOR
207!^ tl_Hvom(i,j,k)=tl_Hvom(i,j,k)+ &
208!^ & 0.5_r8*om_v(i,j)* &
209!^ & ((Hz(i,j,k)+Hz(i,j-1,k))* &
210!^ & tl_v_stokes(i,j,k)+ &
211!^ & (tl_Hz(i,j,k)+tl_Hz(i,j-1,k))* &
212!^ & v_stokes(i,j,k))
213!^
214 adfac=0.5_r8*om_v(i,j)*tl_hvom(i,j,k)
215 adfac1=adfac*v_stokes(i,j,k)
216 tl_v_stokes(i,j,k)=tl_v_stokes(i,j,k)+ &
217 & adfac*(hz(i,j,k)+hz(i,j-1,k))
218 ad_hz(i,j-1,k)=ad_hz(i,j-1,k)+adfac1
219 ad_hz(i,j ,k)=ad_hz(i,j ,k)+adfac1
220# endif
221!^ tl_Hvom(i,j,k)=0.5_r8*om_v(i,j)* &
222!^ & ((Hz(i,j,k)+Hz(i,j-1,k))* &
223!^ & tl_v(i,j,k,nrhs)+ &
224!^ & (tl_Hz(i,j,k)+tl_Hz(i,j-1,k))* &
225!^ & v(i,j,k,nrhs))
226!^
227 adfac=0.5_r8*om_v(i,j)*ad_hvom(i,j,k)
228 adfac1=adfac*v(i,j,k,nrhs)
229 ad_v(i,j,k,nrhs)=ad_v(i,j,k,nrhs)+ &
230 & adfac*(hz(i,j,k)+hz(i,j-1,k))
231 ad_hz(i,j-1,k)=ad_hz(i,j-1,k)+adfac1
232 ad_hz(i,j ,k)=ad_hz(i,j ,k)+adfac1
233 ad_hvom(i,j,k)=0.0_r8
234 END DO
235 END DO
236 DO j=jstrt,jendt
237 DO i=istrp,iendt
238# ifdef WEC_MELLOR
239!^ tl_Huon(i,j,k)=tl_Huon(i,j,k)+ &
240!^ & 0.5_r8*on_u(i,j)* &
241!^ & ((Hz(i,j,k)+Hz(i-1,j,k))* &
242!^ & tl_u_stokes(i,j,k)+ &
243!^ & (tl_Hz(i,j,k)+tl_Hz(i-1,j,k))* &
244!^ & u_stokes(i,j,k))
245!^
246 adfac=0.5_r8*on_u(i,j)*ad_huon(i,j,k)
247 adfac1=adfac*u_stokes(i,j,k)
248 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)+ &
249 & adfac*(hz(i,j,k)+hz(i-1,j,k))
250 ad_hz(i-1,j,k)=ad_hz(i-1,j,k)+adfac1
251 ad_hz(i ,j,k)=ad_hz(i ,j,k)+adfac1
252# endif
253!^ tl_Huon(i,j,k)=0.5_r8*on_u(i,j)* &
254!^ & ((Hz(i,j,k)+Hz(i-1,j,k))* &
255!^ & tl_u(i,j,k,nrhs)+ &
256!^ & (tl_Hz(i,j,k)+tl_Hz(i-1,j,k))* &
257!^ & u(i,j,k,nrhs))
258!^
259 adfac=0.5_r8*on_u(i,j)*ad_huon(i,j,k)
260 adfac1=adfac*u(i,j,k,nrhs)
261 ad_u(i,j,k,nrhs)=ad_u(i,j,k,nrhs)+ &
262 & adfac*(hz(i,j,k)+hz(i-1,j,k))
263 ad_hz(i-1,j,k)=ad_hz(i-1,j,k)+adfac1
264 ad_hz(i ,j,k)=ad_hz(i ,j,k)+adfac1
265 ad_huon(i,j,k)=0.0_r8
266 END DO
267 END DO
268 END DO
269!
270 RETURN
271 END SUBROUTINE ad_set_massflux_tile
272#endif
273 END MODULE ad_set_massflux_mod
ad_exchange_3d_mod
Definition ad_exchange_3d.F:2
ad_exchange_3d_mod::ad_exchange_v3d_tile
subroutine ad_exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:1283
ad_exchange_3d_mod::ad_exchange_u3d_tile
subroutine ad_exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:872
ad_set_massflux_mod
Definition ad_set_massflux.F:2
ad_set_massflux_mod::ad_set_massflux_tile
subroutine ad_set_massflux_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, u, v, ad_u, ad_v, hz, ad_hz, om_v, on_u, ad_huon, ad_hvom)
Definition ad_set_massflux.F:94
ad_set_massflux_mod::ad_set_massflux
subroutine, public ad_set_massflux(ng, tile, model)
Definition ad_set_massflux.F:31
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
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::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nrhs
integer, dimension(:), allocatable nrhs
Definition mod_stepping.F:70
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
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