437
438
439
440
441 integer, intent(in) :: ng, tile
442 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
443 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
444 integer, intent(in) :: Linp, Lout
445
446# ifdef ASSUMED_SHAPE
447# ifdef ADJUST_BOUNDARY
448# ifdef SOLVE3D
449 real(r8), intent(inout) :: tl_t_obc(LBij:,:,:,:,:,:)
450 real(r8), intent(inout) :: tl_u_obc(LBij:,:,:,:,:)
451 real(r8), intent(inout) :: tl_v_obc(LBij:,:,:,:,:)
452# endif
453 real(r8), intent(inout) :: tl_ubar_obc(LBij:,:,:,:)
454 real(r8), intent(inout) :: tl_vbar_obc(LBij:,:,:,:)
455 real(r8), intent(inout) :: tl_zeta_obc(LBij:,:,:,:)
456# endif
457# ifdef ADJUST_WSTRESS
458 real(r8), intent(inout) :: tl_ustr(LBi:,LBj:,:,:)
459 real(r8), intent(inout) :: tl_vstr(LBi:,LBj:,:,:)
460# endif
461# ifdef SOLVE3D
462# ifdef ADJUST_STFLUX
463 real(r8), intent(inout) :: tl_tflux(LBi:,LBj:,:,:,:)
464# endif
465 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
466 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
467 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
468# else
469 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
470 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
471# endif
472 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
473# else
474# ifdef ADJUST_BOUNDARY
475# ifdef SOLVE3D
476 real(r8), intent(inout) :: tl_t_obc(LBij:UBij,N(ng),4, &
477 & Nbrec(ng),2,NT(ng))
478 real(r8), intent(inout) :: tl_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
479 real(r8), intent(inout) :: tl_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
480# endif
481 real(r8), intent(inout) :: tl_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
482 real(r8), intent(inout) :: tl_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
483 real(r8), intent(inout) :: tl_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
484# endif
485# ifdef ADJUST_WSTRESS
486 real(r8), intent(inout) :: tl_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
487 real(r8), intent(inout) :: tl_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
488# endif
489# ifdef SOLVE3D
490# ifdef ADJUST_STFLUX
491 real(r8), intent(inout) :: tl_tflux(LBi:UBi,LBj:UBj, &
492 & Nfrec(ng),2,NT(ng))
493# endif
494 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
495 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
496 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
497# else
498 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
499 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
500# endif
501 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
502# endif
503
504
505
506 integer :: i, ib, ir, j, k
507# ifdef SOLVE3D
508 integer :: itrc
509# endif
510 real(r8) :: fact
511
512# include "set_bounds.h"
513
514
515
516
517
518 fact=-fourdvar(ng)%cg_pxsave(ndatum(ng)+1)
519
520
521
522 DO j=jstrr,jendr
523 DO i=istrr,iendr
524 tl_zeta(i,j,lout)=fact*tl_zeta(i,j,linp)
525 END DO
526 END DO
527
528# ifdef ADJUST_BOUNDARY
529
530
531
532 IF (any(lobc(:,isfsur,ng))) THEN
533 DO ir=1,nbrec(ng)
534 IF ((lobc(iwest,isfsur,ng)).and. &
535 & domain(ng)%Western_Edge(tile)) THEN
536 ib=iwest
537 DO j=jstr,jend
538 tl_zeta_obc(j,ib,ir,lout)=fact*tl_zeta_obc(j,ib,ir,linp)
539 END DO
540 END IF
541 IF ((lobc(ieast,isfsur,ng)).and. &
542 & domain(ng)%Eastern_Edge(tile)) THEN
543 ib=ieast
544 DO j=jstr,jend
545 tl_zeta_obc(j,ib,ir,lout)=fact*tl_zeta_obc(j,ib,ir,linp)
546 END DO
547 END IF
548 IF ((lobc(isouth,isfsur,ng)).and. &
549 & domain(ng)%Southern_Edge(tile)) THEN
550 ib=isouth
551 DO i=istr,iend
552 tl_zeta_obc(i,ib,ir,lout)=fact*tl_zeta_obc(i,ib,ir,linp)
553 END DO
554 END IF
555 IF ((lobc(inorth,isfsur,ng)).and. &
556 & domain(ng)%Northern_Edge(tile)) THEN
557 ib=inorth
558 DO i=istr,iend
559 tl_zeta_obc(i,ib,ir,lout)=fact*tl_zeta_obc(i,ib,ir,linp)
560 END DO
561 END IF
562 END DO
563 END IF
564# endif
565
566# ifndef SOLVE3D
567
568
569
570 DO j=jstrr,jendr
571 DO i=istr,iendr
572 tl_ubar(i,j,lout)=fact*tl_ubar(i,j,linp)
573 END DO
574 END DO
575# endif
576
577# ifdef ADJUST_BOUNDARY
578
579
580
581 IF (any(lobc(:,isubar,ng))) THEN
582 DO ir=1,nbrec(ng)
583 IF ((lobc(iwest,isubar,ng)).and. &
584 & domain(ng)%Western_Edge(tile)) THEN
585 ib=iwest
586 DO j=jstr,jend
587 tl_ubar_obc(j,ib,ir,lout)=fact*tl_ubar_obc(j,ib,ir,linp)
588 END DO
589 END IF
590 IF ((lobc(ieast,isubar,ng)).and. &
591 & domain(ng)%Eastern_Edge(tile)) THEN
592 ib=ieast
593 DO j=jstr,jend
594 tl_ubar_obc(j,ib,ir,lout)=fact*tl_ubar_obc(j,ib,ir,linp)
595 END DO
596 END IF
597 IF ((lobc(isouth,isubar,ng)).and. &
598 & domain(ng)%Southern_Edge(tile)) THEN
599 ib=isouth
600 DO i=istru,iend
601 tl_ubar_obc(i,ib,ir,lout)=fact*tl_ubar_obc(i,ib,ir,linp)
602 END DO
603 END IF
604 IF ((lobc(inorth,isubar,ng)).and. &
605 & domain(ng)%Northern_Edge(tile)) THEN
606 ib=inorth
607 DO i=istru,iend
608 tl_ubar_obc(i,ib,ir,lout)=fact*tl_ubar_obc(i,ib,ir,linp)
609 END DO
610 END IF
611 END DO
612 END IF
613# endif
614
615# ifndef SOLVE3D
616
617
618
619 DO j=jstr,jendr
620 DO i=istrr,iendr
621 tl_vbar(i,j,lout)=fact*tl_vbar(i,j,linp)
622 END DO
623 END DO
624# endif
625
626# ifdef ADJUST_BOUNDARY
627
628
629
630 IF (any(lobc(:,isvbar,ng))) THEN
631 DO ir=1,nbrec(ng)
632 IF ((lobc(iwest,isvbar,ng)).and. &
633 & domain(ng)%Western_Edge(tile)) THEN
634 ib=iwest
635 DO j=jstrv,jend
636 tl_vbar_obc(j,ib,ir,lout)=fact*tl_vbar_obc(j,ib,ir,linp)
637 END DO
638 END IF
639 IF ((lobc(ieast,isvbar,ng)).and. &
640 & domain(ng)%Eastern_Edge(tile)) THEN
641 ib=ieast
642 DO j=jstrv,jend
643 tl_vbar_obc(j,ib,ir,lout)=fact*tl_vbar_obc(j,ib,ir,linp)
644 END DO
645 END IF
646 IF ((lobc(isouth,isvbar,ng)).and. &
647 & domain(ng)%Southern_Edge(tile)) THEN
648 ib=isouth
649 DO i=istr,iend
650 tl_vbar_obc(i,ib,ir,lout)=fact*tl_vbar_obc(i,ib,ir,linp)
651 END DO
652 END IF
653 IF ((lobc(inorth,isvbar,ng)).and. &
654 & domain(ng)%Northern_Edge(tile)) THEN
655 ib=inorth
656 DO i=istr,iend
657 tl_vbar_obc(i,ib,ir,lout)=fact*tl_vbar_obc(i,ib,ir,linp)
658 END DO
659 END IF
660 END DO
661 END IF
662# endif
663
664# ifdef ADJUST_WSTRESS
665
666
667
668 DO k=1,nfrec(ng)
669 DO j=jstrr,jendr
670 DO i=istr,iendr
671 tl_ustr(i,j,k,lout)=fact*tl_ustr(i,j,k,linp)
672 END DO
673 END DO
674 DO j=jstr,jendr
675 DO i=istrr,iendr
676 tl_vstr(i,j,k,lout)=fact*tl_vstr(i,j,k,linp)
677 END DO
678 END DO
679 END DO
680# endif
681
682# ifdef SOLVE3D
683
684
685
686 DO k=1,n(ng)
687 DO j=jstrr,jendr
688 DO i=istr,iendr
689 tl_u(i,j,k,lout)=fact*tl_u(i,j,k,linp)
690 END DO
691 END DO
692 END DO
693
694# ifdef ADJUST_BOUNDARY
695
696
697
698 IF (any(lobc(:,isuvel,ng))) THEN
699 DO ir=1,nbrec(ng)
700 IF ((lobc(iwest,isuvel,ng)).and. &
701 & domain(ng)%Western_Edge(tile)) THEN
702 ib=iwest
703 DO k=1,n(ng)
704 DO j=jstr,jend
705 tl_u_obc(j,k,ib,ir,lout)=fact*tl_u_obc(j,k,ib,ir,linp)
706 END DO
707 END DO
708 END IF
709 IF ((lobc(ieast,isuvel,ng)).and. &
710 & domain(ng)%Eastern_Edge(tile)) THEN
711 ib=ieast
712 DO k=1,n(ng)
713 DO j=jstr,jend
714 tl_u_obc(j,k,ib,ir,lout)=fact*tl_u_obc(j,k,ib,ir,linp)
715 END DO
716 END DO
717 END IF
718 IF ((lobc(isouth,isuvel,ng)).and. &
719 & domain(ng)%Southern_Edge(tile)) THEN
720 ib=isouth
721 DO k=1,n(ng)
722 DO i=istru,iend
723 tl_u_obc(i,k,ib,ir,lout)=fact*tl_u_obc(i,k,ib,ir,linp)
724 END DO
725 END DO
726 END IF
727 IF ((lobc(inorth,isuvel,ng)).and. &
728 & domain(ng)%Northern_Edge(tile)) THEN
729 ib=inorth
730 DO k=1,n(ng)
731 DO i=istru,iend
732 tl_u_obc(i,k,ib,ir,lout)=fact*tl_u_obc(i,k,ib,ir,linp)
733 END DO
734 END DO
735 END IF
736 END DO
737 END IF
738# endif
739
740
741
742 DO k=1,n(ng)
743 DO j=jstr,jendr
744 DO i=istrr,iendr
745 tl_v(i,j,k,lout)=fact*tl_v(i,j,k,linp)
746 END DO
747 END DO
748 END DO
749
750# ifdef ADJUST_BOUNDARY
751
752
753
754 IF (any(lobc(:,isvvel,ng))) THEN
755 DO ir=1,nbrec(ng)
756 IF ((lobc(iwest,isvvel,ng)).and. &
757 & domain(ng)%Western_Edge(tile)) THEN
758 ib=iwest
759 DO k=1,n(ng)
760 DO j=jstrv,jend
761 tl_v_obc(j,k,ib,ir,lout)=fact*tl_v_obc(j,k,ib,ir,linp)
762 END DO
763 END DO
764 END IF
765 IF ((lobc(ieast,isvvel,ng)).and. &
766 & domain(ng)%Eastern_Edge(tile)) THEN
767 ib=ieast
768 DO k=1,n(ng)
769 DO j=jstrv,jend
770 tl_v_obc(j,k,ib,ir,lout)=fact*tl_v_obc(j,k,ib,ir,linp)
771 END DO
772 END DO
773 END IF
774 IF ((lobc(isouth,isvvel,ng)).and. &
775 & domain(ng)%Southern_Edge(tile)) THEN
776 ib=isouth
777 DO k=1,n(ng)
778 DO i=istr,iend
779 tl_v_obc(i,k,ib,ir,lout)=fact*tl_v_obc(i,k,ib,ir,linp)
780 END DO
781 END DO
782 END IF
783 IF ((lobc(inorth,isvvel,ng)).and. &
784 & domain(ng)%Northern_Edge(tile)) THEN
785 ib=inorth
786 DO k=1,n(ng)
787 DO i=istr,iend
788 tl_v_obc(i,k,ib,ir,lout)=fact*tl_v_obc(i,k,ib,ir,linp)
789 END DO
790 END DO
791 END IF
792 END DO
793 END IF
794# endif
795
796
797
798 DO itrc=1,nt(ng)
799 DO k=1,n(ng)
800 DO j=jstrr,jendr
801 DO i=istrr,iendr
802 tl_t(i,j,k,lout,itrc)=fact*tl_t(i,j,k,linp,itrc)
803 END DO
804 END DO
805 END DO
806 END DO
807
808# ifdef ADJUST_BOUNDARY
809
810
811
812 DO itrc=1,nt(ng)
813 IF (any(lobc(:,istvar(itrc),ng))) THEN
814 DO ir=1,nbrec(ng)
815 IF ((lobc(iwest,istvar(itrc),ng)).and. &
816 & domain(ng)%Western_Edge(tile)) THEN
817 ib=iwest
818 DO k=1,n(ng)
819 DO j=jstr,jend
820 tl_t_obc(j,k,ib,ir,lout,itrc)= &
821 & fact*tl_t_obc(j,k,ib,ir,linp,itrc)
822 END DO
823 END DO
824 END IF
825 IF ((lobc(ieast,istvar(itrc),ng)).and. &
826 & domain(ng)%Eastern_Edge(tile)) THEN
827 ib=ieast
828 DO k=1,n(ng)
829 DO j=jstr,jend
830 tl_t_obc(j,k,ib,ir,lout,itrc)= &
831 & fact*tl_t_obc(j,k,ib,ir,linp,itrc)
832 END DO
833 END DO
834 END IF
835 IF ((lobc(isouth,istvar(itrc),ng)).and. &
836 & domain(ng)%Southern_Edge(tile)) THEN
837 ib=isouth
838 DO k=1,n(ng)
839 DO i=istr,iend
840 tl_t_obc(i,k,ib,ir,lout,itrc)= &
841 & fact*tl_t_obc(i,k,ib,ir,linp,itrc)
842 END DO
843 END DO
844 END IF
845 IF ((lobc(inorth,istvar(itrc),ng)).and. &
846 & domain(ng)%Northern_Edge(tile)) THEN
847 ib=inorth
848 DO k=1,n(ng)
849 DO i=istr,iend
850 tl_t_obc(i,k,ib,ir,lout,itrc)= &
851 & fact*tl_t_obc(i,k,ib,ir,linp,itrc)
852 END DO
853 END DO
854 END IF
855 END DO
856 END IF
857 END DO
858# endif
859# ifdef ADJUST_STFLUX
860
861
862
863 DO itrc=1,nt(ng)
864 IF (lstflux(itrc,ng)) THEN
865 DO k=1,nfrec(ng)
866 DO j=jstrr,jendr
867 DO i=istrr,iendr
868 tl_tflux(i,j,k,lout,itrc)=fact*tl_tflux(i,j,k,linp,itrc)
869 END DO
870 END DO
871 END DO
872 END IF
873 END DO
874# endif
875# endif
876
877 RETURN