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

Functions/Subroutines

subroutine, public tl_ini_fields (ng, tile, model)
 
subroutine tl_ini_fields_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kstp, krhs, knew, nstp, nnew, rmask, umask, vmask, hz, tl_hz, tl_t, u, tl_u, v, tl_v, ubar, tl_ubar, vbar, tl_vbar, zeta, tl_zeta)
 
subroutine, public tl_ini_zeta (ng, tile, model)
 
subroutine tl_ini_zeta_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kstp, krhs, knew, rmask, h, tl_bed, tl_bed_thick0, tl_bed_thick, tl_zt_avg1, zeta, tl_zeta)
 
subroutine, public tl_set_zeta_timeavg (ng, tile, model)
 
subroutine tl_set_zeta_timeavg_tile (ng, tile, model, lbi, ubi, lbj, ubj, kstp, tl_zt_avg1, tl_zeta)
 

Function/Subroutine Documentation

◆ tl_ini_fields()

subroutine, public tl_ini_fields_mod::tl_ini_fields ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 64 of file tl_ini_fields.F.

65!***********************************************************************
66!
67 USE mod_stepping
68!
69! Imported variable declarations.
70!
71 integer, intent(in) :: ng, tile, model
72!
73! Local variable declarations.
74!
75 character (len=*), parameter :: MyFile = &
76 & __FILE__
77!
78# include "tile.h"
79!
80# ifdef PROFILE
81 CALL wclock_on (ng, model, 2, __line__, myfile)
82# endif
83 CALL tl_ini_fields_tile (ng, tile, model, &
84 & lbi, ubi, lbj, ubj, &
85 & imins, imaxs, jmins, jmaxs, &
86 & kstp(ng), krhs(ng), knew(ng), &
87# ifdef SOLVE3D
88 & nstp(ng), nnew(ng), &
89# endif
90# ifdef MASKING
91 & grid(ng) % rmask, &
92 & grid(ng) % umask, &
93 & grid(ng) % vmask, &
94# endif
95# ifdef SOLVE3D
96 & grid(ng) % Hz, &
97 & grid(ng) % tl_Hz, &
98 & ocean(ng) % tl_t, &
99 & ocean(ng) % u, &
100 & ocean(ng) % tl_u, &
101 & ocean(ng) % v, &
102 & ocean(ng) % tl_v, &
103# endif
104 & ocean(ng) % ubar, &
105 & ocean(ng) % tl_ubar, &
106 & ocean(ng) % vbar, &
107 & ocean(ng) % tl_vbar, &
108 & ocean(ng) % zeta, &
109 & ocean(ng) % tl_zeta)
110# ifdef PROFILE
111 CALL wclock_off (ng, model, 2, __line__, myfile)
112# endif
113!
114 RETURN
mod_stepping
Definition mod_stepping.F:2
mod_stepping::kstp
integer, dimension(:), allocatable kstp
Definition mod_stepping.F:66
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::krhs
integer, dimension(:), allocatable krhs
Definition mod_stepping.F:65
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
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 mod_grid::grid, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_stepping::nnew, mod_stepping::nstp, mod_ocean::ocean, tl_ini_fields_tile(), wclock_off(), and wclock_on().

Referenced by tl_post_initial_mod::tl_post_initial().

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

◆ tl_ini_fields_tile()

subroutine tl_ini_fields_mod::tl_ini_fields_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
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) kstp,
integer, intent(in) krhs,
integer, intent(in) knew,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:,lbj:), intent(in) rmask,
real(r8), dimension(lbi:,lbj:), intent(in) umask,
real(r8), dimension(lbi:,lbj:), intent(in) vmask,
real(r8), dimension(lbi:,lbj:,:), intent(in) hz,
real(r8), dimension(lbi:,lbj:,:), intent(in) tl_hz,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) tl_t,
real(r8), dimension(lbi:,lbj:,:,:), intent(in) u,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_u,
real(r8), dimension(lbi:,lbj:,:,:), intent(in) v,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_v,
real(r8), dimension(lbi:,lbj:,:), intent(in) ubar,
real(r8), dimension(lbi:,lbj:,:), intent(inout) tl_ubar,
real(r8), dimension(lbi:,lbj:,:), intent(in) vbar,
real(r8), dimension(lbi:,lbj:,:), intent(inout) tl_vbar,
real(r8), dimension(lbi:,lbj:,:), intent(in) zeta,
real(r8), dimension(lbi:,lbj:,:), intent(in) tl_zeta )
private

Definition at line 118 of file tl_ini_fields.F.

