ROMS
Loading...
Searching...
No Matches
set_massflux.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE set_massflux_mod
3
4#ifdef SOLVE3D
5!
6!git $Id$
7!=======================================================================
8! Copyright (c) 2002-2025 The ROMS Group !
9! Licensed under a MIT/X style license !
10! See License_ROMS.md Hernan G. Arango !
11!========================================== Alexander F. Shchepetkin ===
12! !
13! This routine computes horizontal mass fluxes, Hz*u/n and Hz*v/m. !
14! !
15!=======================================================================
16!
17 implicit none
18!
19 PRIVATE
20 PUBLIC :: set_massflux
21# ifdef ADJOINT
22 PUBLIC :: reset_massflux
23# endif
24!
25 CONTAINS
26!
27!***********************************************************************
28 SUBROUTINE set_massflux (ng, tile, model)
29!***********************************************************************
30!
31 USE mod_param
32 USE mod_grid
33 USE mod_ocean
34 USE mod_stepping
35!
36! Imported variable declarations.
37!
38 integer, intent(in) :: ng, tile, model
39!
40! Local variable declarations.
41!
42 character (len=*), parameter :: myfile = &
43 & __FILE__
44!
45# include "tile.h"
46!
47# ifdef PROFILE
48 CALL wclock_on (ng, model, 12, __line__, myfile)
49# endif
50 CALL set_massflux_tile (ng, tile, model, &
51 & lbi, ubi, lbj, ubj, &
52 & imins, imaxs, jmins, jmaxs, &
53 & nrhs(ng), &
54 & ocean(ng) % u, &
55 & ocean(ng) % v, &
56# ifdef WEC
57 & ocean(ng) % u_stokes, &
58 & ocean(ng) % v_stokes, &
59# endif
60 & grid(ng) % Hz, &
61 & grid(ng) % om_v, &
62 & grid(ng) % on_u, &
63 & grid(ng) % Huon, &
64 & grid(ng) % Hvom)
65# ifdef PROFILE
66 CALL wclock_off (ng, model, 12, __line__, myfile)
67# endif
68!
69 RETURN
70 END SUBROUTINE set_massflux
71!
72!***********************************************************************
73 SUBROUTINE set_massflux_tile (ng, tile, model, &
74 & LBi, UBi, LBj, UBj, &
75 & IminS, ImaxS, JminS, JmaxS, &
76 & nrhs, &
77 & u, v, &
78# ifdef WEC
79 & u_stokes, v_stokes, &
80# endif
81 & Hz, om_v, on_u, &
82 & Huon, Hvom)
83!***********************************************************************
84!
85 USE mod_param
86 USE mod_scalars
87!
88 USE exchange_3d_mod
89# ifdef DISTRIBUTE
90 USE mp_exchange_mod, ONLY : mp_exchange3d
91# endif
92!
93! Imported variable declarations.
94!
95 integer, intent(in) :: ng, tile, model
96 integer, intent(in) :: LBi, UBi, LBj, UBj
97 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
98 integer, intent(in) :: nrhs
99!
100# ifdef ASSUMED_SHAPE
101 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
102 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
103# ifdef WEC
104 real(r8), intent(in) :: u_stokes(LBi:,LBj:,:)
105 real(r8), intent(in) :: v_stokes(LBi:,LBj:,:)
106# endif
107 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
108 real(r8), intent(in) :: om_v(LBi:,LBj:)
109 real(r8), intent(in) :: on_u(LBi:,LBj:)
110
111 real(r8), intent(out) :: Huon(LBi:,LBj:,:)
112 real(r8), intent(out) :: Hvom(LBi:,LBj:,:)
113# else
114 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
115 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
116# ifdef WEC
117 real(r8), intent(in) :: u_stokes(LBi:UBi,LBj:UBj,N(ng))
118 real(r8), intent(in) :: v_stokes(LBi:UBi,LBj:UBj,N(ng))
119# endif
120 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
121 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
122 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
123
124 real(r8), intent(out) :: Huon(LBi:UBi,LBj:UBj,N(ng))
125 real(r8), intent(out) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
126# endif
127!
128! Local variable declarations.
129!
130 integer :: i, j, k
131
132# include "set_bounds.h"
133!
134!-----------------------------------------------------------------------
135! Compute horizontal mass fluxes, Hz*u/n and Hz*v/m.
136!-----------------------------------------------------------------------
137!
138! Compute horizontal mass fluxes.
139!
140 DO k=1,n(ng)
141 DO j=jstrt,jendt
142 DO i=istrp,iendt
143 huon(i,j,k)=0.5_r8*(hz(i,j,k)+hz(i-1,j,k))*u(i,j,k,nrhs)* &
144 & on_u(i,j)
145# ifdef WEC
146 huon(i,j,k)=huon(i,j,k)+ &
147 & 0.5_r8*(hz(i,j,k)+hz(i-1,j,k))* &
148 & u_stokes(i,j,k)*on_u(i,j)
149# endif
150 END DO
151 END DO
152 DO j=jstrp,jendt
153 DO i=istrt,iendt
154 hvom(i,j,k)=0.5_r8*(hz(i,j,k)+hz(i,j-1,k))*v(i,j,k,nrhs)* &
155 & om_v(i,j)
156# ifdef WEC
157 hvom(i,j,k)=hvom(i,j,k)+ &
158 & 0.5_r8*(hz(i,j,k)+hz(i,j-1,k))* &
159 & v_stokes(i,j,k)*om_v(i,j)
160# endif
161 END DO
162 END DO
163 END DO
164!
165! Exchange boundary information.
166!
167 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
168 CALL exchange_u3d_tile (ng, tile, &
169 & lbi, ubi, lbj, ubj, 1, n(ng), &
170 & huon)
171 CALL exchange_v3d_tile (ng, tile, &
172 & lbi, ubi, lbj, ubj, 1, n(ng), &
173 & hvom)
174 END IF
175
176# ifdef DISTRIBUTE
177 CALL mp_exchange3d (ng, tile, model, 2, &
178 & lbi, ubi, lbj, ubj, 1, n(ng), &
179 & nghostpoints, &
180 & ewperiodic(ng), nsperiodic(ng), &
181 & huon, hvom)
182# endif
183
184 RETURN
185 END SUBROUTINE set_massflux_tile
186
187# ifdef ADJOINT
188!
189!***********************************************************************
190 SUBROUTINE reset_massflux (ng, tile, model)
191!***********************************************************************
192!
193 USE mod_param
194 USE mod_coupling
195 USE mod_grid
196 USE mod_ocean
197 USE mod_stepping
198!
199! Imported variable declarations.
200!
201 integer, intent(in) :: ng, tile, model
202!
203! Local variable declarations.
204!
205 character (len=*), parameter :: myfile = &
206 & __FILE__//", reset_massflux"
207!
208# include "tile.h"
209!
210# ifdef PROFILE
211 CALL wclock_on (ng, model, 12, __line__, myfile)
212# endif
213 CALL reset_massflux_tile (ng, tile, model, &
214 & lbi, ubi, lbj, ubj, &
215 & imins, imaxs, jmins, jmaxs, &
216 & nnew(ng), &
217 & coupling(ng) % DU_avg2, &
218 & coupling(ng) % DV_avg2, &
219 & ocean(ng) % u, &
220 & ocean(ng) % v, &
221# ifdef WEC
222 & ocean(ng) % u_stokes, &
223 & ocean(ng) % v_stokes, &
224# endif
225 & grid(ng) % Hz, &
226 & grid(ng) % om_v, &
227 & grid(ng) % on_u, &
228 & grid(ng) % Huon, &
229 & grid(ng) % Hvom)
230# ifdef PROFILE
231 CALL wclock_off (ng, model, 12, __line__, myfile)
232# endif
233!
234 RETURN
235 END SUBROUTINE reset_massflux
236!
237!***********************************************************************
238 SUBROUTINE reset_massflux_tile (ng, tile, model, &
239 & LBi, UBi, LBj, UBj, &
240 & IminS, ImaxS, JminS, JmaxS, &
241 & nnew, &
242 & DU_avg2, DV_avg2, &
243 & u, v, &
244# ifdef WEC
245 & u_stokes, v_stokes, &
246# endif
247 & Hz, om_v, on_u, &
248 & Huon, Hvom)
249!***********************************************************************
250!
251 USE mod_param
252 USE mod_scalars
253!
254 USE exchange_3d_mod
255# ifdef DISTRIBUTE
256 USE mp_exchange_mod
257# endif
258!
259! Imported variable declarations.
260!
261 integer, intent(in) :: ng, tile, model
262 integer, intent(in) :: LBi, UBi, LBj, UBj
263 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
264
265 integer, intent(in) :: nnew
266!
267# ifdef ASSUMED_SHAPE
268 real(r8), intent(in) :: DU_avg2(LBi:,LBj:)
269 real(r8), intent(in) :: DV_avg2(LBi:,LBj:)
270 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
271 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
272# ifdef WEC
273 real(r8), intent(in) :: u_stokes(LBi:,LBj:,:)
274 real(r8), intent(in) :: v_stokes(LBi:,LBj:,:)
275# endif
276 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
277 real(r8), intent(in) :: om_v(LBi:,LBj:)
278 real(r8), intent(in) :: on_u(LBi:,LBj:)
279
280 real(r8), intent(inout) :: Huon(LBi:,LBj:,:)
281 real(r8), intent(inout) :: Hvom(LBi:,LBj:,:)
282# else
283 real(r8), intent(in) :: DU_avg2(LBi:UBi,LBj:UBj)
284 real(r8), intent(in) :: DV_avg2(LBi:UBi,LBj:UBj)
285 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
286 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
287# ifdef WEC
288 real(r8), intent(in) :: u_stokes(LBi:UBi,LBj:UBj,N(Ng))
289 real(r8), intent(in) :: v_stokes(LBi:UBi,LBj:UBj,N(ng))
290# endif
291 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
292 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
293 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
294
295 real(r8), intent(inout) :: Huon(LBi:UBi,LBj:UBj,N(ng))
296 real(r8), intent(inout) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
297# endif
298!
299! Local variable declarations.
300!
301 integer :: i, j, k
302
303 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC
304 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
305
306# include "set_bounds.h"
307!
308!-----------------------------------------------------------------------
309! Compute intermediate values of mass fluxes Huon and Hvom used by the
310! adjoint model. The original values can be reinstated by calling
311! "set_massflux" after "ad_omega".
312!-----------------------------------------------------------------------
313!
314! Compute mass flux, Hz*u/n.
315!
316 DO j=jstrt,jendt
317 DO i=istrp,iendt
318 dc(i,0)=0.0_r8
319 fc(i,0)=0.0_r8
320 END DO
321 DO k=1,n(ng)
322 DO i=istrp,iendt
323 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i-1,j,k))*on_u(i,j)
324 dc(i,0)=dc(i,0)+dc(i,k)
325 END DO
326 END DO
327 DO k=n(ng),1,-1
328 DO i=istrp,iendt
329 huon(i,j,k)=0.5_r8*(huon(i,j,k)+u(i,j,k,nnew)*dc(i,k))
330# ifdef WEC
331 huon(i,j,k)=huon(i,j,k)+0.5_r8*u_stokes(i,j,k)*dc(i,k)
332# endif
333 fc(i,0)=fc(i,0)+huon(i,j,k)
334 END DO
335 END DO
336!
337! Replace with correct vertical mean, DU_avg2.
338!
339 DO i=istrp,iendt
340 dc(i,0)=1.0_r8/dc(i,0)
341 fc(i,0)=dc(i,0)*(fc(i,0)-du_avg2(i,j))
342 END DO
343 DO k=1,n(ng)
344 DO i=istrp,iendt
345 huon(i,j,k)=huon(i,j,k)-dc(i,k)*fc(i,0)
346 END DO
347 END DO
348!
349! Compute mass flux, Hz*v/m.
350!
351 IF (j.ge.jstrp) THEN
352 DO i=istrt,iendt
353 dc(i,0)=0.0_r8
354 fc(i,0)=0.0_r8
355 END DO
356 DO k=1,n(ng)
357 DO i=istrt,iendt
358 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i,j-1,k))*om_v(i,j)
359 dc(i,0)=dc(i,0)+dc(i,k)
360 END DO
361 END DO
362 DO k=n(ng),1,-1
363 DO i=istrt,iendt
364 hvom(i,j,k)=0.5_r8*(hvom(i,j,k)+v(i,j,k,nnew)*dc(i,k))
365# ifdef WEC
366 hvom(i,j,k)=hvom(i,j,k)+0.5_r8*v_stokes(i,j,k)*dc(i,k)
367# endif
368 fc(i,0)=fc(i,0)+hvom(i,j,k)
369 END DO
370 END DO
371!
372! Replace with correct vertical mean, DV_avg2.
373!
374 DO i=istrt,iendt
375 dc(i,0)=1.0_r8/dc(i,0)
376 fc(i,0)=dc(i,0)*(fc(i,0)-dv_avg2(i,j))
377 END DO
378 DO k=1,n(ng)
379 DO i=istrt,iendt
380 hvom(i,j,k)=hvom(i,j,k)-dc(i,k)*fc(i,0)
381 END DO
382 END DO
383 ENDIF
384 END DO
385!
386! Exchange boundary information.
387!
388 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
389 CALL exchange_u3d_tile (ng, tile, &
390 & lbi, ubi, lbj, ubj, 1, n(ng), &
391 & huon)
392 CALL exchange_v3d_tile (ng, tile, &
393 & lbi, ubi, lbj, ubj, 1, n(ng), &
394 & hvom)
395 END IF
396
397# ifdef DISTRIBUTE
398 CALL mp_exchange3d (ng, tile, model, 2, &
399 & lbi, ubi, lbj, ubj, 1, n(ng), &
400 & nghostpoints, &
401 & ewperiodic(ng), nsperiodic(ng), &
402 & huon, hvom)
403# endif
404!
405 RETURN
406 END SUBROUTINE reset_massflux_tile
407# endif
408#endif
409 END MODULE set_massflux_mod
exchange_3d_mod
Definition exchange_3d.F:2
exchange_3d_mod::exchange_u3d_tile
subroutine exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:495
exchange_3d_mod::exchange_v3d_tile
subroutine exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:707
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_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
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange3d
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:2037
set_massflux_mod
Definition set_massflux.F:2
set_massflux_mod::reset_massflux
subroutine, public reset_massflux(ng, tile, model)
Definition set_massflux.F:191
set_massflux_mod::reset_massflux_tile
subroutine reset_massflux_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nnew, du_avg2, dv_avg2, u, v, hz, om_v, on_u, huon, hvom)
Definition set_massflux.F:249
set_massflux_mod::set_massflux_tile
subroutine set_massflux_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, u, v, hz, om_v, on_u, huon, hvom)
Definition set_massflux.F:83
set_massflux_mod::set_massflux
subroutine, public set_massflux(ng, tile, model)
Definition set_massflux.F:29
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