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

Functions/Subroutines

subroutine, public hsimt_tvd_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, rmask, umask, vmask, rmask_wet, umask_wet, vmask_wet, pm, pn, huon, hvom, ohz, t, fx, fe)
 

Function/Subroutine Documentation

◆ hsimt_tvd_tile()

subroutine, public hsimt_tvd_mod::hsimt_tvd_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) rmask,
real(r8), dimension(lbi:,lbj:), intent(in) umask,
real(r8), dimension(lbi:,lbj:), intent(in) vmask,
real(r8), dimension(lbi:,lbj:), intent(in) rmask_wet,
real(r8), dimension(lbi:,lbj:), intent(in) umask_wet,
real(r8), dimension(lbi:,lbj:), intent(in) vmask_wet,
real(r8), dimension(lbi:,lbj:), intent(in) pm,
real(r8), dimension(lbi:,lbj:), intent(in) pn,
real(r8), dimension(lbi:,lbj:), intent(in) huon,
real(r8), dimension(lbi:,lbj:), intent(in) hvom,
real(r8), dimension(imins:,jmins:), intent(in) ohz,
real(r8), dimension(lbi:,lbj:), intent(in) t,
real(r8), dimension(imins:,jmins:), intent(out) fx,
real(r8), dimension(imins:,jmins:), intent(out) fe )

Definition at line 35 of file hsimt_tvd.F.

47!***********************************************************************
48!
49 USE mod_param
50 USE mod_ncparam
51 USE mod_scalars
52!
53! Imported variable declarations.
54!
55 integer, intent(in) :: ng, tile
56 integer, intent(in) :: LBi, UBi, LBj, UBj
57 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
58!
59# ifdef ASSUMED_SHAPE
60# ifdef MASKING
61 real(r8), intent(in) :: rmask(LBi:,LBj:)
62 real(r8), intent(in) :: umask(LBi:,LBj:)
63 real(r8), intent(in) :: vmask(LBi:,LBj:)
64# endif
65# ifdef WET_DRY
66 real(r8), intent(in) :: rmask_wet(LBi:,LBj:)
67 real(r8), intent(in) :: umask_wet(LBi:,LBj:)
68 real(r8), intent(in) :: vmask_wet(LBi:,LBj:)
69# endif
70 real(r8), intent(in) :: pm(LBi:,LBj:)
71 real(r8), intent(in) :: pn(LBi:,LBj:)
72 real(r8), intent(in) :: Huon(LBi:,LBj:)
73 real(r8), intent(in) :: Hvom(LBi:,LBj:)
74 real(r8), intent(in) :: oHz(IminS:,JminS:)
75 real(r8), intent(in) :: t(LBi:,LBj:)
76 real(r8), intent(out) :: FX(IminS:,JminS:)
77 real(r8), intent(out) :: FE(IminS:,JminS:)
78# else
79# ifdef MASKING
80 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
81 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
82 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
83# endif
84# ifdef WET_DRY
85 real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj)
86 real(r8), intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
87 real(r8), intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
88# endif
89 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
90 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
91 real(r8), intent(in) :: Huon(LBi:UBi,LBj:UBj)
92 real(r8), intent(in) :: Hvom(LBi:UBi,LBj:UBj)
93 real(r8), intent(in) :: oHz(IminS:ImaxS,JminS:JmaxS)
94 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj)
95 real(r8), intent(out) :: FX(IminS:ImaxS,JminS:JmaxS)
96 real(r8), intent(out) :: FE(IminS:ImaxS,JminS:JmaxS)
97# endif
98!
99! Local variable declarations.
100!
101 integer :: i, is, j, k, ii, jj
102
103 real(r8) :: cc1 = 0.25_r8
104 real(r8) :: cc2 = 0.5_r8
105 real(r8) :: cc3 = 1.0_r8/12.0_r8
106 real(r8) :: eps1 = 1.0e-12_r8
107
108 real(r8) :: cff, cff1
109 real(r8) :: betaL, betaR, betaD, betaU
110 real(r8) :: rL, rR, rD, rU, rkaL, rkaR, rkaD, rkaU
111 real(r8) :: a1, b1, sw_eta, sw_xi
112
113 real(r8), dimension(IminS:ImaxS) :: gradX, KaX, oKaX
114 real(r8), dimension(JminS:JmaxS) :: gradE, KaE, oKaE
115
116# include "set_bounds.h"
117!
118!-----------------------------------------------------------------------
119! Compute tracer horizontal aadvective fluxes using the HSIMT scheme
120! (Wu and Zhu, 2010).
121!-----------------------------------------------------------------------
122!
123 DO j=jstr,jend
124 DO i=istru-1,iendp2
125 cff=0.125_r8*(pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))*dt(ng)
126 cff1=cff*(ohz(i-1,j)+ohz(i,j))
127 gradx(i)=t(i,j)-t(i-1,j)
128 kax(i)=1.0_r8-abs(huon(i,j)*cff1)
129# ifdef MASKING
130 gradx(i)=gradx(i)*umask(i,j)
131 kax(i)=kax(i)*umask(i,j)
132# endif
133 END DO
134 IF (.not.ewperiodic(ng)) THEN
135 IF (domain(ng)%Western_Edge(tile)) THEN
136 IF (huon(istr,j).ge.0.0_r8) THEN
137 gradx(istr-1)=0.0_r8
138 kax(istr-1)=0.0_r8
139 END IF
140 END IF
141 IF (domain(ng)%Eastern_Edge(tile)) THEN
142 IF (huon(iend+1,j).lt.0.0_r8) THEN
143 gradx(iend+2)=0.0_r8
144 kax(iend+2)=0.0_r8
145 END IF
146 END IF
147 END IF
148 DO i=istr,iend+1
149 IF (kax(i).le.eps1) THEN
150 okax(i)=0.0_r8
151 ELSE
152 okax(i)=1.0_r8/max(kax(i),eps1)
153 END IF
154 IF (huon(i,j).ge.0.0_r8) THEN
155 IF (abs(gradx(i)).le.eps1) THEN
156 rl=0.0_r8
157 rkal=0.0_r8
158 ELSE
159 rl=gradx(i-1)/gradx(i)
160 rkal=kax(i-1)*okax(i)
161 END IF
162 a1= cc1*kax(i)+cc2-cc3*okax(i)
163 b1=-cc1*kax(i)+cc2+cc3*okax(i)
164 betal=a1+b1*rl
165 cff=0.5_r8*max(0.0_r8, &
166 & min(2.0_r8, 2.0_r8*rl*rkal, betal))* &
167 & gradx(i)*kax(i)
168# ifdef MASKING
169 ii=max(i-2,0)
170 cff=cff*rmask(ii,j)
171# endif
172 sw_xi=t(i-1,j)+cff
173 ELSE
174 IF (abs(gradx(i)).le.eps1) THEN
175 rr=0.0_r8
176 rkar=0.0_r8
177 ELSE
178 rr=gradx(i+1)/gradx(i)
179 rkar=kax(i+1)*okax(i)
180 END IF
181 a1= cc1*kax(i)+cc2-cc3*okax(i)
182 b1=-cc1*kax(i)+cc2+cc3*okax(i)
183 betar=a1+b1*rr
184 cff=0.5_r8*max(0.0_r8, &
185 & min(2.0_r8, 2.0_r8*rr*rkar, betar))* &
186 & gradx(i)*kax(i)
187# ifdef MASKING
188 ii=min(i+1,lm(ng)+1)
189 cff=cff*rmask(ii,j)
190# endif
191 sw_xi=t(i,j)-cff
192 END IF
193 fx(i,j)=sw_xi*huon(i,j)
194 END DO
195 END DO
196!
197 DO i=istr,iend
198 DO j=jstrv-1,jendp2
199 cff=0.125_r8*(pn(i,j)+pn(i,j-1))*(pm(i,j)+pm(i,j-1))*dt(ng)
200 cff1=cff*(ohz(i,j)+ohz(i,j-1))
201 grade(j)=t(i,j)-t(i,j-1)
202 kae(j)=1.0_r8-abs(hvom(i,j)*cff1)
203# ifdef MASKING
204 grade(j)=grade(j)*vmask(i,j)
205 kae(j)=kae(j)*vmask(i,j)
206# endif
207 END DO
208 IF (.not.nsperiodic(ng)) THEN
209 IF (domain(ng)%Southern_Edge(tile)) THEN
210 IF (hvom(i,jstr).ge.0.0_r8) THEN
211 grade(jstr-1)=0.0_r8
212 kae(jstr-1)=0.0_r8
213 END IF
214 END IF
215 IF (domain(ng)%Northern_Edge(tile)) THEN
216 IF (hvom(i,jend+1).lt.0.0_r8) THEN
217 grade(jend+2)=0.0_r8
218 kae(jend+2)=0.0_r8
219 END IF
220 END IF
221 END IF
222 DO j=jstr,jend+1
223 IF (kae(j).le.eps1) THEN
224 okae(j)=0.0_r8
225 ELSE
226 okae(j)=1.0_r8/max(kae(j),eps1)
227 END IF
228 IF (hvom(i,j).ge.0.0_r8) THEN
229 IF (abs(grade(j)).le.eps1) THEN
230 rd=0.0_r8
231 rkad=0.0_r8
232 ELSE
233 rd=grade(j-1)/grade(j)
234 rkad=kae(j-1)*okae(j)
235 END IF
236 a1= cc1*kae(j)+cc2-cc3*okae(j)
237 b1=-cc1*kae(j)+cc2+cc3*okae(j)
238 betad=a1+b1*rd
239 cff=0.5_r8*max(0.0_r8, &
240 & min(2.0_r8, 2.0_r8*rd*rkad, betad))* &
241 & grade(j)*kae(j)
242# ifdef MASKING
243 jj=max(j-2,0)
244 cff=cff*rmask(i,jj)
245# endif
246 sw_eta=t(i,j-1)+cff
247 ELSE
248 IF (abs(grade(j)).le.eps1) THEN
249 ru=0.0_r8
250 rkau=0.0_r8
251 ELSE
252 ru=grade(j+1)/grade(j)
253 rkau=kae(j+1)*okae(j)
254 END IF
255 a1= cc1*kae(j)+cc2-cc3*okae(j)
256 b1=-cc1*kae(j)+cc2+cc3*okae(j)
257 betau=a1+b1*ru
258 cff=0.5*max(0.0_r8, &
259 & min(2.0_r8, 2.0_r8*ru*rkau, betau))* &
260 & grade(j)*kae(j)
261# ifdef MASKING
262 jj=min(j+1,mm(ng)+1)
263 cff=cff*rmask(i,jj)
264# endif
265 sw_eta=t(i,j)-cff
266 END IF
267 fe(i,j)=sw_eta*hvom(i,j)
268 END DO
269 END DO
270!
271 RETURN
mod_ncparam
Definition mod_ncparam.F:2
mod_param
Definition mod_param.F:2
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_param::lm
integer, dimension(:), allocatable lm
Definition mod_param.F:455
mod_param::mm
integer, dimension(:), allocatable mm
Definition mod_param.F:456
mod_scalars
Definition mod_scalars.F:2
mod_scalars::cc3
real(r8) cc3
Definition mod_scalars.F:395
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::cc1
real(r8) cc1
Definition mod_scalars.F:393
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::cc2
real(r8) cc2
Definition mod_scalars.F:394

References mod_scalars::cc1, mod_scalars::cc2, mod_scalars::cc3, mod_param::domain, mod_scalars::dt, mod_scalars::ewperiodic, mod_param::lm, mod_param::mm, and mod_scalars::nsperiodic.