137!***********************************************************************
138!
139! Imported variable declarations.
140!
141 integer, intent(in) :: ng, tile, model
142 integer, intent(in) :: LBi, UBi, LBj, UBj
143 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
144 integer, intent(in) :: kstp, krhs, knew
145# ifdef SOLVE3D
146 integer, intent(in) :: nstp, nnew
147# endif
148!
149# ifdef ASSUMED_SHAPE
150# ifdef MASKING
151 real(r8), intent(in) :: rmask(LBi:,LBj:)
152 real(r8), intent(in) :: umask(LBi:,LBj:)
153 real(r8), intent(in) :: vmask(LBi:,LBj:)
154# endif
155# ifdef SOLVE3D
156 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
157 real(r8), intent(in) :: tl_Hz(LBi:,LBj:,:)
158 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
159 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
160# endif
161 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
162 real(r8), intent(in) :: vbar(LBi:,LBj:,:)
163 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
164 real(r8), intent(in) :: tl_zeta(LBi:,LBj:,:)
165# ifdef SOLVE3D
166 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
167 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
168 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
169# endif
170 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
171 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
172
173# else
174
175# ifdef MASKING
176 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
177 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
178 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
179# endif
180# ifdef SOLVE3D
181 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
182 real(r8), intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
183 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
184 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
185# endif
186 real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
187 real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
188 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
189 real(r8), intent(in) :: tl_zeta(LBi:UBi,LBj:UBj,:)
190# ifdef SOLVE3D
191 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
192 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
193 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
194# endif
195 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
196 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
197# endif
198!
199! Local variable declarations.
200!
201 integer :: i, ic, itrc, j, k
202
203 real(r8) :: cff1
204 real(r8) :: tl_cff1, tl_cff2
205
206# ifdef SOLVE3D
207 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: CF
208 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC
209
210 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: tl_CF
211 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: tl_DC
212# endif
213
214# include "set_bounds.h"
215
216# ifdef SOLVE3D
217!
218!-----------------------------------------------------------------------
219! Initialize other time levels for 3D momentum.
220!-----------------------------------------------------------------------
221!
222 DO j=jstrb,jendb
223 DO k=1,n(ng)
224 DO i=istrm,iendb
225!^ cff1=u(i,j,k,nstp)
226!^
227 tl_cff1=tl_u(i,j,k,nstp)
228# ifdef MASKING
229!^ cff1=cff1*umask(i,j)
230!^
231 tl_cff1=tl_cff1*umask(i,j)
232# endif
233!^ u(i,j,k,nstp)=cff1
234!^
235 tl_u(i,j,k,nstp)=tl_cff1
236 END DO
237 END DO
238!
239 IF (j.ge.jstrm) THEN
240 DO k=1,n(ng)
241 DO i=istrb,iendb
242!^ cff2=v(i,j,k,nstp)
243!^
244 tl_cff2=tl_v(i,j,k,nstp)
245# ifdef MASKING
246!^ cff2=cff2*vmask(i,j)
247!^
248 tl_cff2=tl_cff2*vmask(i,j)
249# endif
250!^ v(i,j,k,nstp)=cff2
251!^
252 tl_v(i,j,k,nstp)=tl_cff2
253 END DO
254 END DO
255 END IF
256 END DO
257!
258! Apply boundary conditions.
259!
260!^ CALL u3dbc_tile (ng, tile, &
261!^ & LBi, UBi, LBj, UBj, N(ng), &
262!^ & IminS, ImaxS, JminS, JmaxS, &
263!^ & nstp, nstp, &
264!^ & u)
265!^
266 CALL tl_u3dbc_tile (ng, tile, &
267 & lbi, ubi, lbj, ubj, n(ng), &
268 & imins, imaxs, jmins, jmaxs, &
269 & nstp, nstp, &
270 & tl_u)
271!^ CALL v3dbc_tile (ng, tile, &
272!^ & LBi, UBi, LBj, UBj, N(ng), &
273!^ & IminS, ImaxS, JminS, JmaxS, &
274!^ & nstp, nstp, &
275!^ & v)
276!^
277 CALL tl_v3dbc_tile (ng, tile, &
278 & lbi, ubi, lbj, ubj, n(ng), &
279 & imins, imaxs, jmins, jmaxs, &
280 & nstp, nstp, &
281 & tl_v)
282!
283 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
284!^ CALL exchange_u3d_tile (ng, tile, &
285!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
286!^ & u(:,:,:,nstp))
287!^
288 CALL exchange_u3d_tile (ng, tile, &
289 & lbi, ubi, lbj, ubj, 1, n(ng), &
290 & tl_u(:,:,:,nstp))
291!^ CALL exchange_v3d_tile (ng, tile, &
292!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
293!^ & v(:,:,:,nstp))
294!^
295 CALL exchange_v3d_tile (ng, tile, &
296 & lbi, ubi, lbj, ubj, 1, n(ng), &
297 & tl_v(:,:,:,nstp))
298 END IF
299
300# ifdef DISTRIBUTE
301!
302!^ CALL mp_exchange3d (ng, tile, model, 2, &
303!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
304!^ & NghostPoints, &
305!^ & EWperiodic(ng), NSperiodic(ng), &
306!^ & u(:,:,:,nstp), v(:,:,:,nstp))
307!^
308 CALL mp_exchange3d (ng, tile, model, 2, &
309 & lbi, ubi, lbj, ubj, 1, n(ng), &
310 & nghostpoints, &
311 & ewperiodic(ng), nsperiodic(ng), &
312 & tl_u(:,:,:,nstp), tl_v(:,:,:,nstp))
313# endif
314# endif
315
316# ifdef SOLVE3D
317!
318!-----------------------------------------------------------------------
319! Compute vertically-integrated momentum (tl_ubar, tl_vbar) from
320! initial 3D momentum (tl_u, tl_v).
321!-----------------------------------------------------------------------
322!
323! Here DC(i,1:N) are the grid cell thicknesses, DC(i,0) is the total
324! depth of the water column, and CF(i,0) is the vertical integral.
325!
326# if defined STOCHASTIC_OPT && !defined STOCH_OPT_WHITE
327 IF (soinitial(ng)) THEN
328# endif
329 DO j=jstrb,jendb
330 DO i=istrm,iendb
331 dc(i,0)=0.0_r8
332 tl_dc(i,0)=0.0_r8
333 cf(i,0)=0.0_r8
334 tl_cf(i,0)=0.0_r8
335 END DO
336 DO k=1,n(ng)
337 DO i=istrm,iendb
338 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i-1,j,k))
339 tl_dc(i,k)=0.5_r8*(tl_hz(i,j,k)+tl_hz(i-1,j,k))
340 dc(i,0)=dc(i,0)+dc(i,k)
341 tl_dc(i,0)=tl_dc(i,0)+tl_dc(i,k)
342 cf(i,0)=cf(i,0)+dc(i,k)*u(i,j,k,nstp)
343 tl_cf(i,0)=tl_cf(i,0)+tl_dc(i,k)*u(i,j,k,nstp)+ &
344 & dc(i,k)*tl_u(i,j,k,nstp)
345 END DO
346 END DO
347 DO i=istrm,iendb
348 cff1=1.0_r8/dc(i,0)
349 tl_cff1=-cff1*cff1*tl_dc(i,0)
350!^ cff2=CF(i,0)*cff1
351!^
352 tl_cff2=tl_cf(i,0)*cff1+cf(i,0)*tl_cff1
353# ifdef MASKING
354!^ cff2=cff2*umask(i,j)
355!^
356 tl_cff2=tl_cff2*umask(i,j)
357# endif
358!^ ubar(i,j,kstp)=cff2
359!^
360 tl_ubar(i,j,kstp)=tl_cff2
361 END DO
362!
363 IF (j.ge.jstrm) THEN
364 DO i=istrb,iendb
365 dc(i,0)=0.0_r8
366 tl_dc(i,0)=0.0_r8
367 cf(i,0)=0.0_r8
368 tl_cf(i,0)=0.0_r8
369 END DO
370 DO k=1,n(ng)
371 DO i=istrb,iendb
372 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i,j-1,k))
373 tl_dc(i,k)=0.5_r8*(tl_hz(i,j,k)+tl_hz(i,j-1,k))
374 dc(i,0)=dc(i,0)+dc(i,k)
375 tl_dc(i,0)=tl_dc(i,0)+tl_dc(i,k)
376 cf(i,0)=cf(i,0)+dc(i,k)*v(i,j,k,nstp)
377 tl_cf(i,0)=tl_cf(i,0)+tl_dc(i,k)*v(i,j,k,nstp)+ &
378 & dc(i,k)*tl_v(i,j,k,nstp)
379 END DO
380 END DO
381 DO i=istrb,iendb
382 cff1=1.0_r8/dc(i,0)
383 tl_cff1=-cff1*cff1*tl_dc(i,0)
384!^ cff2=CF(i,0)*cff1
385!^
386 tl_cff2=tl_cf(i,0)*cff1+cf(i,0)*tl_cff1
387# ifdef MASKING
388!^ cff2=cff2*vmask(i,j)
389!^
390 tl_cff2=tl_cff2*vmask(i,j)
391# endif
392!^ vbar(i,j,kstp)=cff2
393!^
394 tl_vbar(i,j,kstp)=tl_cff2
395 END DO
396 END IF
397 END DO
398!
399! Apply boundary conditions.
400!
401 IF (.not.(any(tl_lbc(:,isubar,ng)%radiation).or. &
402 & any(tl_lbc(:,isvbar,ng)%radiation).or. &
403 & any(tl_lbc(:,isubar,ng)%Flather).or. &
404 & any(tl_lbc(:,isvbar,ng)%Flather))) THEN
405!^ CALL u2dbc_tile (ng, tile, &
406!^ & LBi, UBi, LBj, UBj, &
407!^ & IminS, ImaxS, JminS, JmaxS, &
408!^ & krhs, kstp, kstp, &
409!^ & ubar, vbar, zeta)
410!^
411 CALL tl_u2dbc_tile (ng, tile, &
412 & lbi, ubi, lbj, ubj, &
413 & imins, imaxs, jmins, jmaxs, &
414 & krhs, kstp, kstp, &
415 & ubar, vbar, zeta, &
416 & tl_ubar, tl_vbar, tl_zeta)
417!^ CALL v2dbc_tile (ng, tile, &
418!^ & LBi, UBi, LBj, UBj, &
419!^ & IminS, ImaxS, JminS, JmaxS, &
420!^ & krhs, kstp, kstp, &
421!^ & ubar, vbar, zeta)
422!^
423 CALL tl_v2dbc_tile (ng, tile, &
424 & lbi, ubi, lbj, ubj, &
425 & imins, imaxs, jmins, jmaxs, &
426 & krhs, kstp, kstp, &
427 & ubar, vbar, zeta, &
428 & tl_ubar, tl_vbar, tl_zeta)
429 END IF
430!
431 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
432!^ CALL exchange_u2d_tile (ng, tile, &
433!^ & LBi, UBi, LBj, UBj, &
434!^ & ubar(:,:,kstp))
435!^
436 CALL exchange_u2d_tile (ng, tile, &
437 & lbi, ubi, lbj, ubj, &
438 & tl_ubar(:,:,kstp))
439!^ CALL exchange_v2d_tile (ng, tile, &
440!^ & LBi, UBi, LBj, UBj, &
441!^ & vbar(:,:,kstp))
442!^
443 CALL exchange_v2d_tile (ng, tile, &
444 & lbi, ubi, lbj, ubj, &
445 & tl_vbar(:,:,kstp))
446 END IF
447
448# ifdef DISTRIBUTE
449!
450!^ CALL mp_exchange2d (ng, tile, model, 2, &
451!^ & LBi, UBi, LBj, UBj, &
452!^ & NghostPoints, &
453!^ & EWperiodic(ng), NSperiodic(ng), &
454!^ & ubar(:,:,kstp), vbar(:,:,kstp))
455!^
456 CALL mp_exchange2d (ng, tile, model, 2, &
457 & lbi, ubi, lbj, ubj, &
458 & nghostpoints, &
459 & ewperiodic(ng), nsperiodic(ng), &
460 & tl_ubar(:,:,kstp), tl_vbar(:,:,kstp))
461# endif
462
463# if defined STOCHASTIC_OPT && !defined STOCH_OPT_WHITE
464 END IF
465# endif
466
467# else
468!
469!-----------------------------------------------------------------------
470! Initialize other time levels for 2D momentum (shallow-water model).
471!-----------------------------------------------------------------------
472!
473 DO j=jstrb,jendb
474 DO i=istrm,iendb
475!^ cff1=ubar(i,j,kstp)
476!^
477 tl_cff1=tl_ubar(i,j,kstp)
478# ifdef MASKING
479!^ cff1=cff1*umask(i,j)
480!^
481 tl_cff1=tl_cff1*umask(i,j)
482# endif
483!^ ubar(i,j,kstp)=cff1
484!^
485 tl_ubar(i,j,kstp)=tl_cff1
486 END DO
487!
488 IF (j.ge.jstrm) THEN
489 DO i=istrb,iendb
490!^ cff2=vbar(i,j,kstp)
491!^
492 tl_cff2=tl_vbar(i,j,kstp)
493# ifdef MASKING
494!^ cff2=cff2*vmask(i,j)
495!^
496 tl_cff2=tl_cff2*vmask(i,j)
497# endif
498!^ vbar(i,j,kstp)=cff2
499!^
500 tl_vbar(i,j,kstp)=tl_cff2
501 END DO
502 END IF
503 END DO
504!
505! Apply boundary conditions.
506!
507 IF (.not.(any(tl_lbc(:,isubar,ng)%radiation).or. &
508 & any(tl_lbc(:,isvbar,ng)%radiation).or. &
509 & any(tl_lbc(:,isubar,ng)%Flather).or. &
510 & any(tl_lbc(:,isvbar,ng)%Flather))) THEN
511!^ CALL u2dbc_tile (ng, tile, &
512!^ & LBi, UBi, LBj, UBj, &
513!^ & IminS, ImaxS, JminS, JmaxS, &
514!^ & krhs, kstp, kstp, &
515!^ & ubar, vbar, zeta)
516!^
517 CALL tl_u2dbc_tile (ng, tile, &
518 & lbi, ubi, lbj, ubj, &
519 & imins, imaxs, jmins, jmaxs, &
520 & krhs, kstp, kstp, &
521 & ubar, vbar, zeta, &
522 & tl_ubar, tl_vbar, tl_zeta)
523!^ CALL v2dbc_tile (ng, tile, &
524!^ & LBi, UBi, LBj, UBj, &
525!^ & IminS, ImaxS, JminS, JmaxS, &
526!^ & krhs, kstp, kstp, &
527!^ & ubar, vbar, zeta)
528!^
529 CALL tl_v2dbc_tile (ng, tile, &
530 & lbi, ubi, lbj, ubj, &
531 & imins, imaxs, jmins, jmaxs, &
532 & krhs, kstp, kstp, &
533 & ubar, vbar, zeta, &
534 & tl_ubar, tl_vbar, tl_zeta)
535 END IF
536!
537 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
538!^ CALL exchange_u2d_tile (ng, tile, &
539!^ & LBi, UBi, LBj, UBj, &
540!^ & ubar(:,:,kstp))
541!^
542 CALL exchange_u2d_tile (ng, tile, &
543 & lbi, ubi, lbj, ubj, &
544 & tl_ubar(:,:,kstp))
545!^ CALL exchange_v2d_tile (ng, tile, &
546!^ & LBi, UBi, LBj, UBj, &
547!^ & vbar(:,:,kstp))
548!^
549 CALL exchange_v2d_tile (ng, tile, &
550 & lbi, ubi, lbj, ubj, &
551 & tl_vbar(:,:,kstp))
552 END IF
553
554# ifdef DISTRIBUTE
555!
556!^ CALL mp_exchange2d (ng, tile, model, 2, &
557!^ & LBi, UBi, LBj, UBj, &
558!^ & NghostPoints, &
559!^ & EWperiodic(ng), NSperiodic(ng), &
560!^ & ubar(:,:,kstp), vbar(:,:,kstp))
561!^
562 CALL mp_exchange2d (ng, tile, model, 2, &
563 & lbi, ubi, lbj, ubj, &
564 & nghostpoints, &
565 & ewperiodic(ng), nsperiodic(ng), &
566 & tl_ubar(:,:,kstp), tl_vbar(:,:,kstp))
567# endif
568# endif
569
570# ifdef SOLVE3D
571!
572!-----------------------------------------------------------------------
573! Initialize other time levels for tracers.
574!-----------------------------------------------------------------------
575!
576 ic=0
577 DO itrc=1,nt(ng)
578 IF (ltracerclm(itrc,ng).and.lnudgetclm(itrc,ng)) THEN
579 ic=ic+1 ! OBC nudging coefficient index
580 END IF
581 DO k=1,n(ng)
582 DO j=jstrb,jendb
583 DO i=istrb,iendb
584!^ cff1=t(i,j,k,nstp,itrc)
585!^
586 tl_cff1=tl_t(i,j,k,nstp,itrc)
587# ifdef MASKING
588 tl_cff1=tl_cff1*rmask(i,j)
589# endif
590!^ t(i,j,k,nstp,itrc)=cff1
591!^
592 tl_t(i,j,k,nstp,itrc)=tl_cff1
593 END DO
594 END DO
595 END DO
596!
597! Apply boundary conditions.
598!
599!^ CALL t3dbc_tile (ng, tile, itrc, ic, &
600!^ & LBi, UBi, LBj, UBj, N(ng), NT(ng), &
601!^ & IminS, ImaxS, JminS, JmaxS, &
602!^ & nstp, nstp, &
603!^ & t)
604!^
605 CALL tl_t3dbc_tile (ng, tile, itrc, ic, &
606 & lbi, ubi, lbj, ubj, n(ng), nt(ng), &
607 & imins, imaxs, jmins, jmaxs, &
608 & nstp, nstp, &
609 & tl_t)
610!
611 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
612!^ CALL exchange_r3d_tile (ng, tile, &
613!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
614!^ & t(:,:,:,nstp,itrc))
615!^
616 CALL exchange_r3d_tile (ng, tile, &
617 & lbi, ubi, lbj, ubj, 1, n(ng), &
618 & tl_t(:,:,:,nstp,itrc))
619 END IF
620 END DO
621
622# ifdef DISTRIBUTE
623!
624!^ CALL mp_exchange4d (ng, tile, model, 1, &
625!^ & LBi, UBi, LBj, UBj, 1, N(ng), 1, NT(ng), &
626!^ & NghostPoints, &
627!^ & EWperiodic(ng), NSperiodic(ng), &
628!^ & t(:,:,:,nstp,:))
629!^
630 CALL mp_exchange4d (ng, tile, model, 1, &
631 & lbi, ubi, lbj, ubj, 1, n(ng), 1, nt(ng), &
632 & nghostpoints, &
633 & ewperiodic(ng), nsperiodic(ng), &
634 & tl_t(:,:,:,nstp,:))
635# endif
636# endif
637!
638 RETURN

