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

Functions/Subroutines

subroutine, public frc_adgather (ng, tile)
 
subroutine frc_adgather_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, ad_zeta, ad_zeta_sol, ad_u, ad_v, ad_t, f_zetag, f_ug, f_vg, f_tg)
 
subroutine, public frc_clear (ng, tile)
 
subroutine frc_clear_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, f_zetag, f_ug, f_vg, f_tg)
 

Function/Subroutine Documentation

◆ frc_adgather()

subroutine, public frc_weak_mod::frc_adgather ( integer, intent(in) ng,
integer, intent(in) tile )

Definition at line 26 of file frc_weak.F.

27!
28!=======================================================================
29! !
30! This subroutine is the adjoint of the weak constraint forcing !
31! interpolation between snapshots used in the tangent linear and !
32! representer models. !
33! !
34! On Input: !
35! !
36! ng Nested grid number. !
37! tile Domain partition. !
38! !
39!=======================================================================
40!
41 USE mod_param
42 USE mod_forces
43 USE mod_ocean
44!
45! Imported variable declarations.
46!
47 integer, intent(in) :: ng, tile
48!
49! Local variable declarations.
50!
51 character (len=*), parameter :: MyFile = &
52 & __FILE__
53!
54# include "tile.h"
55!
56# ifdef PROFILE
57 CALL wclock_on (ng, iadm, 7, __line__, myfile)
58# endif
59 CALL frc_adgather_tile (ng, tile, &
60 & lbi, ubi, lbj, ubj, &
61 & imins, imaxs, jmins, jmaxs, &
62 & ocean(ng) % ad_zeta, &
63 & ocean(ng) % ad_zeta_sol, &
64# ifdef SOLVE3D
65 & ocean(ng) % ad_u, &
66 & ocean(ng) % ad_v, &
67 & ocean(ng) % ad_t, &
68# else
69 & ocean(ng) % ad_ubar, &
70 & ocean(ng) % ad_vbar, &
71 & ocean(ng) % ad_ubar_sol, &
72 & ocean(ng) % ad_vbar_sol, &
73# endif
74 & ocean(ng) % f_zetaG, &
75# ifdef SOLVE3D
76 & ocean(ng) % f_uG, &
77 & ocean(ng) % f_vG, &
78 & ocean(ng) % f_tG)
79# else
80 & ocean(ng) % f_ubarG, &
81 & ocean(ng) % f_vbarG)
82# endif
83# ifdef PROFILE
84 CALL wclock_off (ng, iadm, 7, __line__, myfile)
85# endif
86!
87 RETURN
mod_forces
Definition mod_forces.F:2
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::iadm
integer, parameter iadm
Definition mod_param.F:665
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

References frc_adgather_tile(), mod_param::iadm, mod_ocean::ocean, wclock_off(), and wclock_on().

Referenced by ad_main3d().

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

◆ frc_adgather_tile()

subroutine frc_weak_mod::frc_adgather_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,
real(r8), dimension(lbi:,lbj:,:), intent(in) ad_zeta,
real(r8), dimension(lbi:,lbj:), intent(in) ad_zeta_sol,
real(r8), dimension(lbi:,lbj:,:,:), intent(in) ad_u,
real(r8), dimension(lbi:,lbj:,:,:), intent(in) ad_v,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(in) ad_t,
real(r8), dimension(lbi:,lbj:,:), intent(inout) f_zetag,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) f_ug,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) f_vg,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) f_tg )
private

Definition at line 91 of file frc_weak.F.

