148
149
152# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS || \
153 defined adjust_boundary
155# endif
156
157
158
159 integer, intent(in) :: ng, tile
160 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
161 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
162 integer, intent(in) :: Linp, Lout
163
164# ifdef ASSUMED_SHAPE
165# ifdef ADJUST_BOUNDARY
166# ifdef SOLVE3D
167 real(r8), intent(in) :: tl_t_obc(LBij:,:,:,:,:,:)
168 real(r8), intent(in) :: tl_u_obc(LBij:,:,:,:,:)
169 real(r8), intent(in) :: tl_v_obc(LBij:,:,:,:,:)
170# endif
171 real(r8), intent(in) :: tl_ubar_obc(LBij:,:,:,:)
172 real(r8), intent(in) :: tl_vbar_obc(LBij:,:,:,:)
173 real(r8), intent(in) :: tl_zeta_obc(LBij:,:,:,:)
174# endif
175# ifdef ADJUST_WSTRESS
176 real(r8), intent(in) :: tl_ustr(LBi:,LBj:,:,:)
177 real(r8), intent(in) :: tl_vstr(LBi:,LBj:,:,:)
178# endif
179# ifdef SOLVE3D
180# ifdef ADJUST_STFLUX
181 real(r8), intent(in) :: tl_tflux(LBi:,LBj:,:,:,:)
182# endif
183 real(r8), intent(in) :: tl_t(LBi:,LBj:,:,:,:)
184 real(r8), intent(in) :: tl_u(LBi:,LBj:,:,:)
185 real(r8), intent(in) :: tl_v(LBi:,LBj:,:,:)
186# else
187 real(r8), intent(in) :: tl_ubar(LBi:,LBj:,:)
188 real(r8), intent(in) :: tl_vbar(LBi:,LBj:,:)
189# endif
190 real(r8), intent(in) :: tl_zeta(LBi:,LBj:,:)
191# ifdef ADJUST_BOUNDARY
192# ifdef SOLVE3D
193 real(r8), intent(inout) :: ad_t_obc(LBij:,:,:,:,:,:)
194 real(r8), intent(inout) :: ad_u_obc(LBij:,:,:,:,:)
195 real(r8), intent(inout) :: ad_v_obc(LBij:,:,:,:,:)
196# endif
197 real(r8), intent(inout) :: ad_ubar_obc(LBij:,:,:,:)
198 real(r8), intent(inout) :: ad_vbar_obc(LBij:,:,:,:)
199 real(r8), intent(inout) :: ad_zeta_obc(LBij:,:,:,:)
200# endif
201# ifdef ADJUST_WSTRESS
202 real(r8), intent(inout) :: ad_ustr(LBi:,LBj:,:,:)
203 real(r8), intent(inout) :: ad_vstr(LBi:,LBj:,:,:)
204# endif
205# ifdef SOLVE3D
206# ifdef ADJUST_STFLUX
207 real(r8), intent(inout) :: ad_tflux(LBi:,LBj:,:,:,:)
208# endif
209 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
210 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
211 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
212# else
213 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
214 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
215# endif
216 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
217# else
218# ifdef ADJUST_WSTRESS
219 real(r8), intent(in) :: tl_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
220 real(r8), intent(in) :: tl_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
221# endif
222# ifdef ADJUST_BOUNDARY
223# ifdef SOLVE3D
224 real(r8), intent(in) :: tl_t_obc(LBij:UBij,N(ng),4, &
225 & Nbrec(ng),2,NT(ng))
226 real(r8), intent(in) :: tl_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
227 real(r8), intent(in) :: tl_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
228# endif
229 real(r8), intent(in) :: tl_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
230 real(r8), intent(in) :: tl_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
231 real(r8), intent(in) :: tl_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
232# endif
233# ifdef SOLVE3D
234# ifdef ADJUST_STFLUX
235 real(r8), intent(in) :: tl_tflux(LBi:UBi,LBj:UBj, &
236 & Nfrec(ng),2,NT(ng))
237# endif
238 real(r8), intent(in) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
239 real(r8), intent(in) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
240 real(r8), intent(in) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
241# else
242 real(r8), intent(in) :: tl_ubar(LBi:UBi,LBj:UBj,:)
243 real(r8), intent(in) :: tl_vbar(LBi:UBi,LBj:UBj,:)
244# endif
245 real(r8), intent(in) :: tl_zeta(LBi:UBi,LBj:UBj,:)
246# ifdef ADJUST_BOUNDARY
247# ifdef SOLVE3D
248 real(r8), intent(inout) :: ad_t_obc(LBij:UBij,N(ng),4, &
249 & Nbrec(ng),2,NT(ng))
250 real(r8), intent(inout) :: ad_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
251 real(r8), intent(inout) :: ad_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
252# endif
253 real(r8), intent(inout) :: ad_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
254 real(r8), intent(inout) :: ad_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
255 real(r8), intent(inout) :: ad_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
256# endif
257# ifdef ADJUST_WSTRESS
258 real(r8), intent(inout) :: ad_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
259 real(r8), intent(inout) :: ad_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
260# endif
261# ifdef SOLVE3D
262# ifdef ADJUST_STFLUX
263 real(r8), intent(inout) :: ad_tflux(LBi:UBi,LBj:UBj, &
264 & Nfrec(ng),2,NT(ng))
265# endif
266 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
267 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
268 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
269# else
270 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
271 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
272# endif
273 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
274# endif
275
276
277
278 integer :: i, ib, ir, j, k
279# ifdef SOLVE3D
280 integer :: itrc
281# endif
282
283# include "set_bounds.h"
284
285
286
287
288
289
290
291 DO j=jstrr,jendr
292 DO i=istrr,iendr
293 ad_zeta(i,j,lout)=-tl_zeta(i,j,linp)+ &
294 & ad_zeta(i,j,lout )
295 END DO
296 END DO
297
298# ifdef ADJUST_BOUNDARY
299
300
301
305 &
domain(ng)%Western_Edge(tile))
THEN
307 DO j=jstr,jend
308 ad_zeta_obc(j,ib,ir,lout)=-tl_zeta_obc(j,ib,ir,linp)+ &
309 & ad_zeta_obc(j,ib,ir,lout )
310 END DO
311 END IF
313 &
domain(ng)%Eastern_Edge(tile))
THEN
315 DO j=jstr,jend
316 ad_zeta_obc(j,ib,ir,lout)=-tl_zeta_obc(j,ib,ir,linp)+ &
317 & ad_zeta_obc(j,ib,ir,lout )
318 END DO
319 END IF
321 &
domain(ng)%Southern_Edge(tile))
THEN
323 DO i=istr,iend
324 ad_zeta_obc(i,ib,ir,lout)=-tl_zeta_obc(i,ib,ir,linp)+ &
325 & ad_zeta_obc(i,ib,ir,lout )
326 END DO
327 END IF
329 &
domain(ng)%Northern_Edge(tile))
THEN
331 DO i=istr,iend
332 ad_zeta_obc(i,ib,ir,lout)=-tl_zeta_obc(i,ib,ir,linp)+ &
333 & ad_zeta_obc(i,ib,ir,lout )
334 END DO
335 END IF
336 END DO
337 END IF
338# endif
339
340# ifndef SOLVE3D
341
342
343
344 DO j=jstrr,jendr
345 DO i=istr,iendr
346 ad_ubar(i,j,lout)=-tl_ubar(i,j,linp)+ &
347 & ad_ubar(i,j,lout )
348 END DO
349 END DO
350# endif
351
352# ifdef ADJUST_BOUNDARY
353
354
355
359 &
domain(ng)%Western_Edge(tile))
THEN
361 DO j=jstr,jend
362 ad_ubar_obc(j,ib,ir,lout)=-tl_ubar_obc(j,ib,ir,linp)+ &
363 & ad_ubar_obc(j,ib,ir,lout )
364 END DO
365 END IF
367 &
domain(ng)%Eastern_Edge(tile))
THEN
369 DO j=jstr,jend
370 ad_ubar_obc(j,ib,ir,lout)=-tl_ubar_obc(j,ib,ir,linp)+ &
371 & ad_ubar_obc(j,ib,ir,lout )
372 END DO
373 END IF
375 &
domain(ng)%Southern_Edge(tile))
THEN
377 DO i=istru,iend
378 ad_ubar_obc(i,ib,ir,lout)=-tl_ubar_obc(i,ib,ir,linp)+ &
379 & ad_ubar_obc(i,ib,ir,lout )
380 END DO
381 END IF
383 &
domain(ng)%Northern_Edge(tile))
THEN
385 DO i=istru,iend
386 ad_ubar_obc(i,ib,ir,lout)=-tl_ubar_obc(i,ib,ir,linp)+ &
387 & ad_ubar_obc(i,ib,ir,lout )
388 END DO
389 END IF
390 END DO
391 END IF
392# endif
393
394# ifndef SOLVE3D
395
396
397
398 DO j=jstr,jendr
399 DO i=istrr,iendr
400 ad_vbar(i,j,lout)=-tl_vbar(i,j,linp)+ &
401 & ad_vbar(i,j,lout )
402 END DO
403 END DO
404# endif
405
406# ifdef ADJUST_BOUNDARY
407
408
409
413 &
domain(ng)%Western_Edge(tile))
THEN
415 DO j=jstrv,jend
416 ad_vbar_obc(j,ib,ir,lout)=-tl_vbar_obc(j,ib,ir,linp)+ &
417 & ad_vbar_obc(j,ib,ir,lout )
418 END DO
419 END IF
421 &
domain(ng)%Eastern_Edge(tile))
THEN
423 DO j=jstrv,jend
424 ad_vbar_obc(j,ib,ir,lout)=-tl_vbar_obc(j,ib,ir,linp)+ &
425 & ad_vbar_obc(j,ib,ir,lout )
426 END DO
427 END IF
429 &
domain(ng)%Southern_Edge(tile))
THEN
431 DO i=istr,iend
432 ad_vbar_obc(i,ib,ir,lout)=-tl_vbar_obc(i,ib,ir,linp)+ &
433 & ad_vbar_obc(i,ib,ir,lout )
434 END DO
435 END IF
437 &
domain(ng)%Northern_Edge(tile))
THEN
439 DO i=istr,iend
440 ad_vbar_obc(i,ib,ir,lout)=-tl_vbar_obc(i,ib,ir,linp)+ &
441 & ad_vbar_obc(i,ib,ir,lout )
442 END DO
443 END IF
444 END DO
445 END IF
446# endif
447
448# ifdef ADJUST_WSTRESS
449
450
451
453 DO j=jstrr,jendr
454 DO i=istr,iendr
455 ad_ustr(i,j,k,lout)=-tl_ustr(i,j,k,linp)+ &
456 & ad_ustr(i,j,k,lout )
457 END DO
458 END DO
459 DO j=jstr,jendr
460 DO i=istrr,iendr
461 ad_vstr(i,j,k,lout)=-tl_vstr(i,j,k,linp)+ &
462 & ad_vstr(i,j,k,lout )
463 END DO
464 END DO
465 END DO
466# endif
467
468# ifdef SOLVE3D
469
470
471
473 DO j=jstrr,jendr
474 DO i=istr,iendr
475 ad_u(i,j,k,lout)=-tl_u(i,j,k,linp)+ &
476 & ad_u(i,j,k,lout )
477 END DO
478 END DO
479 END DO
480
481# ifdef ADJUST_BOUNDARY
482
483
484
488 &
domain(ng)%Western_Edge(tile))
THEN
491 DO j=jstr,jend
492 ad_u_obc(j,k,ib,ir,lout)=-tl_u_obc(j,k,ib,ir,linp)+ &
493 & ad_u_obc(j,k,ib,ir,lout )
494 END DO
495 END DO
496 END IF
498 &
domain(ng)%Eastern_Edge(tile))
THEN
501 DO j=jstr,jend
502 ad_u_obc(j,k,ib,ir,lout)=-tl_u_obc(j,k,ib,ir,linp)+ &
503 & ad_u_obc(j,k,ib,ir,lout )
504 END DO
505 END DO
506 END IF
508 &
domain(ng)%Southern_Edge(tile))
THEN
511 DO i=istru,iend
512 ad_u_obc(i,k,ib,ir,lout)=-tl_u_obc(i,k,ib,ir,linp)+ &
513 & ad_u_obc(i,k,ib,ir,lout )
514 END DO
515 END DO
516 END IF
518 &
domain(ng)%Northern_Edge(tile))
THEN
521 DO i=istru,iend
522 ad_u_obc(i,k,ib,ir,lout)=-tl_u_obc(i,k,ib,ir,linp)+ &
523 & ad_u_obc(i,k,ib,ir,lout )
524 END DO
525 END DO
526 END IF
527 END DO
528 END IF
529# endif
530
531
532
534 DO j=jstr,jendr
535 DO i=istrr,iendr
536 ad_v(i,j,k,lout)=-tl_v(i,j,k,linp)+ &
537 & ad_v(i,j,k,lout )
538 END DO
539 END DO
540 END DO
541
542# ifdef ADJUST_BOUNDARY
543
544
545
549 &
domain(ng)%Western_Edge(tile))
THEN
552 DO j=jstrv,jend
553 ad_v_obc(j,k,ib,ir,lout)=-tl_v_obc(j,k,ib,ir,linp)+ &
554 & ad_v_obc(j,k,ib,ir,lout )
555 END DO
556 END DO
557 END IF
559 &
domain(ng)%Eastern_Edge(tile))
THEN
562 DO j=jstrv,jend
563 ad_v_obc(j,k,ib,ir,lout)=-tl_v_obc(j,k,ib,ir,linp)+ &
564 & ad_v_obc(j,k,ib,ir,lout )
565 END DO
566 END DO
567 END IF
569 &
domain(ng)%Southern_Edge(tile))
THEN
572 DO i=istr,iend
573 ad_v_obc(i,k,ib,ir,lout)=-tl_v_obc(i,k,ib,ir,linp)+ &
574 & ad_v_obc(i,k,ib,ir,lout )
575 END DO
576 END DO
577 END IF
579 &
domain(ng)%Northern_Edge(tile))
THEN
582 DO i=istr,iend
583 ad_v_obc(i,k,ib,ir,lout)=-tl_v_obc(i,k,ib,ir,linp)+ &
584 & ad_v_obc(i,k,ib,ir,lout )
585 END DO
586 END DO
587 END IF
588 END DO
589 END IF
590# endif
591
592
593
596 DO j=jstrr,jendr
597 DO i=istrr,iendr
598 ad_t(i,j,k,lout,itrc)=-tl_t(i,j,k,linp,itrc)+ &
599 & ad_t(i,j,k,lout ,itrc)
600 END DO
601 END DO
602 END DO
603 END DO
604
605# ifdef ADJUST_BOUNDARY
606
607
608
613 &
domain(ng)%Western_Edge(tile))
THEN
616 DO j=jstr,jend
617 ad_t_obc(j,k,ib,ir,lout,itrc)= &
618 & -tl_t_obc(j,k,ib,ir,linp,itrc)+ &
619 & ad_t_obc(j,k,ib,ir,lout ,itrc)
620 END DO
621 END DO
622 END IF
624 &
domain(ng)%Eastern_Edge(tile))
THEN
627 DO j=jstr,jend
628 ad_t_obc(j,k,ib,ir,lout,itrc)= &
629 & -tl_t_obc(j,k,ib,ir,linp,itrc)+ &
630 & ad_t_obc(j,k,ib,ir,lout ,itrc)
631 END DO
632 END DO
633 END IF
635 &
domain(ng)%Southern_Edge(tile))
THEN
638 DO i=istr,iend
639 ad_t_obc(i,k,ib,ir,lout,itrc)= &
640 & -tl_t_obc(i,k,ib,ir,linp,itrc)+ &
641 & ad_t_obc(i,k,ib,ir,lout ,itrc)
642 END DO
643 END DO
644 END IF
646 &
domain(ng)%Northern_Edge(tile))
THEN
649 DO i=istr,iend
650 ad_t_obc(i,k,ib,ir,lout,itrc)= &
651 & -tl_t_obc(i,k,ib,ir,linp,itrc)+ &
652 & ad_t_obc(i,k,ib,ir,lout ,itrc)
653 END DO
654 END DO
655 END IF
656 END DO
657 END IF
658 END DO
659# endif
660# ifdef ADJUST_STFLUX
661
662
663
667 DO j=jstrr,jendr
668 DO i=istrr,iendr
669 ad_tflux(i,j,k,lout,itrc)=-tl_tflux(i,j,k,linp,itrc)+ &
670 & ad_tflux(i,j,k,lout ,itrc)
671 END DO
672 END DO
673 END DO
674 END IF
675 END DO
676# endif
677# endif
678
679 RETURN
integer, dimension(:), allocatable istvar
integer, dimension(:), allocatable n
type(t_domain), dimension(:), allocatable domain
integer, dimension(:), allocatable nt
logical, dimension(:,:,:), allocatable lobc
logical, dimension(:,:), allocatable lstflux
integer, dimension(:), allocatable nfrec
integer, parameter isouth
integer, parameter inorth
integer, dimension(:), allocatable nbrec