References mod_scalars::ewperiodic, exchange_3d_mod::exchange_r3d_tile(), exchange_2d_mod::exchange_u2d_tile(), exchange_3d_mod::exchange_u3d_tile(), exchange_2d_mod::exchange_v2d_tile(), exchange_3d_mod::exchange_v3d_tile(), mod_ncparam::isubar, mod_ncparam::isvbar, mod_scalars::lnudgetclm, mod_scalars::ltracerclm, mp_exchange_mod::mp_exchange2d(), mp_exchange_mod::mp_exchange3d(), mp_exchange_mod::mp_exchange4d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::tl_lbc, tl_t3dbc_mod::tl_t3dbc_tile(), tl_u2dbc_mod::tl_u2dbc_tile(), tl_u3dbc_mod::tl_u3dbc_tile(), tl_v2dbc_mod::tl_v2dbc_tile(), and tl_v3dbc_mod::tl_v3dbc_tile().

Referenced by tl_ini_fields().

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

◆ tl_ini_zeta()

subroutine, public tl_ini_fields_mod::tl_ini_zeta ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 643 of file tl_ini_fields.F.

644!***********************************************************************
645!
646 USE mod_stepping
647!
648! Imported variable declarations.
649!
650 integer, intent(in) :: ng, tile, model
651!
652! Local variable declarations.
653!
654 character (len=*), parameter :: MyFile = &
655 & __FILE__//", tl_ini_zeta"
656!
657# include "tile.h"
658!
659# ifdef PROFILE
660 CALL wclock_on (ng, model, 2, __line__, myfile)
661# endif
662 CALL tl_ini_zeta_tile (ng, tile, model, &
663 & lbi, ubi, lbj, ubj, &
664 & imins, imaxs, jmins, jmaxs, &
665 & kstp(ng), krhs(ng), knew(ng), &
666# ifdef MASKING
667 & grid(ng) % rmask, &
668# endif
669# ifdef WET_DRY_NOT_YET
670 & grid(ng) % h, &
671# endif
672# ifdef SOLVE3D
673# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
674 & sedbed(ng) % tl_bed, &
675 & sedbed(ng) % tl_bed_thick0, &
676 & sedbed(ng) % tl_bed_thick, &
677# endif
678 & coupling(ng) % tl_Zt_avg1, &
679# endif
680 & ocean(ng) % zeta, &
681 & ocean(ng) % tl_zeta)
682# ifdef PROFILE
683 CALL wclock_off (ng, model, 2, __line__, myfile)
684# endif
685!
686 RETURN