104# else
105 & f_ubarg, f_vbarg)
106# endif
107!***********************************************************************
108!
109 USE mod_param
110 USE mod_scalars
111 USE mod_stepping
112 USE mod_fourdvar
113!
114! Imported variable declarations.
115!
116 integer, intent(in) :: ng, tile
117 integer, intent(in) :: LBi, UBi, LBj, UBj
118 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
119!
120# ifdef ASSUMED_SHAPE
121 real(r8), intent(in) :: ad_zeta(LBi:,LBj:,:)
122 real(r8), intent(in) :: ad_zeta_sol(LBi:,LBj:)
123 real(r8), intent(inout) :: f_zetaG(LBi:,LBj:,:)
124# ifdef SOLVE3D
125 real(r8), intent(in) :: ad_u(LBi:,LBj:,:,:)
126 real(r8), intent(in) :: ad_v(LBi:,LBj:,:,:)
127 real(r8), intent(in) :: ad_t(LBi:,LBj:,:,:,:)
128 real(r8), intent(inout) :: f_uG(LBi:,LBj:,:,:)
129 real(r8), intent(inout) :: f_vG(LBi:,LBj:,:,:)
130 real(r8), intent(inout) :: f_tG(LBi:,LBj:,:,:,:)
131# else
132 real(r8), intent(in) :: ad_ubar(LBi:,LBj:,:)
133 real(r8), intent(in) :: ad_vbar(LBi:,LBj:,:)
134 real(r8), intent(in) :: ad_ubar_sol(LBi:,LBj:)
135 real(r8), intent(inout) :: ad_vbar_sol(LBi:,LBj:)
136 real(r8), intent(inout) :: f_ubarG(LBi:,LBj:,:)
137 real(r8), intent(inout) :: f_vbarG(LBi:,LBj:,:)
138# endif
139# else
140 real(r8), intent(in) :: ad_zeta(LBi:UBi,LBj:UBj,:)
141 real(r8), intent(in) :: ad_zeta_sol(LBi:UBi,LBj:UBj)
142 real(r8), intent(inout) :: f_zetaG(LBi:UBi,LBj:UBj,2)
143# ifdef SOLVE3D
144 real(r8), intent(in) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
145 real(r8), intent(in) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
146 real(r8), intent(in) :: ad_t(LBi:UBi,LBj:UBj,N(ng),2,NT(ng))
147 real(r8), intent(inout) :: f_uG(LBi:UBi,LBj:UBj,N(ng),2)
148 real(r8), intent(inout) :: f_vG(LBi:UBi,LBj:UBj,N(ng),2)
149 real(r8), intent(inout) :: f_tG(LBi:UBi,LBj:UBj,N(ng),2,NT(ng))
150# else
151 real(r8), intent(in) :: ad_ubar(LBi:UBi,LBj:UBj,:)
152 real(r8), intent(in) :: ad_vbar(LBi:UBi,LBj:UBj,:)
153 real(r8), intent(in) :: ad_ubar_sol(LBi:UBi,LBj:UBj)
154 real(r8), intent(in) :: ad_vbar_sol(LBi:UBi,LBj:UBj)
155 real(r8), intent(inout) :: f_ubarG(LBi:UBi,LBj:UBj,2)
156 real(r8), intent(inout) :: f_vbarG(LBi:UBi,LBj:UBj,2)
157# endif
158# endif
159!
160! Local variable declarations.
161!
162 integer :: i, it1, it2, j, k, kout
163# ifdef SOLVE3D
164 integer :: itrc, nout
165# endif
166 real(r8) :: fac, fac1, fac2, time1, time2
167
168# include "set_bounds.h"
169!
170!-----------------------------------------------------------------------
171! Compute weak-constraint forcing terms used by the tangent linear
172! and representer models. Perform the adjoint of the interpolation
173! between snapshots.
174!-----------------------------------------------------------------------
175!
176! Set time records and interpolation factor, if any.
177!
178# ifdef WEAK_NOINTERP
179# ifdef GENERIC_DSTART
180 it1=max(0,(iic(ng)-ntstart(ng))/nadj(ng))+1
181# else
182 it1=max(0,(iic(ng)-1)/nadj(ng))+1
183# endif
184 it2=it1+1
185 time2=dstart*day2sec+(it2-1)*nadj(ng)*dt(ng)
186# else
187# ifdef GENERIC_DSTART
188 it1=max(0,(iic(ng)-ntstart(ng))/nadj(ng))+1
189# else
190 it1=max(0,(iic(ng)-1)/nadj(ng))+1
191# endif
192 it2=it1+1
193 time1=dstart*day2sec+(it1-1)*nadj(ng)*dt(ng)
194 time2=dstart*day2sec+(it2-1)*nadj(ng)*dt(ng)
195 fac1=time2-time(ng)
196 fac2=time(ng)-time1
197 fac=1.0_r8/(fac1+fac2)
198 fac1=fac*fac1
199 fac2=fac*fac2
200# endif
201!
202! Set weak-constraint force time.
203!
204 forcetime(ng)=time2
205!
206! Determine time index of adjoint variables to process.
207!
208 kout=kstp(ng)
209
210# ifdef SOLVE3D
211 IF (iic(ng).ne.ntend(ng)) THEN
212 nout=nnew(ng)
213 ELSE
214 nout=nstp(ng)
215 END IF
216# endif
217!
218! Clear forcing arrays on first call to this routine.
219!
220 IF (iic(ng).eq.ntstart(ng)-1) THEN
221 DO j=jstrr,jendr
222 DO i=istrr,iendr
223 f_zetag(i,j,1)=0.0_r8
224 f_zetag(i,j,2)=0.0_r8
225 END DO
226 END DO
227# ifndef SOLVE3D
228 DO j=jstrr,jendr
229 DO i=istr,iendr
230 f_ubarg(i,j,1)=0.0_r8
231 f_ubarg(i,j,2)=0.0_r8
232 END DO
233 END DO
234 DO j=jstr,jendr
235 DO i=istrr,iendr
236 f_vbarg(i,j,1)=0.0_r8
237 f_vbarg(i,j,2)=0.0_r8
238 END DO
239 END DO
240# else
241 DO k=1,n(ng)
242 DO j=jstrr,jendr
243 DO i=istr,iendr
244 f_ug(i,j,k,1)=0.0_r8
245 f_ug(i,j,k,2)=0.0_r8
246 END DO
247 END DO
248 END DO
249 DO k=1,n(ng)
250 DO j=jstr,jendr
251 DO i=istrr,iendr
252 f_vg(i,j,k,1)=0.0_r8
253 f_vg(i,j,k,2)=0.0_r8
254 END DO
255 END DO
256 END DO
257 DO itrc=1,nt(ng)
258 DO k=1,n(ng)
259 DO j=jstrr,jendr
260 DO i=istrr,iendr
261 f_tg(i,j,k,1,itrc)=0.0_r8
262 f_tg(i,j,k,2,itrc)=0.0_r8
263 END DO
264 END DO
265 END DO
266 END DO
267# endif
268 END IF
269!
270! Gather free-surface weak-constraint forcing terms.
271!
272 IF (lwrtstate2d(ng)) THEN
273 DO j=jstrr,jendr
274 DO i=istrr,iendr
275# ifdef WEAK_NOINTERP
276 f_zetag(i,j,1)=ad_zeta(i,j,kout)
277 f_zetag(i,j,2)=ad_zeta(i,j,kout)
278# else
279 f_zetag(i,j,1)=f_zetag(i,j,1)+fac1*ad_zeta(i,j,kout)
280 f_zetag(i,j,2)=f_zetag(i,j,2)+fac2*ad_zeta(i,j,kout)
281# endif
282 END DO
283 END DO
284 ELSE
285 DO j=jstrr,jendr
286 DO i=istrr,iendr
287# ifdef WEAK_NOINTERP
288 f_zetag(i,j,1)=ad_zeta_sol(i,j)
289 f_zetag(i,j,2)=ad_zeta_sol(i,j)
290# else
291 f_zetag(i,j,1)=f_zetag(i,j,1)+fac1*ad_zeta_sol(i,j)
292 f_zetag(i,j,2)=f_zetag(i,j,2)+fac2*ad_zeta_sol(i,j)
293# endif
294 END DO
295 END DO
296 END IF
297
298# ifndef SOLVE3D
299!
300! Gather 2D-momentum weak-constraint forcing terms.
301!
302 IF (lwrtstate2d(ng)) THEN
303 DO j=jstrr,jendr
304 DO i=istr,iendr
305# ifdef WEAK_NOINTERP
306 f_ubarg(i,j,1)=ad_ubar(i,j,kout)
307 f_ubarg(i,j,2)=ad_ubar(i,j,kout)
308# else
309 f_ubarg(i,j,1)=f_ubarg(i,j,1)+fac1*ad_ubar(i,j,kout)
310 f_ubarg(i,j,2)=f_ubarg(i,j,2)+fac2*ad_ubar(i,j,kout)
311# endif
312 END DO
313 END DO
314 DO j=jstr,jendr
315 DO i=istrr,iendr
316# ifdef WEAK_NOINTERP
317 f_vbarg(i,j,1)=ad_vbar(i,j,kout)
318 f_vbarg(i,j,2)=ad_vbar(i,j,kout)
319# else
320 f_vbarg(i,j,1)=f_vbarg(i,j,1)+fac1*ad_vbar(i,j,kout)
321 f_vbarg(i,j,2)=f_vbarg(i,j,2)+fac2*ad_vbar(i,j,kout)
322# endif
323 END DO
324 END DO
325 ELSE
326 DO j=jstrr,jendr
327 DO i=istr,iendr
328# ifdef WEAK_NOINTERP
329 f_ubarg(i,j,1)=ad_ubar_sol(i,j)
330 f_ubarg(i,j,2)=ad_ubar_sol(i,j)
331# else
332 f_ubarg(i,j,1)=f_ubarg(i,j,1)+fac1*ad_ubar_sol(i,j)
333 f_ubarg(i,j,2)=f_ubarg(i,j,2)+fac2*ad_ubar_sol(i,j)
334# endif
335 END DO
336 END DO
337 DO j=jstr,jendr
338 DO i=istrr,iendr
339# ifdef WEAK_NOINTERP
340 f_vbarg(i,j,1)=ad_vbar_sol(i,j)
341 f_vbarg(i,j,2)=ad_vbar_sol(i,j)
342# else
343 f_vbarg(i,j,1)=f_vbarg(i,j,1)+fac1*ad_vbar_sol(i,j)
344 f_vbarg(i,j,2)=f_vbarg(i,j,2)+fac2*ad_vbar_sol(i,j)
345# endif
346 END DO
347 END DO
348 END IF
349# endif
350# ifdef SOLVE3D
351!
352! Gather 3D-momentum weak-constraint forcing terms.
353!
354 DO k=1,n(ng)
355 DO j=jstrr,jendr
356 DO i=istr,iendr
357# ifdef WEAK_NOINTERP
358 f_ug(i,j,k,1)=ad_u(i,j,k,nout)
359 f_ug(i,j,k,2)=ad_u(i,j,k,nout)
360# else
361 f_ug(i,j,k,1)=f_ug(i,j,k,1)+fac1*ad_u(i,j,k,nout)
362 f_ug(i,j,k,2)=f_ug(i,j,k,2)+fac2*ad_u(i,j,k,nout)
363# endif
364 END DO
365 END DO
366 END DO
367 DO k=1,n(ng)
368 DO j=jstr,jendr
369 DO i=istrr,iendr
370# ifdef WEAK_NOINTERP
371 f_vg(i,j,k,1)=ad_v(i,j,k,nout)
372 f_vg(i,j,k,2)=ad_v(i,j,k,nout)
373# else
374 f_vg(i,j,k,1)=f_vg(i,j,k,1)+fac1*ad_v(i,j,k,nout)
375 f_vg(i,j,k,2)=f_vg(i,j,k,2)+fac2*ad_v(i,j,k,nout)
376# endif
377 END DO
378 END DO
379 END DO
380!
381! Gather tracer weak-constraint forcing terms.
382!
383 DO itrc=1,nt(ng)
384 DO k=1,n(ng)
385 DO j=jstrr,jendr
386 DO i=istrr,iendr
387# ifdef WEAK_NOINTERP
388 f_tg(i,j,k,1,itrc)=ad_t(i,j,k,nout,itrc)
389 f_tg(i,j,k,2,itrc)=ad_t(i,j,k,nout,itrc)
390# else
391 f_tg(i,j,k,1,itrc)=f_tg(i,j,k,1,itrc)+ &
392 & fac1*ad_t(i,j,k,nout,itrc)
393 f_tg(i,j,k,2,itrc)=f_tg(i,j,k,2,itrc)+ &
394 & fac2*ad_t(i,j,k,nout,itrc)
395# endif
396 END DO
397 END DO
398 END DO
399 END DO
400# endif
401!
402 RETURN
mod_fourdvar
Definition mod_fourdvar.F:2
mod_fourdvar::forcetime
real(r8), dimension(:), allocatable forcetime
Definition mod_fourdvar.F:918
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_scalars
Definition mod_scalars.F:2
mod_scalars::day2sec
real(dp), parameter day2sec
Definition mod_scalars.F:816
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::dstart
real(dp) dstart
Definition mod_scalars.F:281
mod_scalars::ntend
integer, dimension(:), allocatable ntend
Definition mod_scalars.F:379
mod_scalars::lwrtstate2d
logical, dimension(:), allocatable lwrtstate2d
Definition mod_scalars.F:1020
mod_scalars::time
real(dp), dimension(:), allocatable time
Definition mod_scalars.F:262
mod_scalars::ntstart
integer, dimension(:), allocatable ntstart
Definition mod_scalars.F:378
mod_scalars::nadj
integer, dimension(:), allocatable nadj
Definition mod_scalars.F:1072
mod_stepping
Definition mod_stepping.F:2
mod_stepping::kstp
integer, dimension(:), allocatable kstp
Definition mod_stepping.F:66
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 mod_scalars::day2sec, mod_scalars::dstart, mod_scalars::dt, mod_fourdvar::forcetime, mod_scalars::iic, mod_stepping::kstp, mod_scalars::lwrtstate2d, mod_scalars::nadj, mod_stepping::nnew, mod_stepping::nstp, mod_scalars::ntend, mod_scalars::ntstart, and mod_scalars::time.

