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

Functions/Subroutines

subroutine, public adsen_force (ng, tile)
 
subroutine adsen_force_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, knew, nnew, nstp, rscope, uscope, vscope, u_ads, v_ads, wvel_ads, t_ads, ubar_ads, vbar_ads, zeta_ads, ad_u, ad_v, ad_wvel, ad_t, ad_zt_avg1, ad_ubar, ad_vbar)
 

Function/Subroutine Documentation

◆ adsen_force()

subroutine, public adsen_force_mod::adsen_force ( integer, intent(in) ng,
integer, intent(in) tile )

Definition at line 28 of file adsen_force.F.

29!***********************************************************************
30!
31 USE mod_param
32 USE mod_clima
33# ifdef SOLVE3D
34 USE mod_coupling
35# endif
36 USE mod_grid
37 USE mod_ocean
38 USE mod_stepping
39!
40! Imported variable declarations.
41!
42 integer, intent(in) :: ng, tile
43!
44! Local variable declarations.
45!
46# include "tile.h"
47!
48 CALL adsen_force_tile (ng, tile, &
49 & lbi, ubi, lbj, ubj, &
50 & imins, imaxs, jmins, jmaxs, &
51 & knew(ng), &
52# ifdef SOLVE3D
53 & nnew(ng), nstp(ng), &
54# endif
55 & grid(ng) % Rscope, &
56 & grid(ng) % Uscope, &
57 & grid(ng) % Vscope, &
58# ifdef SOLVE3D
59 & clima(ng) % u_ads, &
60 & clima(ng) % v_ads, &
61 & clima(ng) % wvel_ads, &
62 & clima(ng) % t_ads, &
63# endif
64 & clima(ng) % ubar_ads, &
65 & clima(ng) % vbar_ads, &
66 & clima(ng) % zeta_ads, &
67# ifdef SOLVE3D
68 & ocean(ng) % ad_u, &
69 & ocean(ng) % ad_v, &
70 & ocean(ng) % ad_wvel, &
71 & ocean(ng) % ad_t, &
72 & coupling(ng) % ad_Zt_avg1, &
73# else
74 & ocean(ng) % ad_zeta, &
75# endif
76 & ocean(ng) % ad_ubar, &
77 & ocean(ng) % ad_vbar)
78
79 RETURN
mod_clima
Definition mod_clima.F:2
mod_clima::clima
type(t_clima), dimension(:), allocatable clima
Definition mod_clima.F:153
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_stepping
Definition mod_stepping.F:2
mod_stepping::knew
integer, dimension(:), allocatable knew
Definition mod_stepping.F:64
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71

References adsen_force_tile(), mod_clima::clima, mod_coupling::coupling, mod_grid::grid, mod_stepping::knew, mod_stepping::nnew, mod_stepping::nstp, and mod_ocean::ocean.

Referenced by ad_main3d().

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

◆ adsen_force_tile()

subroutine adsen_force_mod::adsen_force_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) knew,
integer, intent(in) nnew,
integer, intent(in) nstp,
real(r8), dimension(lbi:,lbj:), intent(in) rscope,
real(r8), dimension(lbi:,lbj:), intent(in) uscope,
real(r8), dimension(lbi:,lbj:), intent(in) vscope,
real(r8), dimension(lbi:,lbj:,:), intent(in) u_ads,
real(r8), dimension(lbi:,lbj:,:), intent(in) v_ads,
real(r8), dimension(lbi:,lbj:,:), intent(in) wvel_ads,
real(r8), dimension(lbi:,lbj:,:,:), intent(in) t_ads,
real(r8), dimension(lbi:,lbj:), intent(in) ubar_ads,
real(r8), dimension(lbi:,lbj:), intent(in) vbar_ads,
real(r8), dimension(lbi:,lbj:), intent(in) zeta_ads,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) ad_u,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) ad_v,
real(r8), dimension(lbi:,lbj:,:), intent(inout) ad_wvel,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) ad_t,
real(r8), dimension(lbi:,lbj:), intent(inout) ad_zt_avg1,
real(r8), dimension(lbi:,lbj:,:), intent(inout) ad_ubar,
real(r8), dimension(lbi:,lbj:,:), intent(inout) ad_vbar )
private

Definition at line 83 of file adsen_force.F.