References mod_coupling::coupling, mod_grid::grid, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_ocean::ocean, mod_sedbed::sedbed, tl_ini_zeta_tile(), wclock_off(), and wclock_on().

Referenced by tl_post_initial_mod::tl_post_initial().

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

◆ tl_ini_zeta_tile()

subroutine tl_ini_fields_mod::tl_ini_zeta_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
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) kstp,
integer, intent(in) krhs,
integer, intent(in) knew,
real(r8), dimension(lbi:,lbj:), intent(in) rmask,
real(r8), dimension(lbi:,lbj:), intent(in) h,
real(r8), dimension(lbi:,lbj:,:,:), intent(in) tl_bed,
real(r8), dimension(lbi:,lbj:), intent(inout) tl_bed_thick0,
real(r8), dimension(lbi:,lbj:,:), intent(inout) tl_bed_thick,
real(r8), dimension(lbi:,lbj:), intent(inout) tl_zt_avg1,
real(r8), dimension(lbi:,lbj:,:), intent(in) zeta,
real(r8), dimension(lbi:,lbj:,:), intent(inout) tl_zeta )
private

Definition at line 690 of file tl_ini_fields.F.

708!***********************************************************************
709!
710! Imported variable declarations.
711!
712 integer, intent(in) :: ng, tile, model
713 integer, intent(in) :: LBi, UBi, LBj, UBj
714 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
715 integer, intent(in) :: kstp, krhs, knew
716!
717# ifdef ASSUMED_SHAPE
718# ifdef MASKING
719 real(r8), intent(in) :: rmask(LBi:,LBj:)
720# endif
721# ifdef WET_DRY_NOT_YET
722 real(r8), intent(in) :: h(LBi:,LBj:)
723# endif
724 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
725# ifdef SOLVE3D
726# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
727 real(r8), intent(in) :: tl_bed(LBi:,LBj:,:,:)
728 real(r8), intent(inout) :: tl_bed_thick0(LBi:,LBj:)
729 real(r8), intent(inout) :: tl_bed_thick(LBi:,LBj:,:)
730# endif
731 real(r8), intent(inout) :: tl_Zt_avg1(LBi:,LBj:)
732# endif
733 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
734
735# else
736
737# ifdef MASKING
738 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
739# endif
740# ifdef WET_DRY_NOT_YET
741 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
742# endif
743 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
744# ifdef SOLVE3D
745# if defined SOLVE3D && defined SEDIMENT && defined SED_MORPH
746 real(r8), intent(in) :: tl_bed(LBi:UBi,LBj:UBj,Nbed,MBEDP)
747 real(r8), intent(inout) :: tl_bed_thick0(LBi:UBi,LBj:UBj)
748 real(r8), intent(inout) :: tl_bed_thick(LBi:UBi,LBj:UBj,3)
749# endif
750 real(r8), intent(inout) :: tl_Zt_avg1(LBi:UBi,LBj:UBj)
751# endif
752 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
753# endif
754!
755! Local variable declarations.
756!
757 integer :: Imin, Imax, Jmin, Jmax
758 integer :: i, j, kbed
759
760 real(r8) :: cff1
761 real(r8) :: tl_cff1
762
763# include "set_bounds.h"
764!
765!-----------------------------------------------------------------------
766! Initialize other time levels for free-surface.
767!-----------------------------------------------------------------------
768!
769 IF (.not.(any(tl_lbc(:,isfsur,ng)%radiation).or. &
770 & any(tl_lbc(:,isfsur,ng)%Chapman_explicit).or. &
771 & any(tl_lbc(:,isfsur,ng)%Chapman_implicit))) THEN
772 imin=istrb
773 imax=iendb
774 jmin=jstrb
775 jmax=jendb
776 ELSE
777 imin=istrt
778 imax=iendt
779 jmin=jstrt
780 jmax=jendt
781 END IF
782 DO j=jmin,jmax
783 DO i=imin,imax
784!^ cff1=zeta(i,j,kstp)
785!^
786 tl_cff1=tl_zeta(i,j,kstp)
787# ifdef MASKING
788!^ cff1=cff1*rmask(i,j)
789!^
790 tl_cff1=tl_cff1*rmask(i,j)
791# endif
792!^ zeta(i,j,kstp)=cff1
793!^
794 tl_zeta(i,j,kstp)=tl_cff1
795 END DO
796 END DO
797!
798! Apply boundary conditions.
799!
800 IF (.not.(any(tl_lbc(:,isfsur,ng)%radiation).or. &
801 & any(tl_lbc(:,isfsur,ng)%Chapman_explicit).or. &
802 & any(tl_lbc(:,isfsur,ng)%Chapman_implicit))) THEN
803!^ CALL zetabc_tile (ng, tile, &
804!^ & LBi, UBi, LBj, UBj, &
805!^ & IminS, ImaxS, JminS, JmaxS, &
806!^ & krhs, kstp, kstp, &
807!^ & zeta)
808!^
809 CALL tl_zetabc_tile (ng, tile, &
810 & lbi, ubi, lbj, ubj, &
811 & imins, imaxs, jmins, jmaxs, &
812 & krhs, kstp, kstp, &
813 & zeta, &
814 & tl_zeta)
815 END IF
816!
817 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
818!^ CALL exchange_r2d_tile (ng, tile, &
819!^ & LBi, UBi, LBj, UBj, &
820!^ & zeta(:,:,kstp))
821!^
822 CALL exchange_r2d_tile (ng, tile, &
823 & lbi, ubi, lbj, ubj, &
824 & tl_zeta(:,:,kstp))
825 END IF
826
827# ifdef DISTRIBUTE
828!
829!^ CALL mp_exchange2d (ng, tile, model, 1, &
830!^ & LBi, UBi, LBj, UBj, &
831!^ & NghostPoints, &
832!^ & EWperiodic(ng), NSperiodic(ng), &
833!^ & zeta(:,:,kstp))
834!^
835 CALL mp_exchange2d (ng, tile, model, 1, &
836 & lbi, ubi, lbj, ubj, &
837 & nghostpoints, &
838 & ewperiodic(ng), nsperiodic(ng), &
839 & tl_zeta(:,:,kstp))
840# endif
841
842# ifdef SOLVE3D
843!
844!-----------------------------------------------------------------------
845! Initialize fast-time averaged free-surface (Zt_avg1) with the inital
846! free-surface
847!-----------------------------------------------------------------------
848!
849 CALL tl_set_zeta_timeavg (ng, tile, model)
850
851# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
852!
853!-----------------------------------------------------------------------
854! Compute initial total thickness for all sediment bed layers.
855!-----------------------------------------------------------------------
856!
857 DO j=jstrt,jendt
858 DO i=istrt,iendt
859!^ bed_thick0(i,j)=0.0_r8
860!^
861 tl_bed_thick0(i,j)=0.0_r8
862 DO kbed=1,nbed
863!^ bed_thick0(i,j)=bed_thick0(i,j)+bed(i,j,kbed,ithck)
864!^
865 tl_bed_thick0(i,j)=tl_bed_thick0(i,j)+tl_bed(i,j,kbed,ithck)
866 END DO
867!^ bed_thick(i,j,1)=bed_thick0(i,j)
868!^ bed_thick(i,j,2)=bed_thick0(i,j)
869!^ bed_thick(i,j,3)=bed_thick0(i,j)
870!^
871 tl_bed_thick(i,j,1)=tl_bed_thick0(i,j)
872 tl_bed_thick(i,j,2)=tl_bed_thick0(i,j)
873 tl_bed_thick(i,j,3)=tl_bed_thick0(i,j)
874 END DO
875 END DO
876!
877 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
878!^ CALL exchange_r2d_tile (ng, tile, &
879!^ & LBi, UBi, LBj, UBj, &
880!^ & bed_thick0)
881!^
882 CALL exchange_r2d_tile (ng, tile, &
883 & lbi, ubi, lbj, ubj, &
884 & tl_bed_thick0)
885!^ CALL exchange_r2d_tile (ng, tile, &
886!^ & LBi, UBi, LBj, UBj, &
887!^ & bed_thick(:,:,1))
888!^
889 CALL exchange_r2d_tile (ng, tile, &
890 & lbi, ubi, lbj, ubj, &
891 & tl_bed_thick(:,:,1))
892!^ CALL exchange_r2d_tile (ng, tile, &
893!^ & LBi, UBi, LBj, UBj, &
894!^ & bed_thick(:,:,2))
895!^
896 CALL exchange_r2d_tile (ng, tile, &
897 & lbi, ubi, lbj, ubj, &
898 & tl_bed_thick(:,:,2))
899!^ CALL exchange_r2d_tile (ng, tile, &
900!^ & LBi, UBi, LBj, UBj, &
901!^ & bed_thick(:,:,3))
902!^
903 CALL exchange_r2d_tile (ng, tile, &
904 & lbi, ubi, lbj, ubj, &
905 & tl_bed_thick(:,:,3))
906 END IF
907
908# ifdef DISTRIBUTE
909!^ CALL mp_exchange2d (ng, tile, model, 4, &
910!^ & LBi, UBi, LBj, UBj, 1, 1, &
911!^ & NghostPoints, &
912!^ & EWperiodic(ng), NSperiodic(ng), &
913!^ & bed_thick0, &
914!^ & bed_thick(:,:,1), &
915!^ & bed_thick(:,:,2), &
916!^ & bed_thick(:,:,3))
917!^
918 CALL mp_exchange2d (ng, tile, model, 4, &
919 & lbi, ubi, lbj, ubj, &
920 & nghostpoints, &
921 & ewperiodic(ng), nsperiodic(ng), &
922 & tl_bed_thick0, &
923 & tl_bed_thick(:,:,1), &
924 & tl_bed_thick(:,:,2), &
925 & tl_bed_thick(:,:,3))
926# endif
927# endif
928# endif
929!
930 RETURN

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_ncparam::isfsur, mod_sediment::ithck, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::tl_lbc, tl_set_zeta_timeavg(), and tl_zetabc_mod::tl_zetabc_tile().