Referenced by frc_adgather().

Here is the caller graph for this function:

◆ frc_clear()

subroutine, public frc_weak_mod::frc_clear ( integer, intent(in) ng,
integer, intent(in) tile )

Definition at line 405 of file frc_weak.F.

406!
407!=======================================================================
408! !
409! This routine copy weak-constraint arrays (f_***G storage arrays) !
410! index 1 into index 2 and then clear index 1. !
411! !
412! On Input: !
413! !
414! ng Nested grid number. !
415! tile Domain partition. !
416! !
417!=======================================================================
418!
419 USE mod_param
420 USE mod_forces
421 USE mod_ocean
422!
423! Imported variable declarations.
424!
425 integer, intent(in) :: ng, tile
426!
427! Local variable declarations.
428!
429 character (len=*), parameter :: MyFile = &
430 & __FILE__//", frc_clear"
431!
432# include "tile.h"
433!
434# ifdef PROFILE
435 CALL wclock_on (ng, iadm, 7, __line__, myfile)
436# endif
437 CALL frc_clear_tile (ng, tile, &
438 & lbi, ubi, lbj, ubj, &
439 & imins, imaxs, jmins, jmaxs, &
440 & ocean(ng) % f_zetaG, &
441# ifdef SOLVE3D
442 & ocean(ng) % f_uG, &
443 & ocean(ng) % f_vG, &
444 & ocean(ng) % f_tG)
445# else
446 & ocean(ng) % f_ubarG, &
447 & ocean(ng) % f_vbarG)
448# endif
449# ifdef PROFILE
450 CALL wclock_off (ng, iadm, 7, __line__, myfile)
451# endif
452!
453 RETURN

