164
165
168# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS || \
169 defined adjust_boundary
171# endif
172
173
174
175 integer, intent(in) :: ng, tile
176 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
177 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
178 integer, intent(in) :: Linp1, Linp2, Lout
179
180# ifdef ASSUMED_SHAPE
181# ifdef ADJUST_BOUNDARY
182# ifdef SOLVE3D
183 real(r8), intent(in) :: tl_t_obc(LBij:,:,:,:,:,:)
184 real(r8), intent(in) :: tl_u_obc(LBij:,:,:,:,:)
185 real(r8), intent(in) :: tl_v_obc(LBij:,:,:,:,:)
186# endif
187 real(r8), intent(in) :: tl_ubar_obc(LBij:,:,:,:)
188 real(r8), intent(in) :: tl_vbar_obc(LBij:,:,:,:)
189 real(r8), intent(in) :: tl_zeta_obc(LBij:,:,:,:)
190# endif
191# ifdef ADJUST_WSTRESS
192 real(r8), intent(in) :: tl_ustr(LBi:,LBj:,:,:)
193 real(r8), intent(in) :: tl_vstr(LBi:,LBj:,:,:)
194# endif
195# ifdef SOLVE3D
196# ifdef ADJUST_STFLUX
197 real(r8), intent(in) :: tl_tflux(LBi:,LBj:,:,:,:)
198# endif
199 real(r8), intent(in) :: tl_t(LBi:,LBj:,:,:,:)
200 real(r8), intent(in) :: tl_u(LBi:,LBj:,:,:)
201 real(r8), intent(in) :: tl_v(LBi:,LBj:,:,:)
202# else
203 real(r8), intent(in) :: tl_ubar(LBi:,LBj:,:)
204 real(r8), intent(in) :: tl_vbar(LBi:,LBj:,:)
205# endif
206 real(r8), intent(in) :: tl_zeta(LBi:,LBj:,:)
207# ifdef ADJUST_BOUNDARY
208# ifdef SOLVE3D
209 real(r8), intent(inout) :: ad_t_obc(LBij:,:,:,:,:,:)
210 real(r8), intent(inout) :: ad_u_obc(LBij:,:,:,:,:)
211 real(r8), intent(inout) :: ad_v_obc(LBij:,:,:,:,:)
212# endif
213 real(r8), intent(inout) :: ad_ubar_obc(LBij:,:,:,:)
214 real(r8), intent(inout) :: ad_vbar_obc(LBij:,:,:,:)
215 real(r8), intent(inout) :: ad_zeta_obc(LBij:,:,:,:)
216# endif
217# ifdef ADJUST_WSTRESS
218 real(r8), intent(inout) :: ad_ustr(LBi:,LBj:,:,:)
219 real(r8), intent(inout) :: ad_vstr(LBi:,LBj:,:,:)
220# endif
221# ifdef SOLVE3D
222# ifdef ADJUST_STFLUX
223 real(r8), intent(inout) :: ad_tflux(LBi:,LBj:,:,:,:)
224# endif
225 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
226 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
227 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
228# else
229 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
230 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
231# endif
232 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
233# else
234# ifdef ADJUST_WSTRESS
235 real(r8), intent(in) :: tl_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
236 real(r8), intent(in) :: tl_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
237# endif
238# ifdef ADJUST_BOUNDARY
239# ifdef SOLVE3D
240 real(r8), intent(in) :: tl_t_obc(LBij:UBij,N(ng),4, &
241 & Nbrec(ng),2,NT(ng))
242 real(r8), intent(in) :: tl_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
243 real(r8), intent(in) :: tl_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
244# endif
245 real(r8), intent(in) :: tl_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
246 real(r8), intent(in) :: tl_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
247 real(r8), intent(in) :: tl_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
248# endif
249# ifdef SOLVE3D
250# ifdef ADJUST_STFLUX
251 real(r8), intent(in) :: tl_tflux(LBi:UBi,LBj:UBj, &
252 & Nfrec(ng),2,NT(ng))
253# endif
254 real(r8), intent(in) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
255 real(r8), intent(in) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
256 real(r8), intent(in) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
257# else
258 real(r8), intent(in) :: tl_ubar(LBi:UBi,LBj:UBj,:)
259 real(r8), intent(in) :: tl_vbar(LBi:UBi,LBj:UBj,:)
260# endif
261 real(r8), intent(in) :: tl_zeta(LBi:UBi,LBj:UBj,:)
262# ifdef ADJUST_BOUNDARY
263# ifdef SOLVE3D
264 real(r8), intent(inout) :: ad_t_obc(LBij:UBij,N(ng),4, &
265 & Nbrec(ng),2,NT(ng))
266 real(r8), intent(inout) :: ad_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
267 real(r8), intent(inout) :: ad_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
268# endif
269 real(r8), intent(inout) :: ad_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
270 real(r8), intent(inout) :: ad_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
271 real(r8), intent(inout) :: ad_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
272# endif
273# ifdef ADJUST_WSTRESS
274 real(r8), intent(inout) :: ad_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
275 real(r8), intent(inout) :: ad_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
276# endif
277# ifdef SOLVE3D
278# ifdef ADJUST_STFLUX
279 real(r8), intent(inout) :: ad_tflux(LBi:UBi,LBj:UBj, &
280 & Nfrec(ng),2,NT(ng))
281# endif
282 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
283 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
284 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
285# else
286 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
287 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
288# endif
289 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
290# endif
291
292
293
294 integer :: i, ib, ir, j, k
295# ifdef SOLVE3D
296 integer :: itrc
297# endif
298
299# include "set_bounds.h"
300
301
302
303
304
305
306
307
308
309 DO j=jstrr,jendr
310 DO i=istrr,iendr
311 ad_zeta(i,j,lout)=tl_zeta(i,j,linp1)+ &
312 & tl_zeta(i,j,linp2)+ &
313 & ad_zeta(i,j,lout )
314 END DO
315 END DO
316
317# ifdef ADJUST_BOUNDARY
318
319
320
324 &
domain(ng)%Western_Edge(tile))
THEN
326 DO j=jstr,jend
327 ad_zeta_obc(j,ib,ir,lout)=tl_zeta_obc(j,ib,ir,linp1)+ &
328 & tl_zeta_obc(j,ib,ir,linp2)+ &
329 & ad_zeta_obc(j,ib,ir,lout )
330 END DO
331 END IF
333 &
domain(ng)%Eastern_Edge(tile))
THEN
335 DO j=jstr,jend
336 ad_zeta_obc(j,ib,ir,lout)=tl_zeta_obc(j,ib,ir,linp1)+ &
337 & tl_zeta_obc(j,ib,ir,linp2)+ &
338 & ad_zeta_obc(j,ib,ir,lout )
339 END DO
340 END IF
342 &
domain(ng)%Southern_Edge(tile))
THEN
344 DO i=istr,iend
345 ad_zeta_obc(i,ib,ir,lout)=tl_zeta_obc(i,ib,ir,linp1)+ &
346 & tl_zeta_obc(i,ib,ir,linp2)+ &
347 & ad_zeta_obc(i,ib,ir,lout )
348 END DO
349 END IF
351 &
domain(ng)%Northern_Edge(tile))
THEN
353 DO i=istr,iend
354 ad_zeta_obc(i,ib,ir,lout)=tl_zeta_obc(i,ib,ir,linp1)+ &
355 & tl_zeta_obc(i,ib,ir,linp2)+ &
356 & ad_zeta_obc(i,ib,ir,lout )
357 END DO
358 END IF
359 END DO
360 END IF
361# endif
362
363# ifndef SOLVE3D
364
365
366
367 DO j=jstrr,jendr
368 DO i=istr,iendr
369 ad_ubar(i,j,lout)=tl_ubar(i,j,linp1)+ &
370 & tl_ubar(i,j,linp2)+ &
371 & ad_ubar(i,j,lout )
372 END DO
373 END DO
374# endif
375
376# ifdef ADJUST_BOUNDARY
377
378
379
383 &
domain(ng)%Western_Edge(tile))
THEN
385 DO j=jstr,jend
386 ad_ubar_obc(j,ib,ir,lout)=tl_ubar_obc(j,ib,ir,linp1)+ &
387 & tl_ubar_obc(j,ib,ir,linp2)+ &
388 & ad_ubar_obc(j,ib,ir,lout )
389 END DO
390 END IF
392 &
domain(ng)%Eastern_Edge(tile))
THEN
394 DO j=jstr,jend
395 ad_ubar_obc(j,ib,ir,lout)=tl_ubar_obc(j,ib,ir,linp1)+ &
396 & tl_ubar_obc(j,ib,ir,linp2)+ &
397 & ad_ubar_obc(j,ib,ir,lout )
398 END DO
399 END IF
401 &
domain(ng)%Southern_Edge(tile))
THEN
403 DO i=istru,iend
404 ad_ubar_obc(i,ib,ir,lout)=tl_ubar_obc(i,ib,ir,linp1)+ &
405 & tl_ubar_obc(i,ib,ir,linp2)+ &
406 & ad_ubar_obc(i,ib,ir,lout )
407 END DO
408 END IF
410 &
domain(ng)%Northern_Edge(tile))
THEN
412 DO i=istru,iend
413 ad_ubar_obc(i,ib,ir,lout)=tl_ubar_obc(i,ib,ir,linp1)+ &
414 & tl_ubar_obc(i,ib,ir,linp2)+ &
415 & ad_ubar_obc(i,ib,ir,lout )
416 END DO
417 END IF
418 END DO
419 END IF
420# endif
421
422# ifndef SOLVE3D
423
424
425
426 DO j=jstr,jendr
427 DO i=istrr,iendr
428 ad_vbar(i,j,lout)=tl_vbar(i,j,linp1)+ &
429 & tl_vbar(i,j,linp2)+ &
430 & ad_vbar(i,j,lout )
431 END DO
432 END DO
433# endif
434
435# ifdef ADJUST_BOUNDARY
436
437
438
442 &
domain(ng)%Western_Edge(tile))
THEN
444 DO j=jstrv,jend
445 ad_vbar_obc(j,ib,ir,lout)=tl_vbar_obc(j,ib,ir,linp1)+ &
446 & tl_vbar_obc(j,ib,ir,linp2)+ &
447 & ad_vbar_obc(j,ib,ir,lout )
448 END DO
449 END IF
451 &
domain(ng)%Eastern_Edge(tile))
THEN
453 DO j=jstrv,jend
454 ad_vbar_obc(j,ib,ir,lout)=tl_vbar_obc(j,ib,ir,linp1)+ &
455 & tl_vbar_obc(j,ib,ir,linp2)+ &
456 & ad_vbar_obc(j,ib,ir,lout )
457 END DO
458 END IF
460 &
domain(ng)%Southern_Edge(tile))
THEN
462 DO i=istr,iend
463 ad_vbar_obc(i,ib,ir,lout)=tl_vbar_obc(i,ib,ir,linp1)+ &
464 & tl_vbar_obc(i,ib,ir,linp2)+ &
465 & ad_vbar_obc(i,ib,ir,lout )
466 END DO
467 END IF
469 &
domain(ng)%Northern_Edge(tile))
THEN
471 DO i=istr,iend
472 ad_vbar_obc(i,ib,ir,lout)=tl_vbar_obc(i,ib,ir,linp1)+ &
473 & tl_vbar_obc(i,ib,ir,linp2)+ &
474 & ad_vbar_obc(i,ib,ir,lout )
475 END DO
476 END IF
477 END DO
478 END IF
479# endif
480
481# ifdef ADJUST_WSTRESS
482
483
484
486 DO j=jstrr,jendr
487 DO i=istr,iendr
488 ad_ustr(i,j,k,lout)=tl_ustr(i,j,k,linp1)+ &
489 & tl_ustr(i,j,k,linp2)+ &
490 & ad_ustr(i,j,k,lout )
491 END DO
492 END DO
493 DO j=jstr,jendr
494 DO i=istrr,iendr
495 ad_vstr(i,j,k,lout)=tl_vstr(i,j,k,linp1)+ &
496 & tl_vstr(i,j,k,linp2)+ &
497 & ad_vstr(i,j,k,lout )
498 END DO
499 END DO
500 END DO
501# endif
502
503# ifdef SOLVE3D
504
505
506
508 DO j=jstrr,jendr
509 DO i=istr,iendr
510 ad_u(i,j,k,lout)=tl_u(i,j,k,linp1)+ &
511 & tl_u(i,j,k,linp2)+ &
512 & ad_u(i,j,k,lout )
513 END DO
514 END DO
515 END DO
516
517# ifdef ADJUST_BOUNDARY
518
519
520
524 &
domain(ng)%Western_Edge(tile))
THEN
527 DO j=jstr,jend
528 ad_u_obc(j,k,ib,ir,lout)=tl_u_obc(j,k,ib,ir,linp1)+ &
529 & tl_u_obc(j,k,ib,ir,linp2)+ &
530 & ad_u_obc(j,k,ib,ir,lout )
531 END DO
532 END DO
533 END IF
535 &
domain(ng)%Eastern_Edge(tile))
THEN
538 DO j=jstr,jend
539 ad_u_obc(j,k,ib,ir,lout)=tl_u_obc(j,k,ib,ir,linp1)+ &
540 & tl_u_obc(j,k,ib,ir,linp2)+ &
541 & ad_u_obc(j,k,ib,ir,lout )
542 END DO
543 END DO
544 END IF
546 &
domain(ng)%Southern_Edge(tile))
THEN
549 DO i=istru,iend
550 ad_u_obc(i,k,ib,ir,lout)=tl_u_obc(i,k,ib,ir,linp1)+ &
551 & tl_u_obc(i,k,ib,ir,linp2)+ &
552 & ad_u_obc(i,k,ib,ir,lout )
553 END DO
554 END DO
555 END IF
557 &
domain(ng)%Northern_Edge(tile))
THEN
560 DO i=istru,iend
561 ad_u_obc(i,k,ib,ir,lout)=tl_u_obc(i,k,ib,ir,linp1)+ &
562 & tl_u_obc(i,k,ib,ir,linp2)+ &
563 & ad_u_obc(i,k,ib,ir,lout )
564 END DO
565 END DO
566 END IF
567 END DO
568 END IF
569# endif
570
571
572
574 DO j=jstr,jendr
575 DO i=istrr,iendr
576 ad_v(i,j,k,lout)=tl_v(i,j,k,linp1)+ &
577 & tl_v(i,j,k,linp2)+ &
578 & ad_v(i,j,k,lout )
579 END DO
580 END DO
581 END DO
582
583# ifdef ADJUST_BOUNDARY
584
585
586
590 &
domain(ng)%Western_Edge(tile))
THEN
593 DO j=jstrv,jend
594 ad_v_obc(j,k,ib,ir,lout)=tl_v_obc(j,k,ib,ir,linp1)+ &
595 & tl_v_obc(j,k,ib,ir,linp2)+ &
596 & ad_v_obc(j,k,ib,ir,lout )
597 END DO
598 END DO
599 END IF
601 &
domain(ng)%Eastern_Edge(tile))
THEN
604 DO j=jstrv,jend
605 ad_v_obc(j,k,ib,ir,lout)=tl_v_obc(j,k,ib,ir,linp1)+ &
606 & tl_v_obc(j,k,ib,ir,linp2)+ &
607 & ad_v_obc(j,k,ib,ir,lout )
608 END DO
609 END DO
610 END IF
612 &
domain(ng)%Southern_Edge(tile))
THEN
615 DO i=istr,iend
616 ad_v_obc(i,k,ib,ir,lout)=tl_v_obc(i,k,ib,ir,linp1)+ &
617 & tl_v_obc(i,k,ib,ir,linp2)+ &
618 & ad_v_obc(i,k,ib,ir,lout )
619 END DO
620 END DO
621 END IF
623 &
domain(ng)%Northern_Edge(tile))
THEN
626 DO i=istr,iend
627 ad_v_obc(i,k,ib,ir,lout)=tl_v_obc(i,k,ib,ir,linp1)+ &
628 & tl_v_obc(i,k,ib,ir,linp2)+ &
629 & ad_v_obc(i,k,ib,ir,lout )
630 END DO
631 END DO
632 END IF
633 END DO
634 END IF
635# endif
636
637
638
641 DO j=jstrr,jendr
642 DO i=istrr,iendr
643 ad_t(i,j,k,lout,itrc)=tl_t(i,j,k,linp1,itrc)+ &
644 & tl_t(i,j,k,linp2,itrc)+ &
645 & ad_t(i,j,k,lout ,itrc)
646 END DO
647 END DO
648 END DO
649 END DO
650
651# ifdef ADJUST_BOUNDARY
652
653
654
659 &
domain(ng)%Western_Edge(tile))
THEN
662 DO j=jstr,jend
663 ad_t_obc(j,k,ib,ir,lout,itrc)= &
664 & tl_t_obc(j,k,ib,ir,linp1,itrc)+ &
665 & tl_t_obc(j,k,ib,ir,linp2,itrc)+ &
666 & ad_t_obc(j,k,ib,ir,lout ,itrc)
667 END DO
668 END DO
669 END IF
671 &
domain(ng)%Eastern_Edge(tile))
THEN
674 DO j=jstr,jend
675 ad_t_obc(j,k,ib,ir,lout,itrc)= &
676 & tl_t_obc(j,k,ib,ir,linp1,itrc)+ &
677 & tl_t_obc(j,k,ib,ir,linp2,itrc)+ &
678 & ad_t_obc(j,k,ib,ir,lout ,itrc)
679 END DO
680 END DO
681 END IF
683 &
domain(ng)%Southern_Edge(tile))
THEN
686 DO i=istr,iend
687 ad_t_obc(i,k,ib,ir,lout,itrc)= &
688 & tl_t_obc(i,k,ib,ir,linp1,itrc)+ &
689 & tl_t_obc(i,k,ib,ir,linp2,itrc)+ &
690 & ad_t_obc(i,k,ib,ir,lout ,itrc)
691 END DO
692 END DO
693 END IF
695 &
domain(ng)%Northern_Edge(tile))
THEN
698 DO i=istr,iend
699 ad_t_obc(i,k,ib,ir,lout,itrc)= &
700 & tl_t_obc(i,k,ib,ir,linp1,itrc)+ &
701 & tl_t_obc(i,k,ib,ir,linp2,itrc)+ &
702 & ad_t_obc(i,k,ib,ir,lout ,itrc)
703 END DO
704 END DO
705 END IF
706 END DO
707 END IF
708 END DO
709# endif
710# ifdef ADJUST_STFLUX
711
712
713
717 DO j=jstrr,jendr
718 DO i=istrr,iendr
719 ad_tflux(i,j,k,lout,itrc)=tl_tflux(i,j,k,linp1,itrc)+ &
720 & tl_tflux(i,j,k,linp2,itrc)+ &
721 & ad_tflux(i,j,k,lout ,itrc)
722 END DO
723 END DO
724 END DO
725 END IF
726 END DO
727# endif
728# endif
729
730 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