Referenced by tl_ini_zeta().

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

◆ tl_set_zeta_timeavg()

subroutine, public tl_ini_fields_mod::tl_set_zeta_timeavg ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 936 of file tl_ini_fields.F.

937!***********************************************************************
938!
939 USE mod_stepping
940!
941! Imported variable declarations.
942!
943 integer, intent(in) :: ng, tile, model
944!
945! Local variable declarations.
946!
947 character (len=*), parameter :: MyFile = &
948 & __FILE__//", tl_set_zeta_timeavg"
949!
950# include "tile.h"
951!
952# ifdef PROFILE
953 CALL wclock_on (ng, model, 2, __line__, myfile)
954# endif
955 CALL tl_set_zeta_timeavg_tile (ng, tile, model, &
956 & lbi, ubi, lbj, ubj, &
957 & kstp(ng), &
958 & coupling(ng) % tl_Zt_avg1, &
959 & ocean(ng) % tl_zeta)
960# ifdef PROFILE
961 CALL wclock_off (ng, model, 2, __line__, myfile)
962# endif
963!
964 RETURN

References mod_coupling::coupling, mod_stepping::kstp, mod_ocean::ocean, tl_set_zeta_timeavg_tile(), wclock_off(), and wclock_on().

Referenced by tl_ini_zeta_tile().

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

