ROMS
Loading...
Searching...
No Matches
ini_fields.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE ini_fields_mod
3#ifdef NONLINEAR
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group Andrew M. Moore !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This routine initializes other time levels for 2D fields. It also !
13! couples 3D and 2D momentum equations: it initializes 2D momentum !
14! (ubar,vbar) to the vertical integral of initial 3D momentum (u,v). !
15! !
16!=======================================================================
17!
18 USE mod_param
19 USE mod_grid
20# ifdef SOLVE3D
21 USE mod_coupling
22# endif
23 USE mod_ncparam
24 USE mod_ocean
25 USE mod_scalars
26# if defined SOLVE3D && (defined SEDIMENT || defined BBL_MODEL)
27 USE mod_sedbed
28 USE mod_sediment
29# endif
30!
31 USE exchange_2d_mod
32# ifdef SOLVE3D
33 USE exchange_3d_mod
34# endif
35# ifdef DISTRIBUTE
36 USE mp_exchange_mod, ONLY : mp_exchange2d
37# ifdef SOLVE3D
38 USE mp_exchange_mod, ONLY : mp_exchange3d, mp_exchange4d
39# else
40# ifdef PERFECT_RESTART
41 USE mp_exchange_mod, ONLY : mp_exchange3d
42# endif
43# endif
44# endif
45# ifdef SOLVE3D
46 USE t3dbc_mod, ONLY : t3dbc_tile
47 USE u3dbc_mod, ONLY : u3dbc_tile
48 USE v3dbc_mod, ONLY : v3dbc_tile
49# endif
50 USE u2dbc_mod, ONLY : u2dbc_tile
51 USE v2dbc_mod, ONLY : v2dbc_tile
52 USE zetabc_mod, ONLY : zetabc_tile
53!
54 implicit none
55!
56 PRIVATE
57 PUBLIC :: ini_fields
58 PUBLIC :: ini_zeta
59# ifdef SOLVE3D
60 PUBLIC :: set_zeta_timeavg
61# endif
62!
63 CONTAINS
64!
65!***********************************************************************
66 SUBROUTINE ini_fields (ng, tile, model)
67!***********************************************************************
68!
69 USE mod_stepping
70!
71! Imported variable declarations.
72!
73 integer, intent(in) :: ng, tile, model
74!
75! Local variable declarations.
76!
77 character (len=*), parameter :: myfile = &
78 & __FILE__
79!
80# include "tile.h"
81!
82# ifdef PROFILE
83 CALL wclock_on (ng, model, 2, __line__, myfile)
84# endif
85 CALL ini_fields_tile (ng, tile, model, &
86 & lbi, ubi, lbj, ubj, &
87 & imins, imaxs, jmins, jmaxs, &
88 & kstp(ng), krhs(ng), knew(ng), &
89# ifdef SOLVE3D
90 & nstp(ng), nnew(ng), &
91# endif
92# ifdef MASKING
93 & grid(ng) % rmask, &
94 & grid(ng) % umask, &
95 & grid(ng) % vmask, &
96# endif
97# ifdef WET_DRY
98 & grid(ng) % rmask_wet, &
99 & grid(ng) % umask_wet, &
100 & grid(ng) % vmask_wet, &
101# endif
102# ifdef PERFECT_RESTART
103# ifdef SOLVE3D
104 & ocean(ng) % ru, &
105 & ocean(ng) % rv, &
106# endif
107 & ocean(ng) % rubar, &
108 & ocean(ng) % rvbar, &
109 & ocean(ng) % rzeta, &
110# endif
111# ifdef SOLVE3D
112# if defined SEDIMENT || defined BBL_MODEL
113 & sedbed(ng) % bottom, &
114# endif
115# if defined SEDIMENT
116 & sedbed(ng) % bed, &
117 & sedbed(ng) % bed_frac, &
118 & sedbed(ng) % bed_mass, &
119# endif
120 & grid(ng) % Hz, &
121 & ocean(ng) % t, &
122 & ocean(ng) % u, &
123 & ocean(ng) % v, &
124# endif
125 & ocean(ng) % ubar, &
126 & ocean(ng) % vbar, &
127 & ocean(ng) % zeta)
128# ifdef PROFILE
129 CALL wclock_off (ng, model, 2, __line__, myfile)
130# endif
131!
132 RETURN
133 END SUBROUTINE ini_fields
134!
135!***********************************************************************
136 SUBROUTINE ini_fields_tile (ng, tile, model, &
137 & LBi, UBi, LBj, UBj, &
138 & IminS, ImaxS, JminS, JmaxS, &
139 & kstp, krhs, knew, &
140# ifdef SOLVE3D
141 & nstp, nnew, &
142# endif
143# ifdef MASKING
144 & rmask, umask, vmask, &
145# endif
146# ifdef WET_DRY
147 & rmask_wet, umask_wet, vmask_wet, &
148# endif
149# ifdef PERFECT_RESTART
150# ifdef SOLVE3D
151 & ru, rv, &
152# endif
153 & rubar, rvbar, rzeta, &
154# endif
155# ifdef SOLVE3D
156# if defined SEDIMENT || defined BBL_MODEL
157 & bottom, &
158# endif
159# if defined SEDIMENT
160 & bed, bed_frac, bed_mass, &
161# endif
162 & Hz, &
163 & t, u, v, &
164# endif
165 & ubar, vbar, zeta)
166!***********************************************************************
167!
168! Imported variable declarations.
169!
170 integer, intent(in) :: ng, tile, model
171 integer, intent(in) :: LBi, UBi, LBj, UBj
172 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
173 integer, intent(in) :: kstp, krhs, knew
174# ifdef SOLVE3D
175 integer, intent(in) :: nstp, nnew
176# endif
177!
178# ifdef ASSUMED_SHAPE
179# ifdef MASKING
180 real(r8), intent(in) :: rmask(LBi:,LBj:)
181 real(r8), intent(in) :: umask(LBi:,LBj:)
182 real(r8), intent(in) :: vmask(LBi:,LBj:)
183# endif
184# ifdef WET_DRY
185 real(r8), intent(in) :: rmask_wet(LBi:,LBj:)
186 real(r8), intent(inout) :: umask_wet(LBi:,LBj:)
187 real(r8), intent(inout) :: vmask_wet(LBi:,LBj:)
188# endif
189# ifdef SOLVE3D
190 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
191# endif
192 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
193# ifdef SOLVE3D
194# if defined SEDIMENT || defined BBL_MODEL
195 real(r8), intent(inout) :: bottom(LBi:,LBj:,:)
196# endif
197# if defined SEDIMENT
198 real(r8), intent(inout) :: bed(LBi:,LBj:,:,:)
199 real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:)
200 real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:)
201# endif
202# endif
203# ifdef PERFECT_RESTART
204# ifdef SOLVE3D
205 real(r8), intent(inout) :: ru(LBi:,LBj:,0:,:)
206 real(r8), intent(inout) :: rv(LBi:,LBj:,0:,:)
207# endif
208 real(r8), intent(inout) :: rubar(LBi:,LBj:,:)
209 real(r8), intent(inout) :: rvbar(LBi:,LBj:,:)
210 real(r8), intent(inout) :: rzeta(LBi:,LBj:,:)
211# endif
212# ifdef SOLVE3D
213 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
214 real(r8), intent(inout) :: u(LBi:,LBj:,:,:)
215 real(r8), intent(inout) :: v(LBi:,LBj:,:,:)
216# endif
217 real(r8), intent(inout) :: ubar(LBi:,LBj:,:)
218 real(r8), intent(inout) :: vbar(LBi:,LBj:,:)
219
220# else
221
222# ifdef MASKING
223 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
224 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
225 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
226# endif
227# ifdef WET_DRY
228 real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj)
229 real(r8), intent(inout) :: umask_wet(LBi:UBi,LBj:UBj)
230 real(r8), intent(inout) :: vmask_wet(LBi:UBi,LBj:UBj)
231# endif
232# ifdef SOLVE3D
233 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
234# endif
235 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
236# ifdef SOLVE3D
237# if defined SEDIMENT || defined BBL_MODEL
238 real(r8), intent(inout) :: bottom(LBi:UBi,LBj:UBj,MBOTP)
239# endif
240# if defined SEDIMENT
241 real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP)
242 real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST)
243 real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,2,NST)
244# endif
245# endif
246# ifdef PERFECT_RESTART
247# ifdef SOLVE3D
248 real(r8), intent(inout) :: ru(LBi:UBi,LBj:UBj,0:N(ng),2)
249 real(r8), intent(inout) :: rv(LBi:UBi,LBj:UBj,0:N(ng),2)
250# endif
251 real(r8), intent(inout) :: rubar(LBi:UBi,LBj:UBj,2)
252 real(r8), intent(inout) :: rvbar(LBi:UBi,LBj:UBj,2)
253 real(r8), intent(inout) :: rzeta(LBi:UBi,LBj:UBj,2)
254# endif
255# ifdef SOLVE3D
256 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
257 real(r8), intent(inout) :: u(LBi:UBi,LBj:UBj,N(ng),2)
258 real(r8), intent(inout) :: v(LBi:UBi,LBj:UBj,N(ng),2)
259# endif
260 real(r8), intent(inout) :: ubar(LBi:UBi,LBj:UBj,:)
261 real(r8), intent(inout) :: vbar(LBi:UBi,LBj:UBj,:)
262# endif
263!
264! Local variable declarations.
265!
266 integer :: i, ic, itrc, j, k
267# if defined SEDIMENT || defined BBL_MODEL
268 integer :: ised
269# endif
270
271 real(r8) :: cff1, cff2
272# ifdef SOLVE3D
273 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: CF
274 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC
275# endif
276
277# include "set_bounds.h"
278
279# ifdef SOLVE3D
280!
281!-----------------------------------------------------------------------
282! If not perfect restart, initialize other time levels for 3D momentum.
283!-----------------------------------------------------------------------
284!
285 IF (.not.perfectrst(ng)) THEN
286 DO j=jstrb,jendb
287 DO k=1,n(ng)
288 DO i=istrm,iendb
289 cff1=u(i,j,k,nstp)
290# ifdef MASKING
291 cff1=cff1*umask(i,j)
292# endif
293# ifdef WET_DRY
294 cff1=cff1*umask_wet(i,j)
295# endif
296 u(i,j,k,nstp)=cff1
297 END DO
298 END DO
299!
300 IF (j.ge.jstrm) THEN
301 DO k=1,n(ng)
302 DO i=istrb,iendb
303 cff2=v(i,j,k,nstp)
304# ifdef MASKING
305 cff2=cff2*vmask(i,j)
306# endif
307# ifdef WET_DRY
308 cff2=cff2*vmask_wet(i,j)
309# endif
310 v(i,j,k,nstp)=cff2
311 END DO
312 END DO
313 END IF
314 END DO
315!
316! Apply boundary conditions.
317!
318 CALL u3dbc_tile (ng, tile, &
319 & lbi, ubi, lbj, ubj, n(ng), &
320 & imins, imaxs, jmins, jmaxs, &
321 & nstp, nstp, &
322 & u)
323 CALL v3dbc_tile (ng, tile, &
324 & lbi, ubi, lbj, ubj, n(ng), &
325 & imins, imaxs, jmins, jmaxs, &
326 & nstp, nstp, &
327 & v)
328 END IF
329!
330 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
331 CALL exchange_u3d_tile (ng, tile, &
332 & lbi, ubi, lbj, ubj, 1, n(ng), &
333 & u(:,:,:,nstp))
334 CALL exchange_v3d_tile (ng, tile, &
335 & lbi, ubi, lbj, ubj, 1, n(ng), &
336 & v(:,:,:,nstp))
337 END IF
338
339# ifdef DISTRIBUTE
340!
341 CALL mp_exchange3d (ng, tile, model, 2, &
342 & lbi, ubi, lbj, ubj, 1, n(ng), &
343 & nghostpoints, &
344 & ewperiodic(ng), nsperiodic(ng), &
345 & u(:,:,:,nstp), v(:,:,:,nstp))
346# endif
347# endif
348
349# ifdef SOLVE3D
350!
351!-----------------------------------------------------------------------
352! If not perfect restart, compute vertically-integrated momentum
353! (ubar, vbar) from initial 3D momentum (u, v).
354!-----------------------------------------------------------------------
355!
356! Here DC(i,1:N) are the grid cell thicknesses, DC(i,0) is the total
357! depth of the water column, and CF(i,0) is the vertical integral.
358!
359 IF (.not.perfectrst(ng)) THEN
360 DO j=jstrb,jendb
361 DO i=istrm,iendb
362 dc(i,0)=0.0_r8
363 cf(i,0)=0.0_r8
364 END DO
365 DO k=1,n(ng)
366 DO i=istrm,iendb
367 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i-1,j,k))
368 dc(i,0)=dc(i,0)+dc(i,k)
369 cf(i,0)=cf(i,0)+dc(i,k)*u(i,j,k,nstp)
370 END DO
371 END DO
372 DO i=istrm,iendb
373 cff1=1.0_r8/dc(i,0)
374 cff2=cf(i,0)*cff1
375# ifdef MASKING
376 cff2=cff2*umask(i,j)
377# endif
378# ifdef WET_DRY
379 cff2=cff2*umask_wet(i,j)
380# endif
381 ubar(i,j,kstp)=cff2
382 END DO
383!
384 IF (j.ge.jstrm) THEN
385 DO i=istrb,iendb
386 dc(i,0)=0.0_r8
387 cf(i,0)=0.0_r8
388 END DO
389 DO k=1,n(ng)
390 DO i=istrb,iendb
391 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i,j-1,k))
392 dc(i,0)=dc(i,0)+dc(i,k)
393 cf(i,0)=cf(i,0)+dc(i,k)*v(i,j,k,nstp)
394 END DO
395 END DO
396 DO i=istrb,iendb
397 cff1=1.0_r8/dc(i,0)
398 cff2=cf(i,0)*cff1
399# ifdef MASKING
400 cff2=cff2*vmask(i,j)
401# endif
402# ifdef WET_DRY
403 cff2=cff2*vmask_wet(i,j)
404# endif
405 vbar(i,j,kstp)=cff2
406 END DO
407 END IF
408 END DO
409!
410! Apply boundary conditions.
411!
412 IF (.not.(any(lbc(:,isubar,ng)%radiation).or. &
413 & any(lbc(:,isvbar,ng)%radiation).or. &
414 & any(lbc(:,isubar,ng)%Flather).or. &
415 & any(lbc(:,isvbar,ng)%Flather))) THEN
416 CALL u2dbc_tile (ng, tile, &
417 & lbi, ubi, lbj, ubj, &
418 & imins, imaxs, jmins, jmaxs, &
419 & krhs, kstp, kstp, &
420 & ubar, vbar, zeta)
421 CALL v2dbc_tile (ng, tile, &
422 & lbi, ubi, lbj, ubj, &
423 & imins, imaxs, jmins, jmaxs, &
424 & krhs, kstp, kstp, &
425 & ubar, vbar, zeta)
426 END IF
427 END IF
428!
429 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
430 CALL exchange_u2d_tile (ng, tile, &
431 & lbi, ubi, lbj, ubj, &
432 & ubar(:,:,kstp))
433 CALL exchange_v2d_tile (ng, tile, &
434 & lbi, ubi, lbj, ubj, &
435 & vbar(:,:,kstp))
436 END IF
437
438# ifdef DISTRIBUTE
439!
440 CALL mp_exchange2d (ng, tile, model, 2, &
441 & lbi, ubi, lbj, ubj, &
442 & nghostpoints, &
443 & ewperiodic(ng), nsperiodic(ng), &
444 & ubar(:,:,kstp), vbar(:,:,kstp))
445# endif
446
447# else
448!
449!-----------------------------------------------------------------------
450! If not perfect restart, initialize other time levels for 2D momentum
451! (shallow-water model).
452!-----------------------------------------------------------------------
453!
454 IF (.not.perfectrst(ng)) THEN
455 DO j=jstrb,jendb
456 DO i=istrm,iendb
457 cff1=ubar(i,j,kstp)
458# ifdef MASKING
459 cff1=cff1*umask(i,j)
460# endif
461# ifdef WET_DRY
462 cff1=cff1*umask_wet(i,j)
463# endif
464 ubar(i,j,kstp)=cff1
465 END DO
466!
467 IF (j.ge.jstrm) THEN
468 DO i=istrb,iendb
469 cff2=vbar(i,j,kstp)
470# ifdef MASKING
471 cff2=cff2*vmask(i,j)
472# endif
473# ifdef WET_DRY
474 cff2=cff2*vmask_wet(i,j)
475# endif
476 vbar(i,j,kstp)=cff2
477 END DO
478 END IF
479 END DO
480!
481! Apply boundary conditions.
482!
483 IF (.not.(any(lbc(:,isubar,ng)%radiation).or. &
484 & any(lbc(:,isvbar,ng)%radiation).or. &
485 & any(lbc(:,isubar,ng)%Flather).or. &
486 & any(lbc(:,isvbar,ng)%Flather))) THEN
487 CALL u2dbc_tile (ng, tile, &
488 & lbi, ubi, lbj, ubj, &
489 & imins, imaxs, jmins, jmaxs, &
490 & krhs, kstp, kstp, &
491 & ubar, vbar, zeta)
492 CALL v2dbc_tile (ng, tile, &
493 & lbi, ubi, lbj, ubj, &
494 & imins, imaxs, jmins, jmaxs, &
495 & krhs, kstp, kstp, &
496 & ubar, vbar, zeta)
497 END IF
498 END IF
499!
500 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
501 CALL exchange_u2d_tile (ng, tile, &
502 & lbi, ubi, lbj, ubj, &
503 & ubar(:,:,kstp))
504 CALL exchange_v2d_tile (ng, tile, &
505 & lbi, ubi, lbj, ubj, &
506 & vbar(:,:,kstp))
507 IF (perfectrst(ng)) THEN
508 CALL exchange_u2d_tile (ng, tile, &
509 & lbi, ubi, lbj, ubj, &
510 & ubar(:,:,knew))
511 CALL exchange_v2d_tile (ng, tile, &
512 & lbi, ubi, lbj, ubj, &
513 & vbar(:,:,knew))
514 END IF
515 END IF
516
517# ifdef DISTRIBUTE
518!
519 CALL mp_exchange2d (ng, tile, model, 2, &
520 & lbi, ubi, lbj, ubj, &
521 & nghostpoints, &
522 & ewperiodic(ng), nsperiodic(ng), &
523 & ubar(:,:,kstp), vbar(:,:,kstp))
524 IF (perfectrst(ng)) THEN
525 CALL mp_exchange2d (ng, tile, model, 2, &
526 & lbi, ubi, lbj, ubj, &
527 & nghostpoints, &
528 & ewperiodic(ng), nsperiodic(ng), &
529 & ubar(:,:,knew), vbar(:,:,knew))
530 END IF
531# endif
532# endif
533
534# ifdef SOLVE3D
535!
536!-----------------------------------------------------------------------
537! If not perfect restart, initialize other time levels for tracers.
538!-----------------------------------------------------------------------
539!
540 ic=0
541 IF (.not.perfectrst(ng)) THEN
542 DO itrc=1,nt(ng)
543 IF (ltracerclm(itrc,ng).and.lnudgetclm(itrc,ng)) THEN
544 ic=ic+1 ! OBC nudging coefficient index
545 END IF
546 DO k=1,n(ng)
547 DO j=jstrb,jendb
548 DO i=istrb,iendb
549 cff1=t(i,j,k,nstp,itrc)
550# ifdef MASKING
551 cff1=cff1*rmask(i,j)
552# endif
553 t(i,j,k,nstp,itrc)=cff1
554 END DO
555 END DO
556 END DO
557!
558! Apply boundary conditions.
559!
560 CALL t3dbc_tile (ng, tile, itrc, ic, &
561 & lbi, ubi, lbj, ubj, n(ng), nt(ng), &
562 & imins, imaxs, jmins, jmaxs, &
563 & nstp, nstp, &
564 & t)
565 END DO
566 END IF
567!
568 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
569 DO itrc=1,nt(ng)
570 CALL exchange_r3d_tile (ng, tile, &
571 & lbi, ubi, lbj, ubj, 1, n(ng), &
572 & t(:,:,:,nstp,itrc))
573 END DO
574 END IF
575
576# ifdef DISTRIBUTE
577!
578 CALL mp_exchange4d (ng, tile, model, 1, &
579 & lbi, ubi, lbj, ubj, 1, n(ng), 1, nt(ng), &
580 & nghostpoints, &
581 & ewperiodic(ng), nsperiodic(ng), &
582 & t(:,:,:,nstp,:))
583# endif
584
585# if defined BBL_MODEL || defined SEDIMENT
586!
587!-----------------------------------------------------------------------
588! Initialize sediment bed properties.
589!-----------------------------------------------------------------------
590!
591# ifdef SEDIMENT
592 IF (.not.perfectrst(ng)) THEN
593 DO k=1,nbed
594 DO j=jstrt,jendt
595 DO i=istrt,iendt
596 DO ised=1,nst
597 cff1=bed_mass(i,j,k,1,ised)
598 bed_mass(i,j,k,2,ised)=cff1
599 END DO
600 END DO
601 END DO
602 END DO
603 END IF
604# endif
605!
606 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
607# ifdef SEDIMENT
608 DO ised=1,nst
609 CALL exchange_r3d_tile (ng, tile, &
610 & lbi, ubi, lbj, ubj, 1, nbed, &
611 & bed_frac(:,:,:,ised))
612 CALL exchange_r3d_tile (ng, tile, &
613 & lbi, ubi, lbj, ubj, 1, nbed, &
614 & bed_mass(:,:,:,1,ised))
615 CALL exchange_r3d_tile (ng, tile, &
616 & lbi, ubi, lbj, ubj, 1, nbed, &
617 & bed_mass(:,:,:,2,ised))
618 END DO
619 DO ised=1,mbedp
620 CALL exchange_r3d_tile (ng, tile, &
621 & lbi, ubi, lbj, ubj, 1, nbed, &
622 & bed(:,:,:,ised))
623 END DO
624# endif
625 CALL exchange_r3d_tile (ng, tile, &
626 & lbi, ubi, lbj, ubj, 1, mbotp, &
627 & bottom)
628 END IF
629
630# ifdef DISTRIBUTE
631# ifdef SEDIMENT
632 CALL mp_exchange4d (ng, tile, model, 1, &
633 & lbi, ubi, lbj, ubj, 1, nbed, 1, nst, &
634 & nghostpoints, &
635 & ewperiodic(ng), nsperiodic(ng), &
636 & bed_frac)
637 CALL mp_exchange4d (ng, tile, model, 2, &
638 & lbi, ubi, lbj, ubj, 1, nbed, 1, nst, &
639 & nghostpoints, &
640 & ewperiodic(ng), nsperiodic(ng), &
641 & bed_mass(:,:,:,1,:),bed_mass(:,:,:,2,:))
642 CALL mp_exchange4d (ng, tile, model, 1, &
643 & lbi, ubi, lbj, ubj, 1, nbed, 1, mbedp, &
644 & nghostpoints, &
645 & ewperiodic(ng), nsperiodic(ng), &
646 & bed)
647# endif
648 CALL mp_exchange3d (ng, tile, model, 1, &
649 & lbi, ubi, lbj, ubj, 1, mbotp, &
650 & nghostpoints, &
651 & ewperiodic(ng), nsperiodic(ng), &
652 & bottom)
653# endif
654# endif
655# endif
656
657# ifdef PERFECT_RESTART
658!
659!-----------------------------------------------------------------------
660! If perfect restart, apply periodic boundary condition to
661! right-hand-side terms.
662!-----------------------------------------------------------------------
663!
664 IF (perfectrst(ng)) THEN
665 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
666 DO i=1,2
667 CALL exchange_u2d_tile (ng, tile, &
668 & lbi, ubi, lbj, ubj, &
669 & rubar(:,:,i))
670 CALL exchange_v2d_tile (ng, tile, &
671 & lbi, ubi, lbj, ubj, &
672 & rvbar(:,:,i))
673 CALL exchange_r2d_tile (ng, tile, &
674 & lbi, ubi, lbj, ubj, &
675 & rzeta(:,:,i))
676# ifdef SOLVE3D
677 CALL exchange_u3d_tile (ng, tile, &
678 & lbi, ubi, lbj, ubj, 0, n(ng), &
679 & ru(:,:,:,i))
680 CALL exchange_v3d_tile (ng, tile, &
681 & lbi, ubi, lbj, ubj, 0, n(ng), &
682 & rv(:,:,:,i))
683# endif
684 END DO
685 END IF
686
687# ifdef DISTRIBUTE
688 CALL mp_exchange3d (ng, tile, model, 3, &
689 & lbi, ubi, lbj, ubj, 1, 2, &
690 & nghostpoints, &
691 & ewperiodic(ng), nsperiodic(ng), &
692 & rubar, rvbar, rzeta)
693# ifdef SOLVE3D
694 CALL mp_exchange4d (ng, tile, model, 2, &
695 & lbi, ubi, lbj, ubj, 0, n(ng), 1, 2, &
696 & nghostpoints, &
697 & ewperiodic(ng), nsperiodic(ng), &
698 & ru, rv)
699# endif
700# endif
701 END IF
702# endif
703!
704 RETURN
705 END SUBROUTINE ini_fields_tile
706!
707!***********************************************************************
708 SUBROUTINE ini_zeta (ng, tile, model)
709!***********************************************************************
710!
711 USE mod_stepping
712!
713! Imported variable declarations.
714!
715 integer, intent(in) :: ng, tile, model
716!
717! Local variable declarations.
718!
719 character (len=*), parameter :: myfile = &
720 & __FILE__//", ini_zeta"
721!
722# include "tile.h"
723!
724# ifdef PROFILE
725 CALL wclock_on (ng, model, 2, __line__, myfile)
726# endif
727 CALL ini_zeta_tile (ng, tile, model, &
728 & lbi, ubi, lbj, ubj, &
729 & imins, imaxs, jmins, jmaxs, &
730 & kstp(ng), krhs(ng), knew(ng), &
731# ifdef MASKING
732 & grid(ng) % rmask, &
733# endif
734# ifdef WET_DRY
735 & grid(ng) % rmask_wet, &
736 & grid(ng) % h, &
737# endif
738# ifdef SOLVE3D
739# if defined SEDIMENT && defined SED_MORPH
740 & sedbed(ng) % bed, &
741 & sedbed(ng) % bed_thick0, &
742 & sedbed(ng) % bed_thick, &
743# endif
744# endif
745 & ocean(ng) % zeta)
746# ifdef PROFILE
747 CALL wclock_off (ng, model, 2, __line__, myfile)
748# endif
749!
750 RETURN
751 END SUBROUTINE ini_zeta
752!
753!***********************************************************************
754 SUBROUTINE ini_zeta_tile (ng, tile, model, &
755 & LBi, UBi, LBj, UBj, &
756 & IminS, ImaxS, JminS, JmaxS, &
757 & kstp, krhs, knew, &
758# ifdef MASKING
759 & rmask, &
760# endif
761# ifdef WET_DRY
762 & rmask_wet, &
763 & h, &
764# endif
765# ifdef SOLVE3D
766# if defined SEDIMENT && defined SED_MORPH
767 & bed, bed_thick0, bed_thick, &
768# endif
769# endif
770 & zeta)
771!***********************************************************************
772!
773! Imported variable declarations.
774!
775 integer, intent(in) :: ng, tile, model
776 integer, intent(in) :: LBi, UBi, LBj, UBj
777 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
778 integer, intent(in) :: kstp, krhs, knew
779!
780# ifdef ASSUMED_SHAPE
781# ifdef MASKING
782 real(r8), intent(in) :: rmask(LBi:,LBj:)
783# endif
784# ifdef WET_DRY
785 real(r8), intent(in) :: h(LBi:,LBj:)
786# endif
787# if defined SOLVE3D && defined SEDIMENT && defined SED_MORPH
788 real(r8), intent(in) :: bed(LBi:,LBj:,:,:)
789 real(r8), intent(inout) :: bed_thick0(LBi:,LBj:)
790 real(r8), intent(inout) :: bed_thick(LBi:,LBj:,:)
791# endif
792# ifdef WET_DRY
793 real(r8), intent(inout) :: rmask_wet(LBi:,LBj:)
794# endif
795 real(r8), intent(inout) :: zeta(LBi:,LBj:,:)
796
797# else
798
799# ifdef MASKING
800 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
801# endif
802# ifdef WET_DRY
803 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
804# endif
805# if defined SOLVE3D && defined SEDIMENT && defined SED_MORPH
806 real(r8), intent(in) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP)
807 real(r8), intent(inout) :: bed_thick0(LBi:UBi,LBj:UBj)
808 real(r8), intent(inout) :: bed_thick(LBi:UBi,LBj:UBj,3)
809# endif
810# ifdef WET_DRY
811 real(r8), intent(inout) :: rmask_wet(LBi:UBi,LBj:UBj)
812# endif
813 real(r8), intent(inout) :: zeta(LBi:UBi,LBj:UBj,:)
814# endif
815!
816! Local variable declarations.
817!
818 integer :: Imin, Imax, Jmin, Jmax
819 integer :: i, j, kbed
820
821 real(r8) :: cff1
822
823# include "set_bounds.h"
824!
825!-----------------------------------------------------------------------
826! Initialize other time levels for free-surface.
827!-----------------------------------------------------------------------
828!
829 IF (.not.perfectrst(ng)) THEN
830 IF (.not.(any(lbc(:,isfsur,ng)%radiation).or. &
831 & any(lbc(:,isfsur,ng)%Chapman_explicit).or. &
832 & any(lbc(:,isfsur,ng)%Chapman_implicit))) THEN
833 imin=istrb
834 imax=iendb
835 jmin=jstrb
836 jmax=jendb
837 ELSE
838 imin=istrt
839 imax=iendt
840 jmin=jstrt
841 jmax=jendt
842 END IF
843 DO j=jmin,jmax
844 DO i=imin,imax
845 cff1=zeta(i,j,kstp)
846# ifdef MASKING
847 cff1=cff1*rmask(i,j)
848# endif
849# ifdef WET_DRY
850 IF (cff1.le.(dcrit(ng)-h(i,j))) THEN
851 cff1=dcrit(ng)-h(i,j)
852!! rmask_wet(i,j)=0.0_r8
853!! ELSE
854!! rmask_wet(i,j)=1.0_r8*rmask(i,j)
855 END IF
856# endif
857 zeta(i,j,kstp)=cff1
858 END DO
859 END DO
860!
861! Apply boundary conditions.
862!
863 IF (.not.(any(lbc(:,isfsur,ng)%radiation).or. &
864 & any(lbc(:,isfsur,ng)%Chapman_explicit).or. &
865 & any(lbc(:,isfsur,ng)%Chapman_implicit))) THEN
866 CALL zetabc_tile (ng, tile, &
867 & lbi, ubi, lbj, ubj, &
868 & imins, imaxs, jmins, jmaxs, &
869 & krhs, kstp, kstp, &
870 & zeta)
871 END IF
872 END IF
873!
874 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
875 CALL exchange_r2d_tile (ng, tile, &
876 & lbi, ubi, lbj, ubj, &
877 & zeta(:,:,kstp))
878 IF (perfectrst(ng)) THEN
879# ifdef SOLVE3D
880 CALL exchange_r2d_tile (ng, tile, &
881 & lbi, ubi, lbj, ubj, &
882 & zeta(:,:,krhs))
883# else
884 CALL exchange_r2d_tile (ng, tile, &
885 & lbi, ubi, lbj, ubj, &
886 & zeta(:,:,knew))
887# endif
888 END IF
889
890# ifdef WET_DRY
891 CALL exchange_r2d_tile (ng, tile, &
892 & lbi, ubi, lbj, ubj, &
893 & rmask_wet)
894# endif
895 END IF
896
897# ifdef DISTRIBUTE
898 CALL mp_exchange2d (ng, tile, model, 1, &
899 & lbi, ubi, lbj, ubj, &
900 & nghostpoints, &
901 & ewperiodic(ng), nsperiodic(ng), &
902 & zeta(:,:,kstp))
903 IF (perfectrst(ng)) THEN
904# ifdef SOLVE3D
905 CALL mp_exchange2d (ng, tile, model, 1, &
906 & lbi, ubi, lbj, ubj, &
907 & nghostpoints, &
908 & ewperiodic(ng), nsperiodic(ng), &
909 & zeta(:,:,krhs))
910# else
911 CALL mp_exchange2d (ng, tile, model, 1, &
912 & lbi, ubi, lbj, ubj, &
913 & nghostpoints, &
914 & ewperiodic(ng), nsperiodic(ng), &
915 & zeta(:,:,knew))
916# endif
917 END IF
918
919# ifdef WET_DRY
920 CALL mp_exchange2d (ng, tile, model, 1, &
921 & lbi, ubi, lbj, ubj, &
922 & nghostpoints, &
923 & ewperiodic(ng), nsperiodic(ng), &
924 & rmask_wet)
925# endif
926# endif
927
928# ifdef SOLVE3D
929!
930!-----------------------------------------------------------------------
931! Initialize fast-time averaged free-surface (Zt_avg1) with the inital
932! free-surface
933!-----------------------------------------------------------------------
934!
935 CALL set_zeta_timeavg (ng, tile, model)
936
937# if defined SEDIMENT && defined SED_MORPH
938!
939!-----------------------------------------------------------------------
940! Compute initial total thickness for all sediment bed layers.
941!-----------------------------------------------------------------------
942!
943 DO j=jstrt,jendt
944 DO i=istrt,iendt
945 bed_thick0(i,j)=0.0_r8
946 DO kbed=1,nbed
947 bed_thick0(i,j)=bed_thick0(i,j)+bed(i,j,kbed,ithck)
948 END DO
949 bed_thick(i,j,1)=bed_thick0(i,j)
950 bed_thick(i,j,2)=bed_thick0(i,j)
951 END DO
952 END DO
953!
954 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
955 CALL exchange_r2d_tile (ng, tile, &
956 & lbi, ubi, lbj, ubj, &
957 & bed_thick0)
958 CALL exchange_r2d_tile (ng, tile, &
959 & lbi, ubi, lbj, ubj, &
960 & bed_thick(:,:,1))
961 CALL exchange_r2d_tile (ng, tile, &
962 & lbi, ubi, lbj, ubj, &
963 & bed_thick(:,:,2))
964 END IF
965
966# ifdef DISTRIBUTE
967 CALL mp_exchange2d (ng, tile, model, 3, &
968 & lbi, ubi, lbj, ubj, &
969 & nghostpoints, &
970 & ewperiodic(ng), nsperiodic(ng), &
971 & bed_thick0, &
972 & bed_thick(:,:,1), bed_thick(:,:,2))
973# endif
974# endif
975# endif
976!
977 RETURN
978!
979 END SUBROUTINE ini_zeta_tile
980
981# ifdef SOLVE3D
982!
983!
984!***********************************************************************
985 SUBROUTINE set_zeta_timeavg (ng, tile, model)
986!***********************************************************************
987!
988 USE mod_stepping
989!
990! Imported variable declarations.
991!
992 integer, intent(in) :: ng, tile, model
993!
994! Local variable declarations.
995!
996 character (len=*), parameter :: myfile = &
997 & __FILE__//", set_zeta_timeavg"
998!
999# include "tile.h"
1000!
1001# ifdef PROFILE
1002 CALL wclock_on (ng, model, 2, __line__, myfile)
1003# endif
1004 CALL set_zeta_timeavg_tile (ng, tile, model, &
1005 & lbi, ubi, lbj, ubj, &
1006 & kstp(ng), &
1007 & ocean(ng) % zeta, &
1008 & coupling(ng) % Zt_avg1)
1009# ifdef PROFILE
1010 CALL wclock_off (ng, model, 2, __line__, myfile)
1011# endif
1012!
1013 RETURN
1014 END SUBROUTINE set_zeta_timeavg
1015!
1016!***********************************************************************
1017 SUBROUTINE set_zeta_timeavg_tile (ng, tile, model, &
1018 & LBi, UBi, LBj, UBj, &
1019 & kstp, &
1020 & zeta, &
1021 & Zt_avg1)
1022!***********************************************************************
1023!
1024! Imported variable declarations.
1025!
1026 integer, intent(in) :: ng, tile, model
1027 integer, intent(in) :: LBi, UBi, LBj, UBj
1028 integer, intent(in) :: kstp
1029!
1030# ifdef ASSUMED_SHAPE
1031 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
1032 real(r8), intent(inout) :: Zt_avg1(LBi:,LBj:)
1033# else
1034 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
1035 real(r8), intent(inout) :: Zt_avg1(LBi:UBi,LBj:UBj)
1036# endif
1037!
1038! Local variable declarations.
1039!
1040 integer :: i, j
1041!
1042# include "set_bounds.h"
1043!
1044!-----------------------------------------------------------------------
1045! Initialize fast-time averaged free-surface (Zt_avg1) with the inital
1046! free-surface.
1047!-----------------------------------------------------------------------
1048!
1049 DO j=jstrt,jendt
1050 DO i=istrt,iendt
1051 zt_avg1(i,j)=zeta(i,j,kstp)
1052 END DO
1053 END DO
1054!
1055 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1056 CALL exchange_r2d_tile (ng, tile, &
1057 & lbi, ubi, lbj, ubj, &
1058 & zt_avg1)
1059 END IF
1060
1061# ifdef DISTRIBUTE
1062!
1063 CALL mp_exchange2d (ng, tile, model, 1, &
1064 & lbi, ubi, lbj, ubj, &
1065 & nghostpoints, &
1066 & ewperiodic(ng), nsperiodic(ng), &
1067 & zt_avg1)
1068# endif
1069!
1070 RETURN
1071 END SUBROUTINE set_zeta_timeavg_tile
1072# endif
1073#endif
1074 END MODULE ini_fields_mod
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
exchange_2d_mod::exchange_u2d_tile
subroutine exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:440
exchange_2d_mod::exchange_v2d_tile
subroutine exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:627
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_r3d_tile
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:283
exchange_3d_mod::exchange_v3d_tile
subroutine exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:707
ini_fields_mod
Definition ini_fields.F:2
ini_fields_mod::ini_fields_tile
subroutine ini_fields_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kstp, krhs, knew, nstp, nnew, rmask, umask, vmask, rmask_wet, umask_wet, vmask_wet, ru, rv, rubar, rvbar, rzeta, bottom, bed, bed_frac, bed_mass, hz, t, u, v, ubar, vbar, zeta)
Definition ini_fields.F:166
ini_fields_mod::ini_zeta
subroutine, public ini_zeta(ng, tile, model)
Definition ini_fields.F:709
ini_fields_mod::set_zeta_timeavg
subroutine, public set_zeta_timeavg(ng, tile, model)
Definition ini_fields.F:986
ini_fields_mod::set_zeta_timeavg_tile
subroutine set_zeta_timeavg_tile(ng, tile, model, lbi, ubi, lbj, ubj, kstp, zeta, zt_avg1)
Definition ini_fields.F:1022
ini_fields_mod::ini_zeta_tile
subroutine ini_zeta_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kstp, krhs, knew, rmask, rmask_wet, h, bed, bed_thick0, bed_thick, zeta)
Definition ini_fields.F:771
ini_fields_mod::ini_fields
subroutine, public ini_fields(ng, tile, model)
Definition ini_fields.F:67
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_ncparam
Definition mod_ncparam.F:2
mod_ncparam::isvbar
integer isvbar
Definition mod_ncparam.F:505
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_ncparam::isubar
integer isubar
Definition mod_ncparam.F:504
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_param::lbc
type(t_lbc), dimension(:,:,:), allocatable lbc
Definition mod_param.F:375
mod_scalars
Definition mod_scalars.F:2
mod_scalars::dcrit
real(r8), dimension(:), allocatable dcrit
Definition mod_scalars.F:782
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_scalars::perfectrst
logical, dimension(:), allocatable perfectrst
Definition mod_scalars.F:244
mod_scalars::ltracerclm
logical, dimension(:,:), allocatable ltracerclm
Definition mod_scalars.F:528
mod_scalars::lnudgetclm
logical, dimension(:,:), allocatable lnudgetclm
Definition mod_scalars.F:535
mod_sedbed
Definition sedbed_mod.h:1
mod_sedbed::sedbed
type(t_sedbed), dimension(:), allocatable sedbed
Definition sedbed_mod.h:157
mod_sediment
Definition sediment_mod.h:1
mod_sediment::ithck
integer, parameter ithck
Definition sediment_mod.h:116
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
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange4d
subroutine mp_exchange4d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, nghost, ew_periodic, ns_periodic, a, b, c)
Definition mp_exchange.F:3377
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
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
t3dbc_mod
Definition t3dbc_im.F:2
t3dbc_mod::t3dbc_tile
subroutine, public t3dbc_tile(ng, tile, itrc, ic, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nout, t)
Definition t3dbc_im.F:55
u2dbc_mod
Definition u2dbc_im.F:2
u2dbc_mod::u2dbc_tile
subroutine, public u2dbc_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, krhs, kstp, kout, ubar, vbar, zeta)
Definition u2dbc_im.F:56
u3dbc_mod
Definition u3dbc_im.F:2
u3dbc_mod::u3dbc_tile
subroutine, public u3dbc_tile(ng, tile, lbi, ubi, lbj, ubj, ubk, imins, imaxs, jmins, jmaxs, nstp, nout, u)
Definition u3dbc_im.F:55
v2dbc_mod
Definition v2dbc_im.F:3
v2dbc_mod::v2dbc_tile
subroutine, public v2dbc_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, krhs, kstp, kout, ubar, vbar, zeta)
Definition v2dbc_im.F:57
v3dbc_mod
Definition v3dbc_im.F:2
v3dbc_mod::v3dbc_tile
subroutine, public v3dbc_tile(ng, tile, lbi, ubi, lbj, ubj, ubk, imins, imaxs, jmins, jmaxs, nstp, nout, v)
Definition v3dbc_im.F:55
zetabc_mod
Definition zetabc.F:2
zetabc_mod::zetabc_tile
subroutine, public zetabc_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, krhs, kstp, kout, zeta)
Definition zetabc.F:65
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