87 & bed_thick, ad_bed_thick, &
88# endif
89 & huon, hvom, z_w, &
90 & ad_huon, ad_hvom, ad_z_w, &
91 & w, ad_w_sol, ad_w)
92
93
97
100# ifdef DISTRIBUTE
103# endif
104
105
106
107 integer, intent(in) :: ng, tile, model
108 integer, intent(in) :: LBi, UBi, LBj, UBj
109 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
110# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
111 integer, intent(in) :: nstp, nnew
112# endif
113
114# ifdef ASSUMED_SHAPE
115 real(r8), intent(in) :: Huon(LBi:,LBj:,:)
116 real(r8), intent(in) :: Hvom(LBi:,LBj:,:)
117 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
118# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
119 real(r8), intent(in) :: omn(LBi:,LBj:)
120 real(r8), intent(in):: bed_thick(LBi:,LBj:,:)
121 real(r8), intent(inout):: ad_bed_thick(LBi:,LBj:,:)
122# endif
123 real(r8), intent(inout) :: ad_Huon(LBi:,LBj:,:)
124 real(r8), intent(inout) :: ad_Hvom(LBi:,LBj:,:)
125 real(r8), intent(inout) :: ad_z_w(LBi:,LBj:,0:)
126 real(r8), intent(inout) :: ad_W(LBi:,LBj:,0:)
127 real(r8), intent(inout) :: ad_W_sol(LBi:,LBj:,0:)
128
129 real(r8), intent(out) :: W(LBi:,LBj:,0:)
130
131# else
132
133 real(r8), intent(in) :: Huon(LBi:UBi,LBj:UBj,N(ng))
134 real(r8), intent(in) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
135 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
136# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
137 real(r8), intent(in) :: omn(LBi:UBi,LBj:UBj)
138 real(r8), intent(in):: bed_thick(LBi:UBi,LBj:UBj,2)
139 real(r8), intent(inout):: ad_bed_thick(LBi:UBi,LBj:UBj,2)
140# endif
141 real(r8), intent(inout) :: ad_Huon(LBi:UBi,LBj:UBj,N(ng))
142 real(r8), intent(inout) :: ad_Hvom(LBi:UBi,LBj:UBj,N(ng))
143 real(r8), intent(inout) :: ad_z_w(LBi:UBi,LBj:UBj,0:N(ng))
144 real(r8), intent(inout) :: ad_W(LBi:UBi,LBj:UBj,0:N(ng))
145 real(r8), intent(inout) :: ad_W_sol(LBi:UBi,LBj:UBj,0:N(ng))
146
147 real(r8), intent(out) :: W(LBi:UBi,LBj:UBj,0:N(ng))
148# endif
149
150
151
152 integer :: i, ii, is, j, jj, k
153 real(r8) :: cff
154 real(r8) :: ad_cff, adfac
155# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
156 real(r8) :: cff1
157# endif
158 real(r8), dimension(IminS:ImaxS) :: wrk
159 real(r8), dimension(IminS:ImaxS) :: ad_wrk
160
161# include "set_bounds.h"
162
163
164
165
166
167 ad_cff=0.0_r8
168 DO i=imins,imaxs
169 ad_wrk(i)=0.0_r8
170 END DO
171
172
173
174
175
176
177
179 DO j=jstrr,jendr
180 DO i=istrr,iendr
181 ad_w_sol(i,j,k)=ad_w(i,j,k)
182 END DO
183 END DO
184 END DO
185
186
187
188# ifdef DISTRIBUTE
189
190
191
192
193
194
196 & lbi, ubi, lbj, ubj, 0,
n(ng), &
199 & ad_w)
200# endif
201
202
203
204
206 & lbi, ubi, lbj, ubj, 0,
n(ng), &
207 & ad_w)
208
209
210
211
212
213
214
215
216
217
218
219# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
221# endif
222 DO j=jstr,jend
223 DO i=istr,iend
224# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
225 w(i,j,0)=-cff1*(bed_thick(i,j,nstp)- &
226 & bed_thick(i,j,nnew))*omn(i,j)
227# else
228 w(i,j,0)=0.0_r8
229# endif
230
231 END DO
233 DO i=istr,iend
234 w(i,j,k)=w(i,j,k-1)- &
235 & (huon(i+1,j,k)-huon(i,j,k)+ &
236 & hvom(i,j+1,k)-hvom(i,j,k))
237 END DO
238 END DO
239
240
241
242
243
244
245
246
247
248
249
252 IF (int(
sources(ng)%Dsrc(is)).eq.2)
THEN
255 IF (((istrr.le.ii).and.(ii.le.iendr)).and. &
256 & ((jstrr.le.jj).and.(jj.le.jendr)).and. &
257 & (j.eq.jj)) THEN
259 w(ii,jj,k)=w(ii,jj,k-1)- &
260 & (huon(ii+1,jj,k)-huon(ii,jj,k)+ &
261 & hvom(ii,jj+1,k)-hvom(ii,jj,k))+ &
263 END DO
264 END IF
265 END IF
266 END DO
267 END IF
268
269 DO i=istr,iend
270 wrk(i)=w(i,j,
n(ng))/(z_w(i,j,
n(ng))-z_w(i,j,0))
271 END DO
272
273
274
275
276
277
278 DO i=istr,iend
279
280
281 ad_w(i,j,
n(ng))=0.0_r8
282 END DO
284 DO i=istr,iend
285
286
287
288
289 adfac=wrk(i)*ad_w(i,j,k)
290 ad_wrk(i)=ad_wrk(i)- &
291 & ad_w(i,j,k)*(z_w(i,j,k)-z_w(i,j,0))
292 ad_z_w(i,j,0)=ad_z_w(i,j,0)+adfac
293 ad_z_w(i,j,k)=ad_z_w(i,j,k)-adfac
294 END DO
295 END DO
296 DO i=istr,iend
297 cff=1.0_r8/(z_w(i,j,
n(ng))-z_w(i,j,0))
298
299
300 ad_w(i,j,
n(ng))=ad_w(i,j,
n(ng))+cff*ad_wrk(i)
301 ad_cff=ad_cff+w(i,j,
n(ng))*ad_wrk(i)
302 ad_wrk(i)=0.0_r8
303
304
305 adfac=-cff*cff*ad_cff
306 ad_z_w(i,j,0 )=ad_z_w(i,j,0 )-adfac
307 ad_z_w(i,j,
n(ng))=ad_z_w(i,j,
n(ng))+adfac
308 ad_cff=0.0_r8
309 END DO
310
311
312
313
314
317 IF (int(
sources(ng)%Dsrc(is)).eq.2)
THEN
320 IF (((istrr.le.ii).and.(ii.le.iendr)).and. &
321 & ((jstrr.le.jj).and.(jj.le.jendr)).and. &
322 & (j.eq.jj)) THEN
323
324
326
327
328
329
330
331 ad_w(ii,jj,k-1)=ad_w(ii,jj,k-1)+ad_w(ii,jj,k)
332 ad_huon(ii ,jj,k)=ad_huon(ii ,jj,k)+ad_w(ii,jj,k)
333 ad_huon(ii+1,jj,k)=ad_huon(ii+1,jj,k)-ad_w(ii,jj,k)
334 ad_hvom(ii,jj ,k)=ad_hvom(ii,jj ,k)+ad_w(ii,jj,k)
335 ad_hvom(ii,jj+1,k)=ad_hvom(ii,jj+1,k)-ad_w(ii,jj,k)
337 & ad_w(ii,jj,k)
338
339
340
341
342
343 ad_w(ii,jj,k)=0.0_r8
344 END DO
345 END IF
346 END IF
347 END DO
348 END IF
349
350
351
352
353
355 DO i=istr,iend
356
357
358
359
360 ad_w(i,j,k-1)=ad_w(i,j,k-1)+ad_w(i,j,k)
361 ad_huon(i ,j,k)=ad_huon(i ,j,k)+ad_w(i,j,k)
362 ad_huon(i+1,j,k)=ad_huon(i+1,j,k)-ad_w(i,j,k)
363 ad_hvom(i,j ,k)=ad_hvom(i,j ,k)+ad_w(i,j,k)
364 ad_hvom(i,j+1,k)=ad_hvom(i,j+1,k)-ad_w(i,j,k)
365 END DO
366 END DO
368 DO i=istr,iend
369
370
371 ad_w(i,j,k)=0.0_r8
372 END DO
373 END DO
374
375
376
377 DO i=istr,iend
378# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
379
380
381
382 adfac=cff1*omn(i,j)*ad_w(i,j,0)
383 ad_bed_thick(i,j,nnew)=ad_bed_thick(i,j,nnew)+adfac
384 ad_bed_thick(i,j,nstp)=ad_bed_thick(i,j,nstp)+adfac
385 ad_w(i,j,0)=0.0_r8
386# else
387
388
389 ad_w(i,j,0)=0.0_r8
390# endif
391 END DO
392
393
394
395
397 DO i=istr,iend
398 w(i,j,k)=w(i,j,k)-wrk(i)*(z_w(i,j,k)-z_w(i,j,0))
399 END DO
400 END DO
401 DO i=istr,iend
403 END DO
404 END DO
405
406
407
409 & lbi, ubi, lbj, ubj, 0,
n(ng), &
410 & w)
411# ifdef DISTRIBUTE
413 & lbi, ubi, lbj, ubj, 0,
n(ng), &
416 & w)
417# endif
418
419 RETURN
subroutine ad_bc_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
subroutine bc_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
integer, dimension(:), allocatable n
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
logical, dimension(:), allocatable lwsrc
type(t_sources), dimension(:), allocatable sources
integer, dimension(:), allocatable nsrc
subroutine ad_mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)