◆ tl_set_zeta_timeavg_tile()

subroutine tl_ini_fields_mod::tl_set_zeta_timeavg_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) kstp,
real(r8), dimension(lbi:,lbj:), intent(inout) tl_zt_avg1,
real(r8), dimension(lbi:,lbj:,:), intent(inout) tl_zeta )
private

Zt_avg1(i,j)=zeta(i,j,kstp)

Definition at line 968 of file tl_ini_fields.F.

973!***********************************************************************
974!
975 USE mod_param
976 USE mod_scalars
977!
978 USE exchange_2d_mod, ONLY : exchange_r2d_tile
979# ifdef DISTRIBUTE
980 USE mp_exchange_mod, ONLY : mp_exchange2d
981# endif
982!
983! Imported variable declarations.
984!
985 integer, intent(in) :: ng, tile, model
986 integer, intent(in) :: LBi, UBi, LBj, UBj
987 integer, intent(in) :: kstp
988!
989# ifdef ASSUMED_SHAPE
990 real(r8), intent(inout) :: tl_Zt_avg1(LBi:,LBj:)
991 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
992# else
993 real(r8), intent(inout) :: tl_Zt_avg1(LBi:UBi,LBj:UBj)
994 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
995# endif
996!
997! Local variable declarations.
998!
999 integer :: i, j
1000!
1001# include "set_bounds.h"
1002!
1003!-----------------------------------------------------------------------
1004! Initialize fast-time averaged free-surface (Zt_avg1) with the inital
1005! free-surface.
1006!-----------------------------------------------------------------------
1007!
1008 DO j=jstrt,jendt
1009 DO i=istrt,iendt
1010!> Zt_avg1(i,j)=zeta(i,j,kstp)
1011!>
1012 tl_zt_avg1(i,j)=tl_zeta(i,j,kstp)
1013 END DO
1014 END DO
1015!
1016 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1017 CALL exchange_r2d_tile (ng, tile, &
1018 & lbi, ubi, lbj, ubj, &
1019 & tl_zt_avg1)
1020 END IF
1021
1022# ifdef DISTRIBUTE
1023 CALL mp_exchange2d (ng, tile, model, 1, &
1024 & lbi, ubi, lbj, ubj, &
1025 & nghostpoints, &
1026 & ewperiodic(ng), nsperiodic(ng), &
1027 & tl_zt_avg1)
1028# endif
1029!
1030 RETURN
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
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
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by tl_set_zeta_timeavg().

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