ROMS
Loading...
Searching...
No Matches
set_zeta.F
Go to the documentation of this file.
1#include "cppdefs.h"
3
4#ifdef SOLVE3D
5!
6!git $Id$
7!================================================== Hernan G. Arango ===
8! Copyright (c) 2002-2025 The ROMS Group !
9! Licensed under a MIT/X style license !
10! See License_ROMS.md !
11!=======================================================================
12! !
13! This routine sets free-surface to its fast-time averaged value. !
14! !
15!=======================================================================
16!
17 implicit none
18!
19 PRIVATE
20 PUBLIC :: set_zeta
21!
22 CONTAINS
23!
24!***********************************************************************
25 SUBROUTINE set_zeta (ng, tile)
26!***********************************************************************
27!
28 USE mod_param
29 USE mod_coupling
30 USE mod_ocean
31!
32! Imported variable declarations.
33!
34 integer, intent(in) :: ng, tile
35!
36! Local variable declarations.
37!
38 character (len=*), parameter :: myfile = &
39 & __FILE__
40!
41# include "tile.h"
42!
43# ifdef PROFILE
44 CALL wclock_on (ng, inlm, 12, __line__, myfile)
45# endif
46 CALL set_zeta_tile (ng, tile, &
47 & lbi, ubi, lbj, ubj, &
48 & imins, imaxs, jmins, jmaxs, &
49 & coupling(ng) % Zt_avg1, &
50 & ocean(ng) % zeta)
51# ifdef PROFILE
52 CALL wclock_off (ng, inlm, 12, __line__, myfile)
53# endif
54!
55 RETURN
56 END SUBROUTINE set_zeta
57!
58!***********************************************************************
59 SUBROUTINE set_zeta_tile (ng, tile, &
60 & LBi, UBi, LBj, UBj, &
61 & IminS, ImaxS, JminS, JmaxS, &
62 & Zt_avg1, zeta)
63!***********************************************************************
64!
65 USE mod_param
66 USE mod_scalars
67!
69# ifdef DISTRIBUTE
71# endif
72!
73! Imported variable declarations.
74!
75 integer, intent(in) :: ng, tile
76 integer, intent(in) :: LBi, UBi, LBj, UBj
77 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
78!
79# ifdef ASSUMED_SHAPE
80 real(r8), intent(in) :: Zt_avg1(LBi:,LBj:)
81
82 real(r8), intent(out) :: zeta(LBi:,LBj:,:)
83# else
84 real(r8), intent(in) :: Zt_avg1(LBi:UBi,LBj:UBj)
85
86 real(r8), intent(out) :: zeta(LBi:UBi,LBj:UBj,3)
87# endif
88!
89! Local variable declarations.
90!
91 integer :: i, j
92
93# include "set_bounds.h"
94!
95!-----------------------------------------------------------------------
96! Prepare to time-step 2D equations: set initial free-surface
97! to its fast-time averaged values (which corresponds to the time
98! step "n").
99!-----------------------------------------------------------------------
100!
101 DO j=jstrr,jendr
102 DO i=istrr,iendr
103 zeta(i,j,1)=zt_avg1(i,j)
104 zeta(i,j,2)=zt_avg1(i,j)
105 END DO
106 END DO
107
108 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
109 CALL exchange_r2d_tile (ng, tile, &
110 & lbi, ubi, lbj, ubj, &
111 & zeta(:,:,1))
112 CALL exchange_r2d_tile (ng, tile, &
113 & lbi, ubi, lbj, ubj, &
114 & zeta(:,:,2))
115 END IF
116
117# ifdef DISTRIBUTE
118 CALL mp_exchange2d (ng, tile, inlm, 2, &
119 & lbi, ubi, lbj, ubj, &
120 & nghostpoints, &
121 & ewperiodic(ng), nsperiodic(ng), &
122 & zeta(:,:,1), &
123 & zeta(:,:,2))
124# endif
125!
126 RETURN
127 END SUBROUTINE set_zeta_tile
128#endif
129 END MODULE set_zeta_mod
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
type(t_coupling), dimension(:), allocatable coupling
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
integer, parameter inlm
Definition mod_param.F:662
integer nghostpoints
Definition mod_param.F:710
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine, public set_zeta(ng, tile)
Definition set_zeta.F:26
subroutine set_zeta_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, zt_avg1, zeta)
Definition set_zeta.F:63
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3