103!***********************************************************************
104!
105 USE mod_param
106 USE mod_parallel
107 USE mod_iounits
108 USE mod_ncparam
109 USE mod_scalars
110!
111! Imported variable declarations.
112!
113 integer, intent(in) :: ng, tile
114 integer, intent(in) :: LBi, UBi, LBj, UBj
115 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
116 integer, intent(in) :: knew
117# ifdef SOLVE3D
118 integer, intent(in) :: nnew, nstp
119# endif
120!
121# ifdef ASSUMED_SHAPE
122 real(r8), intent(in) :: Rscope(LBi:,LBj:)
123 real(r8), intent(in) :: Uscope(LBi:,LBj:)
124 real(r8), intent(in) :: Vscope(LBi:,LBj:)
125# ifdef SOLVE3D
126 real(r8), intent(in) :: u_ads(LBi:,LBj:,:)
127 real(r8), intent(in) :: v_ads(LBi:,LBj:,:)
128 real(r8), intent(in) :: wvel_ads(LBi:,LBj:,:)
129 real(r8), intent(in) :: t_ads(LBi:,LBj:,:,:)
130# endif
131 real(r8), intent(in) :: ubar_ads(LBi:,LBj:)
132 real(r8), intent(in) :: vbar_ads(LBi:,LBj:)
133 real(r8), intent(in) :: zeta_ads(LBi:,LBj:)
134# ifdef SOLVE3D
135 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
136 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
137 real(r8), intent(inout) :: ad_wvel(LBi:,LBj:,:)
138 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
139 real(r8), intent(inout) :: ad_Zt_avg1(LBi:,LBj:)
140# else
141 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
142# endif
143 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
144 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
145# else
146 real(r8), intent(in) :: Rscope(LBi:UBi,LBj:UBj)
147 real(r8), intent(in) :: Uscope(LBi:UBi,LBj:UBj)
148 real(r8), intent(in) :: Vscope(LBi:UBi,LBj:UBj)
149# ifdef SOLVE3D
150 real(r8), intent(in) :: u_ads(LBi:UBi,LBj:UBj,N(ng))
151 real(r8), intent(in) :: v_ads(LBi:UBi,LBj:UBj,N(ng))
152 real(r8), intent(in) :: wvel_ads(LBi:UBi,LBj:UBj,N(ng))
153 real(r8), intent(in) :: t_ads(LBi:UBi,LBj:UBj,N(ng),NT(ng))
154# endif
155 real(r8), intent(in) :: ubar_ads(LBi:UBi,LBj:UBj)
156 real(r8), intent(in) :: vbar_ads(LBi:UBi,LBj:UBj)
157 real(r8), intent(in) :: zeta_ads(LBi:UBi,LBj:UBj)
158# ifdef SOLVE3D
159 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
160 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
161 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,0:N(ng))
162 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
163 real(r8), intent(inout) :: ad_Zt_avg1(LBi:UBi,LBj:UBj)
164# else
165 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
166# endif
167 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
168 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
169# endif
170!
171! Local variable declarations.
172!
173 integer :: Kfrc, Nfrc, i, itrc, j, k
174
175 real(r8) :: adFac
176
177# include "set_bounds.h"
178!
179!-----------------------------------------------------------------------
180! Initialize adjoint staye with the functional whose sensitivity is
181! required. Use functional loaded into first record of climatological
182! arrays.
183!-----------------------------------------------------------------------
184!
185 IF (iic(ng).eq.ntend(ng)) THEN
186 kfrc=knew
187 nfrc=nstp
188 ELSE
189 kfrc=1
190 nfrc=nnew
191 END IF
192
193# ifdef AD_IMPULSE
194!
195! Impose the forcing in the adjoint model as impulses in a manner that
196! is consistent with the definition of the sensitivity functional.
197! Notice that nTLM is used to control the forcing since nADJ is
198! used to control strong versus weak constraint so cannot be
199! arbitrarily defined.
200!
201 adfac=0.0_r8
202# ifdef I4DVAR_ANA_SENSITIVITY
203 IF ((mod(iic(ng)-1,nhis(ng)).eq.0).and. &
204 & (dends(ng).ge.tdays(ng)).and.(tdays(ng).ge.dstrs(ng))) THEN
205# else
206 IF ((mod(iic(ng)-1,ntlm(ng)).eq.0).and. &
207 & (dends(ng).ge.tdays(ng)).and.(tdays(ng).ge.dstrs(ng))) THEN
208# endif
209 adfac=1.0_r8
210 IF (master) THEN
211 WRITE (stdout,10) iic(ng)-1
212 10 FORMAT (2x,'ADSEN_FORCE - forcing Adjoint model at', &
213 & ' TimeStep: ', i0)
214 END IF
215 END IF
216# else
217 adfac=1.0_r8
218# endif
219!
220! Free-surface.
221!
222 IF (scalars(ng)%Lstate(isfsur)) THEN
223# ifdef SOLVE3D
224 DO j=jstrr,jendr
225 DO i=istrr,iendr
226 ad_zt_avg1(i,j)=ad_zt_avg1(i,j)+ &
227 & adfac*zeta_ads(i,j)*rscope(i,j)
228 END DO
229 END DO
230# else
231 DO j=jstrr,jendr
232 DO i=istrr,iendr
233 ad_zeta(i,j,kfrc)=ad_zeta(i,j,kfrc)+ &
234 & adfac*zeta_ads(i,j)*rscope(i,j)
235 END DO
236 END DO
237# endif
238 END IF
239!
240! 2D Momentum.
241!
242 IF (scalars(ng)%Lstate(isubar)) THEN
243 DO j=jstrr,jendr
244 DO i=istr,iendr
245 ad_ubar(i,j,kfrc)=ad_ubar(i,j,kfrc)+ &
246 & adfac*ubar_ads(i,j)*uscope(i,j)
247 END DO
248 END DO
249 END IF
250!
251 IF (scalars(ng)%Lstate(isvbar)) THEN
252 DO j=jstr,jendr
253 DO i=istrr,iendr
254 ad_vbar(i,j,kfrc)=ad_vbar(i,j,kfrc)+ &
255 & adfac*vbar_ads(i,j)*vscope(i,j)
256 END DO
257 END DO
258 END IF
259# ifdef SOLVE3D
260!
261! 3D Momentum.
262!
263 IF (scalars(ng)%Lstate(isuvel)) THEN
264 DO k=kstrs(ng),kends(ng)
265 DO j=jstrr,jendr
266 DO i=istr,iendr
267 ad_u(i,j,k,nfrc)=ad_u(i,j,k,nfrc)+ &
268 & adfac*u_ads(i,j,k)*uscope(i,j)
269 END DO
270 END DO
271 END DO
272 END IF
273!
274 IF (scalars(ng)%Lstate(isvvel)) THEN
275 DO k=kstrs(ng),kends(ng)
276 DO j=jstr,jendr
277 DO i=istrr,iendr
278 ad_v(i,j,k,nfrc)=ad_v(i,j,k,nfrc)+ &
279 & adfac*v_ads(i,j,k)*vscope(i,j)
280 END DO
281 END DO
282 END DO
283 END IF
284!
285! Vertical velocity.
286!
287! Notice that vertical velocity will not be forced at the top in the
288! current code. To do this, uncomment the next line and ensure that
289! KendSb=N in the ocean input file.
290!
291 IF (scalars(ng)%Lstate(isvvel)) THEN
292!! DO k=KstrS(ng),KendS(ng)+1 ! if forced at the top
293 DO k=kstrs(ng),kends(ng)
294 DO j=jstrr,jendr
295 DO i=istrr,iendr
296 ad_wvel(i,j,k)=ad_wvel(i,j,k)+ &
297 & adfac*wvel_ads(i,j,k)*rscope(i,j)
298 END DO
299 END DO
300 END DO
301 END IF
302!
303! Tracers.
304!
305 DO itrc=1,nt(ng)
306 IF (scalars(ng)%Lstate(istvar(itrc))) THEN
307 DO k=kstrs(ng),kends(ng)
308 DO j=jstrr,jendr
309 DO i=istrr,iendr
310 ad_t(i,j,k,nfrc,itrc)=ad_t(i,j,k,nfrc,itrc)+ &
311 & adfac*t_ads(i,j,k,itrc)* &
312 & rscope(i,j)
313 END DO
314 END DO
315 END DO
316 END IF
317 END DO
318# endif
319
320 RETURN
mod_iounits
Definition mod_iounits.F:2
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
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::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::isubar
integer isubar
Definition mod_ncparam.F:504
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_scalars
Definition mod_scalars.F:2
mod_scalars::kends
integer, dimension(:), allocatable kends
Definition mod_scalars.F:1217
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::ntlm
integer, dimension(:), allocatable ntlm
Definition mod_scalars.F:1080
mod_scalars::tdays
real(dp), dimension(:), allocatable tdays
Definition mod_scalars.F:261
mod_scalars::dends
real(r8), dimension(:), allocatable dends
Definition mod_scalars.F:1222
mod_scalars::kstrs
integer, dimension(:), allocatable kstrs
Definition mod_scalars.F:1216
mod_scalars::ntend
integer, dimension(:), allocatable ntend
Definition mod_scalars.F:379
mod_scalars::nhis
integer, dimension(:), allocatable nhis
Definition mod_scalars.F:1076
mod_scalars::scalars
type(t_scalars), dimension(:), allocatable scalars
Definition mod_scalars.F:65
mod_scalars::dstrs
real(r8), dimension(:), allocatable dstrs
Definition mod_scalars.F:1221

References mod_scalars::dends, mod_scalars::dstrs, mod_scalars::iic, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::kends, mod_scalars::kstrs, mod_parallel::master, mod_scalars::nhis, mod_scalars::ntend, mod_scalars::ntlm, mod_scalars::scalars, mod_iounits::stdout, and mod_scalars::tdays.

Referenced by adsen_force().

Here is the caller graph for this function: