75
76
80
83# ifdef DISTRIBUTE
85# endif
86
87
88
89 integer, intent(in) :: ng, tile
90 integer, intent(in) :: LBi, UBi, LBj, UBj
91 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
92 integer, intent(in) :: Ninp
93
94# ifdef ASSUMED_SHAPE
95 real(r8), intent(in) :: pm(LBi:,LBj:)
96 real(r8), intent(in) :: pn(LBi:,LBj:)
97 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
98 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
99 real(r8), intent(inout) :: DU_avg1(LBi:,LBj:)
100 real(r8), intent(inout) :: DV_avg1(LBi:,LBj:)
101 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
102 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
103 real(r8), intent(in) :: W(LBi:,LBj:,0:)
104# ifdef OMEGA_IMPLICIT
105 real(r8), intent(in) :: Wi(LBi:,LBj:,0:)
106# endif
107 real(r8), intent(out) :: wvel(LBi:,LBj:,0:)
108# else
109 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
110 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
111 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
112 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
113 real(r8), intent(inout) :: DU_avg1(LBi:UBi,LBj:UBj)
114 real(r8), intent(inout) :: DV_avg1(LBi:UBi,LBj:UBj)
115 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
116 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
117 real(r8), intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng))
118# ifdef OMEGA_IMPLICIT
119 real(r8), intent(in) :: Wi(LBi:UBi,LBj:UBj,0:N(ng))
120# endif
121 real(r8), intent(out) :: wvel(LBi:UBi,LBj:UBj,0:N(ng))
122# endif
123
124
125
126 integer :: i, j, k
127
128 real(r8) :: cff1, cff2, cff3, cff4, cff5, slope
129
130 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: vert
131
132 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wrk
133
134# include "set_bounds.h"
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
156 & lbi, ubi, lbj, ubj, &
157 & du_avg1)
159 & lbi, ubi, lbj, ubj, &
160 & dv_avg1)
161 END IF
162
163# ifdef DISTRIBUTE
165 & lbi, ubi, lbj, ubj, &
168 & du_avg1, dv_avg1)
169# endif
170
171
172
173
175 DO j=jstr,jend
176 DO i=istr,iend+1
177 wrk(i,j)=u(i,j,k,ninp)*(z_r(i,j,k)-z_r(i-1,j,k))* &
178 & (pm(i-1,j)+pm(i,j))
179 END DO
180 DO i=istr,iend
181 vert(i,j,k)=0.25_r8*(wrk(i,j)+wrk(i+1,j))
182 END DO
183 END DO
184 DO j=jstr,jend+1
185 DO i=istr,iend
186 wrk(i,j)=v(i,j,k,ninp)*(z_r(i,j,k)-z_r(i,j-1,k))* &
187 & (pn(i,j-1)+pn(i,j))
188 END DO
189 END DO
190 DO j=jstr,jend
191 DO i=istr,iend
192 vert(i,j,k)=vert(i,j,k)+0.25_r8*(wrk(i,j)+wrk(i,j+1))
193 END DO
194 END DO
195 END DO
196
197
198
199
200
201
202
203
204
205 cff1=3.0_r8/8.0_r8
206 cff2=3.0_r8/4.0_r8
207 cff3=1.0_r8/8.0_r8
208 cff4=9.0_r8/16.0_r8
209 cff5=1.0_r8/16.0_r8
210
211 j_loop : DO j=jstr,jend
212 DO i=istr,iend
213 wrk(i,j)=(du_avg1(i,j)-du_avg1(i+1,j)+ &
214 & dv_avg1(i,j)-dv_avg1(i,j+1))/ &
215 & (z_w(i,j,
n(ng))-z_w(i,j,0))
216 END DO
217
218
219
220
221 DO i=istr,iend
222 slope=(z_r(i,j,1)-z_w(i,j,0))/ &
223 & (z_r(i,j,2)-z_r(i,j,1))
224 wvel(i,j,0)=cff1*(vert(i,j,1)- &
225 & slope*(vert(i,j,2)- &
226 & vert(i,j,1)))+ &
227 & cff2*vert(i,j,1)- &
228 & cff3*vert(i,j,2)
229 wvel(i,j,1)=pm(i,j)*pn(i,j)* &
230 & (w(i,j,1)+ &
231# ifdef OMEGA_IMPLICIT
232 & wi(i,j,1)+ &
233# endif
234 & wrk(i,j)*(z_w(i,j,1)-z_w(i,j,0)))+ &
235 & cff1*vert(i,j,1)+ &
236 & cff2*vert(i,j,2)- &
237 & cff3*vert(i,j,3)
238 END DO
240 DO i=istr,iend
241 wvel(i,j,k)=pm(i,j)*pn(i,j)* &
242 & (w(i,j,k)+ &
243# ifdef OMEGA_IMPLICIT
244 & wi(i,j,k)+ &
245# endif
246 & wrk(i,j)*(z_w(i,j,k)-z_w(i,j,0)))+ &
247 & cff4*(vert(i,j,k )+vert(i,j,k+1))- &
248 & cff5*(vert(i,j,k-1)+vert(i,j,k+2))
249 END DO
250 END DO
251 DO i=istr,iend
252 slope=(z_w(i,j,
n(ng))-z_r(i,j,
n(ng) ))/ &
253 & (z_r(i,j,
n(ng))-z_r(i,j,
n(ng)-1))
254 wvel(i,j,
n(ng))=pm(i,j)*pn(i,j)* &
255 & wrk(i,j)*(z_w(i,j,
n(ng))-z_w(i,j,0))+ &
256 & cff1*(vert(i,j,
n(ng))+ &
257 & slope*(vert(i,j,
n(ng) )- &
258 & vert(i,j,
n(ng)-1)))+ &
259 & cff2*vert(i,j,
n(ng) )- &
260 & cff3*vert(i,j,
n(ng)-1)
261 wvel(i,j,
n(ng)-1)=pm(i,j)*pn(i,j)* &
263# ifdef OMEGA_IMPLICIT
265# endif
266 & wrk(i,j)*(z_w(i,j,
n(ng)-1)-z_w(i,j,0)))+ &
267 & cff1*vert(i,j,
n(ng) )+ &
268 & cff2*vert(i,j,
n(ng)-1)- &
269 & cff3*vert(i,j,
n(ng)-2)
270 END DO
271 END DO j_loop
272
273
274
276 & lbi, ubi, lbj, ubj, 0,
n(ng), &
277 & wvel)
278# ifdef DISTRIBUTE
280 & lbi, ubi, lbj, ubj, 0,
n(ng), &
283 & wvel)
284# endif
285
286 RETURN
subroutine bc_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
subroutine exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
integer, dimension(:), allocatable n
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 mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)