115
116
120
122# ifdef DISTRIBUTE
124# endif
125
126
127
128 integer, intent(in) :: ng, tile, model
129 integer, intent(in) :: LBi, UBi, LBj, UBj
130 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
131
132# ifdef ASSUMED_SHAPE
133 real(r8), intent(in) :: pmask(LBi:,LBj:)
134 real(r8), intent(in) :: rmask(LBi:,LBj:)
135 real(r8), intent(in) :: umask(LBi:,LBj:)
136 real(r8), intent(in) :: vmask(LBi:,LBj:)
137# if defined AVERAGES || \
138 (defined ad_averages && defined adjoint) || \
139 (defined rp_averages && defined tl_ioms) || \
140 (defined tl_averages && defined tangent)
141 real(r8), intent(inout) :: pmask_avg(LBi:,LBj:)
142 real(r8), intent(inout) :: rmask_avg(LBi:,LBj:)
143 real(r8), intent(inout) :: umask_avg(LBi:,LBj:)
144 real(r8), intent(inout) :: vmask_avg(LBi:,LBj:)
145# endif
146# ifdef DIAGNOSTICS
147 real(r8), intent(inout) :: pmask_dia(LBi:,LBj:)
148 real(r8), intent(inout) :: rmask_dia(LBi:,LBj:)
149 real(r8), intent(inout) :: umask_dia(LBi:,LBj:)
150 real(r8), intent(inout) :: vmask_dia(LBi:,LBj:)
151# endif
152 real(r8), intent(inout) :: pmask_full(LBi:,LBj:)
153 real(r8), intent(inout) :: rmask_full(LBi:,LBj:)
154 real(r8), intent(inout) :: umask_full(LBi:,LBj:)
155 real(r8), intent(inout) :: vmask_full(LBi:,LBj:)
156# else
157 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
158 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
159 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
160 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
161# if defined AVERAGES || \
162 (defined ad_averages && defined adjoint) || \
163 (defined rp_averages && defined tl_ioms) || \
164 (defined tl_averages && defined tangent)
165 real(r8), intent(inout) :: pmask_avg(LBi:UBi,LBj:UBj)
166 real(r8), intent(inout) :: rmask_avg(LBi:UBi,LBj:UBj)
167 real(r8), intent(inout) :: umask_avg(LBi:UBi,LBj:UBj)
168 real(r8), intent(inout) :: vmask_avg(LBi:UBi,LBj:UBj)
169# endif
170# ifdef DIAGNOSTICS
171 real(r8), intent(inout) :: pmask_dia(LBi:UBi,LBj:UBj)
172 real(r8), intent(inout) :: rmask_dia(LBi:UBi,LBj:UBj)
173 real(r8), intent(inout) :: umask_dia(LBi:UBi,LBj:UBj)
174 real(r8), intent(inout) :: vmask_dia(LBi:UBi,LBj:UBj)
175# endif
176 real(r8), intent(inout) :: pmask_full(LBi:UBi,LBj:UBj)
177 real(r8), intent(inout) :: rmask_full(LBi:UBi,LBj:UBj)
178 real(r8), intent(inout) :: umask_full(LBi:UBi,LBj:UBj)
179 real(r8), intent(inout) :: vmask_full(LBi:UBi,LBj:UBj)
180# endif
181
182
183
184 integer :: i, is, j
185
186# include "set_bounds.h"
187
188
189
190
191
192
193
194
195
196 DO j=jstrp,jendp
197 DO i=istrp,iendp
198 pmask_full(i,j)=pmask(i,j)
199 END DO
200 END DO
201 DO j=jstrt,jendt
202 DO i=istrt,iendt
203 rmask_full(i,j)=rmask(i,j)
204 END DO
205 END DO
206 DO j=jstrt,jendt
207 DO i=istrp,iendt
208 umask_full(i,j)=umask(i,j)
209 END DO
210 END DO
211 DO j=jstrp,jendt
212 DO i=istrt,iendt
213 vmask_full(i,j)=vmask(i,j)
214 END DO
215 END DO
216
217
218
219
224 IF (((istrt.le.i).and.(i.le.iendt)).and. &
225 & ((jstrt.le.j).and.(j.le.jendt))) THEN
226 IF (int(
sources(ng)%Dsrc(is)).eq.0)
THEN
227 umask_full(i,j)=1.0_r8
228 ELSE
229 vmask_full(i,j)=1.0_r8
230 END IF
231 END IF
232 END DO
233 END IF
234
237 & lbi, ubi, lbj, ubj, &
238 & pmask_full)
240 & lbi, ubi, lbj, ubj, &
241 & rmask_full)
243 & lbi, ubi, lbj, ubj, &
244 & umask_full)
246 & lbi, ubi, lbj, ubj, &
247 & vmask_full)
248 END IF
249
250# ifdef DISTRIBUTE
252 & lbi, ubi, lbj, ubj, &
255 & pmask_full, rmask_full, umask_full, vmask_full)
256# endif
257
258# if defined AVERAGES || \
259 (defined ad_averages && defined adjoint) || \
260 (defined rp_averages && defined tl_ioms) || \
261 (defined tl_averages && defined tangent)
262
263
264
265
266
267 DO j=jstrp,jendp
268 DO i=istrp,iendp
269# ifdef WET_DRY
270 pmask_avg(i,j)=0.0_r8
271# else
272 pmask_avg(i,j)=pmask_full(i,j)
273# endif
274 END DO
275 END DO
276
277 DO j=jstrt,jendt
278 DO i=istrt,iendt
279# ifdef WET_DRY
280 rmask_avg(i,j)=0.0_r8
281# else
282 rmask_avg(i,j)=rmask_full(i,j)
283# endif
284 END DO
285 END DO
286
287 DO j=jstrt,jendt
288 DO i=istrp,iendt
289# ifdef WET_DRY
290 umask_avg(i,j)=0.0_r8
291# else
292 umask_avg(i,j)=umask_full(i,j)
293# endif
294 END DO
295 END DO
296
297 DO j=jstrp,jendt
298 DO i=istrt,iendt
299# ifdef WET_DRY
300 vmask_avg(i,j)=0.0_r8
301# else
302 vmask_avg(i,j)=vmask_full(i,j)
303# endif
304 END DO
305 END DO
306
309 & lbi, ubi, lbj, ubj, &
310 & pmask_avg)
312 & lbi, ubi, lbj, ubj, &
313 & rmask_avg)
315 & lbi, ubi, lbj, ubj, &
316 & umask_avg)
318 & lbi, ubi, lbj, ubj, &
319 & vmask_avg)
320 END IF
321
322# ifdef DISTRIBUTE
324 & lbi, ubi, lbj, ubj, &
327 & pmask_avg, rmask_avg, umask_avg, vmask_avg)
328# endif
329# endif
330
331# ifdef DIAGNOSTICS
332
333
334
335
336
337 DO j=jstrp,jendp
338 DO i=istrp,iendp
339# ifdef WET_DRY
340 pmask_dia(i,j)=0.0_r8
341# else
342 pmask_dia(i,j)=pmask_full(i,j)
343# endif
344 END DO
345 END DO
346
347 DO j=jstrt,jendt
348 DO i=istrt,iendt
349# ifdef WET_DRY
350 rmask_dia(i,j)=0.0_r8
351# else
352 rmask_dia(i,j)=rmask_full(i,j)
353# endif
354 END DO
355 END DO
356
357 DO j=jstrt,jendt
358 DO i=istrp,iendt
359# ifdef WET_DRY
360 umask_dia(i,j)=0.0_r8
361# else
362 umask_dia(i,j)=umask_full(i,j)
363# endif
364 END DO
365 END DO
366
367 DO j=jstrp,jendt
368 DO i=istrt,iendt
369# ifdef WET_DRY
370 vmask_dia(i,j)=0.0_r8
371# else
372 vmask_dia(i,j)=vmask_full(i,j)
373# endif
374 END DO
375 END DO
376
379 & lbi, ubi, lbj, ubj, &
380 & pmask_dia)
382 & lbi, ubi, lbj, ubj, &
383 & rmask_dia)
385 & lbi, ubi, lbj, ubj, &
386 & umask_dia)
388 & lbi, ubi, lbj, ubj, &
389 & vmask_dia)
390 END IF
391
392# ifdef DISTRIBUTE
394 & lbi, ubi, lbj, ubj, &
397 & pmask_dia, rmask_dia, umask_dia, vmask_dia)
398# endif
399
400# endif
401
402 RETURN
logical, dimension(:), allocatable luvsrc
type(t_sources), dimension(:), allocatable sources
integer, dimension(:), allocatable nsrc