ROMS
Loading...
Searching...
No Matches
ana_tobc.h
Go to the documentation of this file.
1!!
2 SUBROUTINE ana_tobc (ng, tile, model)
3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets tracer-type variables open boundary conditions !
12! using analytical expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_boundary
18 USE mod_grid
19 USE mod_ncparam
20 USE mod_ocean
21 USE mod_stepping
22!
23! Imported variable declarations.
24!
25 integer, intent(in) :: ng, tile, model
26!
27! Local variable declarations.
28!
29 character (len=*), parameter :: MyFile = &
30 & __FILE__
31!
32#include "tile.h"
33!
34 CALL ana_tobc_tile (ng, tile, model, &
35 & lbi, ubi, lbj, ubj, &
36 & imins, imaxs, jmins, jmaxs, &
37 & nstp(ng), &
38 & grid(ng) % z_r, &
39 & ocean(ng) % t)
40!
41! Set analytical header file name used.
42!
43#ifdef DISTRIBUTE
44 IF (lanafile) THEN
45#else
46 IF (lanafile.and.(tile.eq.0)) THEN
47#endif
48 ananame(34)=myfile
49 END IF
50!
51 RETURN
52 END SUBROUTINE ana_tobc
53!
54!***********************************************************************
55 SUBROUTINE ana_tobc_tile (ng, tile, model, &
56 & LBi, UBi, LBj, UBj, &
57 & IminS, ImaxS, JminS, JmaxS, &
58 & nstp, &
59 & z_r, t)
60!***********************************************************************
61!
62 USE mod_param
63 USE mod_scalars
64 USE mod_boundary
65 USE mod_ncparam
66 USE mod_ocean
67#ifdef SEDIMENT
68 USE mod_sediment
69#endif
70!
71! Imported variable declarations.
72!
73 integer, intent(in) :: ng, tile, model
74 integer, intent(in) :: LBi, UBi, LBj, UBj
75 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
76 integer, intent(in) :: nstp
77
78#ifdef ASSUMED_SHAPE
79 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
80 real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
81#else
82 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
83 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
84#endif
85!
86! Local variable declarations.
87!
88 integer :: i, ised, itrc, j, k
89!
90 real(r8) :: cff
91
92#include "set_bounds.h"
93!
94!-----------------------------------------------------------------------
95! Tracers open boundary conditions.
96!-----------------------------------------------------------------------
97!
98#ifdef ESTUARY_TEST
99 IF (any(lbc(ieast,istvar(:),ng)%acquire).and. &
100 & domain(ng)%Eastern_Edge(tile)) THEN
101 DO k=1,n(ng)
102 DO j=jstrt,jendt
103 boundary(ng)%t_east(j,k,itemp)=t0(ng)
104# ifdef SALINITY
105 boundary(ng)%t_east(j,k,isalt)=0.0_r8
106# endif
107# ifdef SEDIMENT
108 DO ised=1,nst
109 boundary(ng)%t_east(j,k,idsed(ised))=0.0_r8
110 END DO
111# endif
112 END DO
113 END DO
114 END IF
115
116 IF (any(lbc(iwest,istvar(:),ng)%acquire).and. &
117 & domain(ng)%Western_Edge(tile)) THEN
118 DO k=1,n(ng)
119 DO j=jstrt,jendt
120 boundary(ng)%t_west(j,k,itemp)=t0(ng)
121# ifdef SALINITY
122 boundary(ng)%t_west(j,k,isalt)=30.0_r8
123# endif
124# ifdef SEDIMENT
125 DO ised=1,nst
126 boundary(ng)%t_west(j,k,idsed(ised))=0.0_r8
127 END DO
128# endif
129 END DO
130 END DO
131 END IF
132
133#elif defined NJ_BIGHT
134 IF (any(lbc(ieast,istvar(:),ng)%acquire).and. &
135 & domain(ng)%Eastern_Edge(tile)) THEN
136 DO k=1,n(ng)
137 DO j=jstrt,jendt
138 IF (z_r(iend+1,j,k).ge.-15.0_r8) THEN
139 boundary(ng)%t_east(j,k,itemp)=2.04926425772840e+01_r8- &
140 & z_r(iend+1,j,k)* &
141 & (2.64085084879392e-01_r8+ &
142 & z_r(iend+1,j,k)* &
143 & (2.75112532853521e-01_r8+ &
144 & z_r(iend+1,j,k)* &
145 & (9.20748976164887e-02_r8+ &
146 & z_r(iend+1,j,k)* &
147 & (1.44907572574284e-02_r8+ &
148 & z_r(iend+1,j,k)* &
149 & (1.07821568591208e-03_r8+ &
150 & z_r(iend+1,j,k)* &
151 & (3.24031805390397e-05_r8+ &
152 & 1.26282685769027e-07_r8*
153 & z_r(iend+1,j,k)))))))
154# ifdef SALINITY
155 boundary(ng)%t_east(j,k,isalt)=3.06648914919313e+01_r8- &
156 & z_r(iend+1,j,k)* &
157 & (1.47672526294673e-01_r8+ &
158 & z_r(iend+1,j,k)* &
159 & (1.12645576031340e-01_r8+ &
160 & z_r(iend+1,j,k)* &
161 & (3.90092328187102e-02_r8+ &
162 & z_r(iend+1,j,k)* &
163 & (6.93901493744710e-03_r8+ &
164 & z_r(iend+1,j,k)* &
165 & (6.60443669679294e-04_r8+ &
166 & z_r(iend+1,j,k)* &
167 & (3.19179236195422e-05_r8+ &
168 & 6.17735263440932e-07_r8*
169 & z_r(iend+1,j,k)))))))
170# endif
171 ELSE
172 cff=tanh(1.1_r8*z_r(iend+1,j,k)+15.9_r8)
173 t_east(j,k,itemp)=14.6_r8+6.70_r8*cff
174# ifdef SALINITY
175 t_east(j,k,isalt)=31.3_r8-0.55_r8*cff
176# endif
177 END IF
178 END DO
179 END DO
180 END IF
181
182 IF (any(lbc(isouth,istvar(:),ng)%acquire).and. &
183 & domain(ng)%Southern_Edge(tile)) THEN
184 DO k=1,n(ng)
185 DO i=istrt,iendt
186 IF (z_r(i,jstr-1,k).ge.-15.0_r8) THEN
187 boundary(ng)%t_south(i,k,itemp)=2.04926425772840e+01_r8- &
188 & z_r(i,jstr-1,k)* &
189 & (2.64085084879392e-01_r8+ &
190 & z_r(i,jstr-1,k)* &
191 & (2.75112532853521e-01_r8+&
192 & z_r(i,jstr-1,k)* &
193 & (9.20748976164887e-02_r8+&
194 & z_r(i,jstr-1,k)* &
195 & (1.44907572574284e-02_r8+&
196 & z_r(i,jstr-1,k)* &
197 & (1.07821568591208e-03_r8+&
198 & z_r(i,jstr-1,k)* &
199 & (3.24031805390397e-05_r8+&
200 & 1.26282685769027e-07_r8*
201 & z_r(i,jstr-1,k)))))))
202# ifdef SALINITY
203 boundary(ng)%t_south(i,k,isalt)=3.06648914919313e+01_r8- &
204 & z_r(i,jstr-1,k)* &
205 & (1.47672526294673e-01_r8+ &
206 & z_r(i,jstr-1,k)* &
207 & (1.12645576031340e-01_r8+&
208 & z_r(i,jstr-1,k)* &
209 & (3.90092328187102e-02_r8+&
210 & z_r(i,jstr-1,k)* &
211 & (6.93901493744710e-03_r8+&
212 & z_r(i,jstr-1,k)* &
213 & (6.60443669679294e-04_r8+&
214 & z_r(i,jstr-1,k)* &
215 & (3.19179236195422e-05_r8+&
216 & 6.17735263440932e-07_r8*
217 & z_r(i,jstr-1,k)))))))
218# endif
219 ELSE
220 cff=tanh(1.1_r8*depth+15.9_r8)
221 boundary(ng)%t_south(i,k,itemp)=14.6_r8+6.70_r8*cff
222# ifdef SALINITY
223 boundary(ng)%t_south(i,k,isalt)=31.3_r8-0.55_r8*cff
224# endif
225 END IF
226 END DO
227 END DO
228 END IF
229
230#elif defined SED_TEST1
231 IF (any(lbc(ieast,istvar(:),ng)%acquire).and. &
232 & domain(ng)%Eastern_Edge(tile)) THEN
233 DO k=1,n(ng)
234 DO j=jstrt,jendt
235 boundary(ng)%t_east(j,k,itemp)=20.0_r8
236# ifdef SALINITY
237 boundary(ng)%t_east(j,k,isalt)=0.0_r8
238# endif
239 END DO
240 END DO
241 END IF
242
243#else
244 IF (any(lbc(ieast,istvar(:),ng)%acquire).and. &
245 & domain(ng)%Eastern_Edge(tile)) THEN
246 DO itrc=1,nt(ng)
247 DO k=1,n(ng)
248 DO j=jstrt,jendt
249 boundary(ng)%t_east(j,k,itrc)=0.0_r8
250 END DO
251 END DO
252 END DO
253 END IF
254
255 IF (any(lbc(iwest,istvar(:),ng)%acquire).and. &
256 & domain(ng)%Western_Edge(tile)) THEN
257 DO itrc=1,nt(ng)
258 DO k=1,n(ng)
259 DO j=jstrt,jendt
260 boundary(ng)%t_west(j,k,itrc)=0.0_r8
261 END DO
262 END DO
263 END DO
264 END IF
265
266 IF (any(lbc(isouth,istvar(:),ng)%acquire).and. &
267 & domain(ng)%Southern_Edge(tile)) THEN
268 DO itrc=1,nt(ng)
269 DO k=1,n(ng)
270 DO i=istrt,iendt
271 boundary(ng)%t_south(i,k,itrc)=0.0_r8
272 END DO
273 END DO
274 END DO
275 END IF
276
277 IF (any(lbc(inorth,istvar(:),ng)%acquire).and. &
278 & domain(ng)%Northern_Edge(tile)) THEN
279 DO itrc=1,nt(ng)
280 DO k=1,n(ng)
281 DO i=istrt,iendt
282 boundary(ng)%t_north(i,k,itrc)=0.0_r8
283 END DO
284 END DO
285 END DO
286 END IF
287#endif
288!
289 RETURN
290 END SUBROUTINE ana_tobc_tile
subroutine ana_tobc(ng, tile, model)
Definition ana_tobc.h:3
subroutine ana_tobc_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nstp, z_r, t)
Definition ana_tobc.h:60
type(t_boundary), dimension(:), allocatable boundary
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
integer, dimension(:), allocatable istvar
logical lanafile
character(len=256), dimension(39) ananame
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
type(t_lbc), dimension(:,:,:), allocatable lbc
Definition mod_param.F:375
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
integer nst
Definition mod_param.F:521
real(r8), dimension(:), allocatable t0
integer, parameter iwest
integer isalt
integer itemp
integer, parameter isouth
integer, parameter ieast
integer, parameter inorth
integer, dimension(:), allocatable idsed
integer, dimension(:), allocatable nstp