References frc_clear_tile(), mod_param::iadm, mod_ocean::ocean, wclock_off(), and wclock_on().

Referenced by ad_main3d().

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

◆ frc_clear_tile()

subroutine frc_weak_mod::frc_clear_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,
real(r8), dimension(lbi:,lbj:,:), intent(inout) f_zetag,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) f_ug,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) f_vg,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) f_tg )
private

Definition at line 457 of file frc_weak.F.

463# else
464 & f_ubarg, f_vbarg)
465# endif
466!***********************************************************************
467!
468 USE mod_param
469 USE mod_scalars
470 USE mod_stepping
471 USE mod_fourdvar
472!
473! Imported variable declarations.
474!
475 integer, intent(in) :: ng, tile
476 integer, intent(in) :: LBi, UBi, LBj, UBj
477 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
478!
479# ifdef ASSUMED_SHAPE
480 real(r8), intent(inout) :: f_zetaG(LBi:,LBj:,:)
481# ifdef SOLVE3D
482 real(r8), intent(inout) :: f_uG(LBi:,LBj:,:,:)
483 real(r8), intent(inout) :: f_vG(LBi:,LBj:,:,:)
484 real(r8), intent(inout) :: f_tG(LBi:,LBj:,:,:,:)
485# else
486 real(r8), intent(inout) :: f_ubarG(LBi:,LBj:,:)
487 real(r8), intent(inout) :: f_vbarG(LBi:,LBj:,:)
488# endif
489# else
490 real(r8), intent(inout) :: f_zetaG(LBi:UBi,LBj:UBj,2)
491# ifdef SOLVE3D
492 real(r8), intent(inout) :: f_uG(LBi:UBi,LBj:UBj,N(ng),2)
493 real(r8), intent(inout) :: f_vG(LBi:UBi,LBj:UBj,N(ng),2)
494 real(r8), intent(inout) :: f_tG(LBi:UBi,LBj:UBj,N(ng),2,NT(ng))
495# else
496 real(r8), intent(inout) :: f_ubarG(LBi:UBi,LBj:UBj,2)
497 real(r8), intent(inout) :: f_vbarG(LBi:UBi,LBj:UBj,2)
498# endif
499# endif
500!
501! Local variable declarations.
502!
503 integer :: i, it1, it2, j, k, kout, nout
504# ifdef SOLVE3D
505 integer :: itrc
506# endif
507 real(r8) :: fac, fac1, fac2, time1, time2
508
509# include "set_bounds.h"
510!
511!-----------------------------------------------------------------------
512! Copy weak-constraint forcing arrays index 1 into index 2, and
513! clear index 1.
514!-----------------------------------------------------------------------
515!
516! Reset weak-constraing forcing time on last timestep.
517!
518 IF (iic(ng).eq.ntend(ng)) THEN
519 forcetime(ng)=dstart*day2sec
520 END IF
521!
522! Update free-surface weak-constraint forcing terms.
523!
524 DO j=jstrr,jendr
525 DO i=istrr,iendr
526 f_zetag(i,j,2)=f_zetag(i,j,1)
527 f_zetag(i,j,1)=0.0_r8
528 END DO
529 END DO
530
531# ifndef SOLVE3D
532!
533! Update 2D-momentum weak-constraint forcing terms.
534!
535 DO j=jstrr,jendr
536 DO i=istr,iendr
537 f_ubarg(i,j,2)=f_ubarg(i,j,1)
538 f_ubarg(i,j,1)=0.0_r8
539 END DO
540 END DO
541 DO j=jstr,jendr
542 DO i=istrr,iendr
543 f_vbarg(i,j,2)=f_vbarg(i,j,1)
544 f_vbarg(i,j,1)=0.0_r8
545 END DO
546 END DO
547# endif
548# ifdef SOLVE3D
549!
550! Update 3D-momentum weak-constraint forcing terms.
551!
552 DO k=1,n(ng)
553 DO j=jstrr,jendr
554 DO i=istr,iendr
555 f_ug(i,j,k,2)=f_ug(i,j,k,1)
556 f_ug(i,j,k,1)=0.0_r8
557 END DO
558 END DO
559 DO j=jstr,jendr
560 DO i=istrr,iendr
561 f_vg(i,j,k,2)=f_vg(i,j,k,1)
562 f_vg(i,j,k,1)=0.0_r8
563 END DO
564 END DO
565 END DO
566!
567! Update tracer weak-constraint forcing terms.
568!
569 DO itrc=1,nt(ng)
570 DO k=1,n(ng)
571 DO j=jstrr,jendr
572 DO i=istrr,iendr
573 f_tg(i,j,k,2,itrc)=f_tg(i,j,k,1,itrc)
574 f_tg(i,j,k,1,itrc)=0.0_r8
575 END DO
576 END DO
577 END DO
578 END DO
579# endif
580!
581 RETURN

References mod_scalars::day2sec, mod_scalars::dstart, mod_fourdvar::forcetime, mod_scalars::iic, and mod_scalars::ntend.

Referenced by frc_clear().

Here is the caller graph for this function: