










      subroutine MessPass2D_tile (Istr,Iend,Jstr,Jend, A)      


      use Agrif_Util
      interface
        subroutine Sub_Loop_MessPass2D_tile(Istr,Iend,Jstr,Jend,A,NORTH_
     &INTER,SOUTH_INTER,EAST_INTER,WEST_INTER,p_NW,buf_rev4,buf_snd4,COR
     &NER_NW,p_SE,buf_rev3,buf_snd3,CORNER_SE,p_NE,buf_rev2,buf_snd2,COR
     &NER_NE,p_SW,buf_rev1,buf_snd1,CORNER_SW,p_N,NORTH_INTER2,p_S,SOUTH
     &_INTER2,p_E,EAST_INTER2,p_W,WEST_INTER2,jbuf_revE,jbuf_revW,jbuf_s
     &ndE,jbuf_sndW,ibuf_revS,ibuf_sndS,ibuf_revN,ibuf_sndN,Mmmpi,jj,Lmm
     &pi,ii,padd_E,Mm,padd_X,Lm)
          implicit none
      integer(4), parameter :: LLm0 = 41
      integer(4), parameter :: MMm0 = 42
      integer(4), parameter :: N = 32
      integer(4), parameter :: N_sl = 0
      integer(4), parameter :: NP_XI = 1
      integer(4), parameter :: NP_ETA = 4
      integer(4), parameter :: NNODES = NP_XI*NP_ETA
      integer(4), parameter :: NPP = 1
      integer(4), parameter :: NSUB_X = 1
      integer(4), parameter :: NSUB_E = 1
      integer(4), parameter :: NWEIGHT = 1000
      integer(4), parameter :: Ntides = 8
      integer(4), parameter :: stdout = 6
      integer(4), parameter :: Np = N+1
      integer(4), parameter :: NpHz = (N+1+N_sl)
      integer(4), parameter :: NSA = 28
      real, parameter :: Vtransform = 2
      integer(4), parameter :: itemp = 1
      integer(4), parameter :: ntrc_temp = 1
      integer(4), parameter :: ntrc_salt = 1
      integer(4), parameter :: ntrc_pas = 0
      integer(4), parameter :: ntrc_bio = 0
      integer(4), parameter :: ntrc_subs = 0
      integer(4), parameter :: ntrc_substot = 0
      integer(4), parameter :: ntrc_sed = 0
      integer(4), parameter :: NTA = itemp+ntrc_salt
      integer(4), parameter :: NT = itemp+ntrc_salt+ntrc_pas+ntrc_bio+nt
     &rc_sed
      integer(4), parameter :: NTot = NT
      integer(4), parameter :: isalt = itemp+1
      integer(4), parameter :: ntrc_diabio = 0
      integer(4), parameter :: ntrc_diats = 0
      integer(4), parameter :: ntrc_diauv = 0
      integer(4), parameter :: ntrc_diavrt = 0
      integer(4), parameter :: ntrc_diaek = 0
      integer(4), parameter :: ntrc_diapv = 0
      integer(4), parameter :: ntrc_diaeddy = 0
      integer(4), parameter :: ntrc_surf = 0
      real, parameter :: pi = 3.14159265358979323846D0
      real, parameter :: deg2rad = pi/180.D0
      real, parameter :: rad2deg = 180.D0/pi
      real, parameter :: Eradius = 6371315.0D0
      real, parameter :: Erotation = 7.292115090D-5
      real, parameter :: day2sec = 86400.D0
      real, parameter :: sec2day = 1.D0/86400.D0
      real, parameter :: year2day = 365.25D0
      real, parameter :: day2year = 1.D0/365.25D0
      real, parameter :: jul_off = 2440000.D0
      real, parameter :: g = 9.81D0
      real, parameter :: Cp = 3985.0D0
      real, parameter :: vonKar = 0.41D0
      real, parameter :: spval = -999.0D0
      logical, parameter :: mask_val = .true.
      integer(4), parameter :: Npts = 2
      logical, parameter :: use_host_device = .TRUE.
      logical :: NORTH_INTER
      logical :: SOUTH_INTER
      logical :: EAST_INTER
      logical :: WEST_INTER
      integer(4) :: p_NW
      logical :: CORNER_NW
      integer(4) :: p_SE
      logical :: CORNER_SE
      integer(4) :: p_NE
      logical :: CORNER_NE
      integer(4) :: p_SW
      logical :: CORNER_SW
      integer(4) :: p_N
      logical :: NORTH_INTER2
      integer(4) :: p_S
      logical :: SOUTH_INTER2
      integer(4) :: p_E
      logical :: EAST_INTER2
      integer(4) :: p_W
      logical :: WEST_INTER2
      integer(4) :: Mmmpi
      integer(4) :: jj
      integer(4) :: Lmmpi
      integer(4) :: ii
      integer(4) :: padd_E
      integer(4) :: Mm
      integer(4) :: padd_X
      integer(4) :: Lm
      real, dimension(1:3*3) :: buf_rev4
      real, dimension(1:3*3) :: buf_snd4
      real, dimension(1:3*3) :: buf_rev3
      real, dimension(1:3*3) :: buf_snd3
      real, dimension(1:3*3) :: buf_rev2
      real, dimension(1:3*3) :: buf_snd2
      real, dimension(1:3*3) :: buf_rev1
      real, dimension(1:3*3) :: buf_snd1
      real, allocatable, dimension(:) :: jbuf_revE
      real, allocatable, dimension(:) :: jbuf_revW
      real, allocatable, dimension(:) :: jbuf_sndE
      real, allocatable, dimension(:) :: jbuf_sndW
      real, allocatable, dimension(:) :: ibuf_revS
      real, allocatable, dimension(:) :: ibuf_sndS
      real, allocatable, dimension(:) :: ibuf_revN
      real, allocatable, dimension(:) :: ibuf_sndN
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: A
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
        end subroutine Sub_Loop_MessPass2D_tile

      end interface
      real, dimension(-1: Agrif_tabvars_i(2)%iarray0+2+ Agrif_tabvars_i(
     &13)%iarray0,-1: Agrif_tabvars_i(4)%iarray0+2+ Agrif_tabvars_i(14)%
     &iarray0) :: A
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
      

        call Sub_Loop_MessPass2D_tile(Istr,Iend,Jstr,Jend,A, Agrif_tabva
     &rs_l(13)%larray0, Agrif_tabvars_l(14)%larray0, Agrif_tabvars_l(11)
     &%larray0, Agrif_tabvars_l(12)%larray0, Agrif_tabvars_i(186)%iarray
     &0, Agrif_tabvars(335)%array1, Agrif_tabvars(337)%array1, Agrif_tab
     &vars_l(16)%larray0, Agrif_tabvars_i(185)%iarray0, Agrif_tabvars(33
     &0)%array1, Agrif_tabvars(332)%array1, Agrif_tabvars_l(18)%larray0,
     & Agrif_tabvars_i(187)%iarray0, Agrif_tabvars(334)%array1, Agrif_ta
     &bvars(336)%array1, Agrif_tabvars_l(17)%larray0, Agrif_tabvars_i(18
     &4)%iarray0, Agrif_tabvars(331)%array1, Agrif_tabvars(333)%array1, 
     &Agrif_tabvars_l(15)%larray0, Agrif_tabvars_i(183)%iarray0, Agrif_t
     &abvars_l(9)%larray0, Agrif_tabvars_i(182)%iarray0, Agrif_tabvars_l
     &(10)%larray0, Agrif_tabvars_i(181)%iarray0, Agrif_tabvars_l(7)%lar
     &ray0, Agrif_tabvars_i(180)%iarray0, Agrif_tabvars_l(8)%larray0, Ag
     &rif_tabvars(322)%array1, Agrif_tabvars(323)%array1, Agrif_tabvars(
     &324)%array1, Agrif_tabvars(325)%array1, Agrif_tabvars(326)%array1,
     & Agrif_tabvars(327)%array1, Agrif_tabvars(328)%array1, Agrif_tabva
     &rs(329)%array1, Agrif_tabvars_i(8)%iarray0, Agrif_tabvars_i(179)%i
     &array0, Agrif_tabvars_i(7)%iarray0, Agrif_tabvars_i(178)%iarray0, 
     &Agrif_tabvars_i(14)%iarray0, Agrif_tabvars_i(4)%iarray0, Agrif_tab
     &vars_i(13)%iarray0, Agrif_tabvars_i(2)%iarray0)

      end


      subroutine Sub_Loop_MessPass2D_tile(Istr,Iend,Jstr,Jend,A,NORTH_IN
     &TER,SOUTH_INTER,EAST_INTER,WEST_INTER,p_NW,buf_rev4,buf_snd4,CORNE
     &R_NW,p_SE,buf_rev3,buf_snd3,CORNER_SE,p_NE,buf_rev2,buf_snd2,CORNE
     &R_NE,p_SW,buf_rev1,buf_snd1,CORNER_SW,p_N,NORTH_INTER2,p_S,SOUTH_I
     &NTER2,p_E,EAST_INTER2,p_W,WEST_INTER2,jbuf_revE,jbuf_revW,jbuf_snd
     &E,jbuf_sndW,ibuf_revS,ibuf_sndS,ibuf_revN,ibuf_sndN,Mmmpi,jj,Lmmpi
     &,ii,padd_E,Mm,padd_X,Lm)

      use Agrif_Types, only : Agrif_tabvars


      include 'mpif.h'
      integer(4), parameter :: LLm0 = 41
      integer(4), parameter :: MMm0 = 42
      integer(4), parameter :: N = 32
      integer(4), parameter :: N_sl = 0
      integer(4), parameter :: NP_XI = 1
      integer(4), parameter :: NP_ETA = 4
      integer(4), parameter :: NNODES = NP_XI*NP_ETA
      integer(4), parameter :: NPP = 1
      integer(4), parameter :: NSUB_X = 1
      integer(4), parameter :: NSUB_E = 1
      integer(4), parameter :: NWEIGHT = 1000
      integer(4), parameter :: Ntides = 8
      integer(4), parameter :: stdout = 6
      integer(4), parameter :: Np = N+1
      integer(4), parameter :: NpHz = (N+1+N_sl)
      integer(4), parameter :: NSA = 28
      real, parameter :: Vtransform = 2
      integer(4), parameter :: itemp = 1
      integer(4), parameter :: ntrc_temp = 1
      integer(4), parameter :: ntrc_salt = 1
      integer(4), parameter :: ntrc_pas = 0
      integer(4), parameter :: ntrc_bio = 0
      integer(4), parameter :: ntrc_subs = 0
      integer(4), parameter :: ntrc_substot = 0
      integer(4), parameter :: ntrc_sed = 0
      integer(4), parameter :: NTA = itemp+ntrc_salt
      integer(4), parameter :: NT = itemp+ntrc_salt+ntrc_pas+ntrc_bio+nt
     &rc_sed
      integer(4), parameter :: NTot = NT
      integer(4), parameter :: isalt = itemp+1
      integer(4), parameter :: ntrc_diabio = 0
      integer(4), parameter :: ntrc_diats = 0
      integer(4), parameter :: ntrc_diauv = 0
      integer(4), parameter :: ntrc_diavrt = 0
      integer(4), parameter :: ntrc_diaek = 0
      integer(4), parameter :: ntrc_diapv = 0
      integer(4), parameter :: ntrc_diaeddy = 0
      integer(4), parameter :: ntrc_surf = 0
      real, parameter :: pi = 3.14159265358979323846D0
      real, parameter :: deg2rad = pi/180.D0
      real, parameter :: rad2deg = 180.D0/pi
      real, parameter :: Eradius = 6371315.0D0
      real, parameter :: Erotation = 7.292115090D-5
      real, parameter :: day2sec = 86400.D0
      real, parameter :: sec2day = 1.D0/86400.D0
      real, parameter :: year2day = 365.25D0
      real, parameter :: day2year = 1.D0/365.25D0
      real, parameter :: jul_off = 2440000.D0
      real, parameter :: g = 9.81D0
      real, parameter :: Cp = 3985.0D0
      real, parameter :: vonKar = 0.41D0
      real, parameter :: spval = -999.0D0
      logical, parameter :: mask_val = .true.
      integer(4), parameter :: Npts = 2
      logical, parameter :: use_host_device = .TRUE.
      logical :: NORTH_INTER
      logical :: SOUTH_INTER
      logical :: EAST_INTER
      logical :: WEST_INTER
      integer(4) :: p_NW
      logical :: CORNER_NW
      integer(4) :: p_SE
      logical :: CORNER_SE
      integer(4) :: p_NE
      logical :: CORNER_NE
      integer(4) :: p_SW
      logical :: CORNER_SW
      integer(4) :: p_N
      logical :: NORTH_INTER2
      integer(4) :: p_S
      logical :: SOUTH_INTER2
      integer(4) :: p_E
      logical :: EAST_INTER2
      integer(4) :: p_W
      logical :: WEST_INTER2
      integer(4) :: Mmmpi
      integer(4) :: jj
      integer(4) :: Lmmpi
      integer(4) :: ii
      integer(4) :: padd_E
      integer(4) :: Mm
      integer(4) :: padd_X
      integer(4) :: Lm
      real, dimension(1:3*3) :: buf_rev4
      real, dimension(1:3*3) :: buf_snd4
      real, dimension(1:3*3) :: buf_rev3
      real, dimension(1:3*3) :: buf_snd3
      real, dimension(1:3*3) :: buf_rev2
      real, dimension(1:3*3) :: buf_snd2
      real, dimension(1:3*3) :: buf_rev1
      real, dimension(1:3*3) :: buf_snd1
      real, allocatable, dimension(:) :: jbuf_revE
      real, allocatable, dimension(:) :: jbuf_revW
      real, allocatable, dimension(:) :: jbuf_sndE
      real, allocatable, dimension(:) :: jbuf_sndW
      real, allocatable, dimension(:) :: ibuf_revS
      real, allocatable, dimension(:) :: ibuf_sndS
      real, allocatable, dimension(:) :: ibuf_revN
      real, allocatable, dimension(:) :: ibuf_sndN
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: A
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend

                                            
                             
                                            

                                                             
                     
                        

                                                            
                                           
                                                               
                                    
                                      
                                                          

                       

                                    

                        
                              

                       
                          

                                                
                                             
                          

                        

                                 

                                                
                        

                                                              
                      
                              

                                       
                                                                     
                                          
                         

                             

                             

                            

                            

                                             

                            

                                     

                                                               

                         

                                                      
                                                      
                                                                  
                               

                               

                              

                              

                               

                              

                              

                                

                             

                                                                  
                                                                       
                                                                 
                                 
                                
                                                                       
                                                                 
                                                                 
                                                                 
                                                        
                                                                       
                                                                 
                                                                 
            
                                              
                                                   
                     
                              
                               
                                 
                                                  
                                                                       
                                                                 
                                                                 
                        
                      
                           
                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                    
                           
                                      
                             
                                                 
                                                                       
                                                                 
                     
                                                      
                                                                       
                                                                 
              
                                          
                                                                       
                                                                 
       
                                                           
      real(8) :: Cu_Nbq_X
      real(8) :: Cu_Nbq_Y
      real(8) :: Cu_Nbq_Z
                                             
                                                                       
                                                                 
              
                                                  
                                                                       
                                                                 
              
                                  
                                           
                                                  
                                                                   
                                                               
                                                      
                                                                       
                                                                 
                      
                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                        
                                
                                                                       
                                                                 
                                                        

                                                                       
                                                                 
                  
                                                                       
                                                                 
                                                                 
                                                                 
                  

                          

              
                             

                  
                               

                 
                                

                       
                                   

!$AGRIF_DO_NOT_TREAT
      INTEGER*4 :: ocean_grid_comm
      common /cpl_comm/ ocean_grid_comm
!$AGRIF_END_DO_NOT_TREAT
                       
                     
                        

                                                     
                                           
      integer(4) :: sub_X
      integer(4) :: size_X
      integer(4) :: sub_E
      integer(4) :: size_E
                                                                       
                                                                 
                                                                 
                         
                                                                       
                                                                 
                                                                 
                                           
                                                                       
                                                                 
                                                                 
                                                                 
                                              
                                                              
      integer(4) :: size_Z
      integer(4) :: sub_X_3D
      integer(4) :: size_X_3D
      integer(4) :: sub_E_3D
      integer(4) :: size_E_3D
                                                                       
                                                                 
                                                                 
                                                 
                                                                       
                                                                 
                                                                 
                                         
                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                        
                          
      integer(4) :: ipts
      integer(4) :: jpts
                                            
                                                                       
                                                                 
                                                              
      integer(4) :: i
      integer(4) :: j
      integer(4) :: isize
      integer(4) :: jsize
      integer(4) :: ksize
      integer(4) :: iter
      integer(4), dimension(1:8) :: req
      integer(4), dimension(1:MPI_STATUS_SIZE,1:8) :: status
      integer(4) :: ierr
      integer(4) :: mdii
      integer(4) :: mdjj
                                                 
      integer(4) :: imin
      integer(4) :: imax
      integer(4) :: ishft
      integer(4) :: jmin
      integer(4) :: jmax
      integer(4) :: jshft
      if (ii.eq.0 .and. Istr.eq.1) then
        imin=Istr-1
      else
        imin=Istr
      endif
      if (ii.eq.NP_XI-1 .and. Iend.eq.Lmmpi) then
        imax=Iend+1
      else
        imax=Iend
      endif
      ishft=imax-imin+1
      if (jj.eq.0 .and. Jstr.eq.1) then
        jmin=Jstr-1
      else
        jmin=Jstr
      endif
      if (jj.eq.NP_ETA-1 .and. Jend.eq.Mmmpi) then
        jmax=Jend+1
      else
        jmax=Jend
      endif
      jshft=jmax-jmin+1
         sub_X=Lm
         size_X=Npts*(sub_X+2*Npts)-1
         sub_E=Mm
         size_E=Npts*(sub_E+2*Npts)-1
         if (.not. allocated(ibuf_sndN)) then
         Allocate(ibuf_sndN(0:size_X), ibuf_revN(0:size_X),
     &     ibuf_sndS(0:size_X), ibuf_revS(0:size_X),
     &     jbuf_sndW(0:size_E), jbuf_sndE(0:size_E),
     &     jbuf_revW(0:size_E), jbuf_revE(0:size_E))
         endif
      ksize=Npts*Npts
      isize=Npts*ishft
      jsize=Npts*jshft
      do iter=0,1
        mdii=mod(ii+iter,2)
        mdjj=mod(jj+iter,2)
        if (mdii.eq.0) then
          if (WEST_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do j=jmin,jmax
              do ipts=1,Npts
                jbuf_sndW(j-jmin+(ipts-1)*jshft)=A(ipts,j)
              enddo
            enddo
!$acc update host(jbuf_sndW) if(.not.use_host_device)
!$acc host_data if(compute_on_device.and.use_host_device)
!$acc& use_device(jbuf_revW, jbuf_sndW)
            call MPI_Irecv (jbuf_revW, jsize, MPI_DOUBLE_PRECISION,
     &                         p_W, 2, MPI_COMM_WORLD, req(1), ierr)
            call MPI_Send  (jbuf_sndW, jsize, MPI_DOUBLE_PRECISION,
     &                         p_W, 1, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        else
          if (EAST_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do j=jmin,jmax
              do ipts=1,Npts
                jbuf_sndE(j-jmin+(ipts-1)*jshft)=A(Lmmpi-Npts+ipts,j)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(jbuf_revE, jbuf_sndE)
            call MPI_Irecv (jbuf_revE, jsize, MPI_DOUBLE_PRECISION,
     &                         p_E, 1, MPI_COMM_WORLD, req(2), ierr)
            call MPI_Send  (jbuf_sndE, jsize, MPI_DOUBLE_PRECISION,
     &                         p_E, 2, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        endif
        if (mdjj.eq.0) then
          if (SOUTH_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do i=imin,imax
                ibuf_sndS(i-imin+(jpts-1)*ishft)=A(i,jpts)
              enddo
            enddo
!$acc update host(ibuf_sndS) if(.not.use_host_device)
!$acc host_data if(compute_on_device.and.use_host_device)
!$acc&  use_device(ibuf_revS, ibuf_sndS)
            call MPI_Irecv (ibuf_revS, isize, MPI_DOUBLE_PRECISION,
     &                         p_S, 4, MPI_COMM_WORLD, req(3), ierr)
            call MPI_Send  (ibuf_sndS, isize, MPI_DOUBLE_PRECISION,
     &                         p_S, 3, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        else
          if (NORTH_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do i=imin,imax
                ibuf_sndN(i-imin+(jpts-1)*ishft)=A(i,Mmmpi-Npts+jpts)
              enddo
            enddo
!$acc update host(ibuf_sndN) if(.not.use_host_device)
!$acc host_data if(compute_on_device.and.use_host_device)
!$acc&  use_device(ibuf_revN, ibuf_sndN)
            call MPI_Irecv (ibuf_revN, isize, MPI_DOUBLE_PRECISION,
     &                         p_N, 3, MPI_COMM_WORLD, req(4), ierr)
            call MPI_Send  (ibuf_sndN, isize, MPI_DOUBLE_PRECISION,
     &                         p_N, 4, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        endif
        if (mdii.eq.0) then
          if (CORNER_SW) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd1(ipts+Npts*(jpts-1))=A(ipts,jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev1,buf_snd1)
            call MPI_Irecv (buf_rev1,ksize, MPI_DOUBLE_PRECISION,  p_SW,
     &                               6, MPI_COMM_WORLD, req(5),ierr)
            call MPI_Send  (buf_snd1,ksize, MPI_DOUBLE_PRECISION,  p_SW,
     &                               5, MPI_COMM_WORLD,        ierr)
!$acc end host_data
          endif
        else
          if (CORNER_NE) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd2(ipts+Npts*(jpts-1))=
     &                                A(Lmmpi-Npts+ipts,Mmmpi-Npts+jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev2,buf_snd2)
            call MPI_Irecv (buf_rev2,ksize, MPI_DOUBLE_PRECISION,  p_NE,
     &                               5, MPI_COMM_WORLD, req(6),ierr)
            call MPI_Send  (buf_snd2,ksize, MPI_DOUBLE_PRECISION,  p_NE,
     &                               6, MPI_COMM_WORLD,        ierr)
!$acc end host_data
          endif
        endif
        if (mdii.eq.1) then
          if (CORNER_SE) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd3(ipts+Npts*(jpts-1))=
     &                                A(Lmmpi-Npts+ipts,jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev3,buf_snd3)
            call MPI_Irecv (buf_rev3,ksize, MPI_DOUBLE_PRECISION,  p_SE,
     &                               8, MPI_COMM_WORLD, req(7), ierr)
            call MPI_Send  (buf_snd3,ksize, MPI_DOUBLE_PRECISION,  p_SE,
     &                               7, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        else
          if (CORNER_NW) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd4(ipts+Npts*(jpts-1))=
     &                                A(ipts,Mmmpi-Npts+jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev4,buf_snd4)
            call MPI_Irecv (buf_rev4, ksize, MPI_DOUBLE_PRECISION, p_NW,
     &                               7, MPI_COMM_WORLD, req(8), ierr)
            call MPI_Send  (buf_snd4, ksize, MPI_DOUBLE_PRECISION, p_NW,
     &                               8, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        endif
      enddo
      if (WEST_INTER2) then
        call MPI_Wait (req(1),status(1,1),ierr)
!$acc update device(jbuf_revW) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(ipts-Npts,j)=jbuf_revW(j-jmin+(ipts-1)*jshft)
          enddo
        enddo
      endif
      if ( WEST_INTER .and. .not. WEST_INTER2 ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(ipts-Npts,j)=A(ipts,j)
          enddo
        enddo
      endif
      if (EAST_INTER2) then
        call MPI_Wait (req(2),status(1,2),ierr)
!$acc update device(jbuf_revE) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(Lmmpi+ipts,j)=jbuf_revE(j-jmin+(ipts-1)*jshft)
          enddo
        enddo
      endif
      if ( EAST_INTER .and. .not. EAST_INTER2 ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(Lmmpi+ipts,j)=A(Lmmpi-Npts+ipts,j)
          enddo
        enddo
      endif
      if (SOUTH_INTER2) then
        call MPI_Wait (req(3),status(1,3),ierr)
!$acc update device(ibuf_revS) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
       do jpts=1,Npts
          do i=imin,imax
           A(i,jpts-Npts)=ibuf_revS(i-imin+(jpts-1)*ishft)
          enddo
        enddo
      endif
      if ( SOUTH_INTER .and. .not. SOUTH_INTER2 ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do i=imin,imax
           A(i,jpts-Npts)=A(i,jpts)
          enddo
        enddo
      endif
      if (NORTH_INTER2) then
        call MPI_Wait (req(4),status(1,4),ierr)
!$acc update device(ibuf_revN) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do i=imin,imax
            A(i,Mmmpi+jpts)=ibuf_revN(i-imin+(jpts-1)*ishft)
          enddo
        enddo
      endif
      if (NORTH_INTER .AND. .not. NORTH_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do i=imin,imax
            A(i,Mmmpi+jpts)=A(i,Mmmpi-Npts+jpts)
          enddo
        enddo
      endif
      if ( CORNER_SW) then
        call MPI_Wait (req(5),status(1,5),ierr)
!$acc update device(buf_rev1) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
          A(ipts-Npts,jpts-Npts)=buf_rev1(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not.CORNER_SW .and.
     &  SOUTH_INTER .and.WEST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
           A(ipts-Npts,jpts-Npts)=A(ipts,jpts)
          enddo
        enddo
       endif
      if ( CORNER_NE) then
        call MPI_Wait (req(6),status(1,6),ierr)
!$acc update device(buf_rev2) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,Mmmpi+jpts)=buf_rev2(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not.CORNER_NE .and.
     &  NORTH_INTER .and.EAST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,Mmmpi+jpts)=A(Lmmpi+ipts-NPts,Mmmpi+jpts-Npts)
          enddo
        enddo
       endif
      if (CORNER_SE) then
        call MPI_Wait (req(7),status(1,7),ierr)
!$acc update device(buf_rev3) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,jpts-Npts)=buf_rev3(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not. CORNER_SE .and.
     &  SOUTH_INTER .and. EAST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,jpts-Npts)=A(Lmmpi+ipts-Npts,jpts)
          enddo
        enddo
      endif
      if (CORNER_NW) then
        call MPI_Wait (req(8),status(1,8),ierr)
!$acc update device(buf_rev4) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(ipts-Npts,Mmmpi+jpts)=buf_rev4(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not. CORNER_NW .and.
     &   NORTH_INTER .and.  WEST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
       do jpts=1,Npts
          do ipts=1,Npts
            A(ipts-Npts,Mmmpi+jpts)=A(ipts,Mmmpi+jpts-NPts)
          enddo
        enddo
       endif
      return
       
      

      end subroutine Sub_Loop_MessPass2D_tile

      subroutine MessPass2D_3pts_tile (Istr,Iend,Jstr,Jend, A)      


      use Agrif_Util
      interface
        subroutine Sub_Loop_MessPass2D_3pts_tile(Istr,Iend,Jstr,Jend,A,N
     &ORTH_INTER,SOUTH_INTER,EAST_INTER,WEST_INTER,p_NW,buf_rev4,buf_snd
     &4,CORNER_NW,p_SE,buf_rev3,buf_snd3,CORNER_SE,p_NE,buf_rev2,buf_snd
     &2,CORNER_NE,p_SW,buf_rev1,buf_snd1,CORNER_SW,p_N,NORTH_INTER2,p_S,
     &SOUTH_INTER2,p_E,EAST_INTER2,p_W,WEST_INTER2,jbuf_revE,jbuf_revW,j
     &buf_sndE,jbuf_sndW,ibuf_revS,ibuf_sndS,ibuf_revN,ibuf_sndN,Mmmpi,j
     &j,Lmmpi,ii,padd_E,Mm,padd_X,Lm)
          implicit none
      integer(4), parameter :: LLm0 = 41
      integer(4), parameter :: MMm0 = 42
      integer(4), parameter :: N = 32
      integer(4), parameter :: N_sl = 0
      integer(4), parameter :: NP_XI = 1
      integer(4), parameter :: NP_ETA = 4
      integer(4), parameter :: NNODES = NP_XI*NP_ETA
      integer(4), parameter :: NPP = 1
      integer(4), parameter :: NSUB_X = 1
      integer(4), parameter :: NSUB_E = 1
      integer(4), parameter :: NWEIGHT = 1000
      integer(4), parameter :: Ntides = 8
      integer(4), parameter :: stdout = 6
      integer(4), parameter :: Np = N+1
      integer(4), parameter :: NpHz = (N+1+N_sl)
      integer(4), parameter :: NSA = 28
      real, parameter :: Vtransform = 2
      integer(4), parameter :: itemp = 1
      integer(4), parameter :: ntrc_temp = 1
      integer(4), parameter :: ntrc_salt = 1
      integer(4), parameter :: ntrc_pas = 0
      integer(4), parameter :: ntrc_bio = 0
      integer(4), parameter :: ntrc_subs = 0
      integer(4), parameter :: ntrc_substot = 0
      integer(4), parameter :: ntrc_sed = 0
      integer(4), parameter :: NTA = itemp+ntrc_salt
      integer(4), parameter :: NT = itemp+ntrc_salt+ntrc_pas+ntrc_bio+nt
     &rc_sed
      integer(4), parameter :: NTot = NT
      integer(4), parameter :: isalt = itemp+1
      integer(4), parameter :: ntrc_diabio = 0
      integer(4), parameter :: ntrc_diats = 0
      integer(4), parameter :: ntrc_diauv = 0
      integer(4), parameter :: ntrc_diavrt = 0
      integer(4), parameter :: ntrc_diaek = 0
      integer(4), parameter :: ntrc_diapv = 0
      integer(4), parameter :: ntrc_diaeddy = 0
      integer(4), parameter :: ntrc_surf = 0
      real, parameter :: pi = 3.14159265358979323846D0
      real, parameter :: deg2rad = pi/180.D0
      real, parameter :: rad2deg = 180.D0/pi
      real, parameter :: Eradius = 6371315.0D0
      real, parameter :: Erotation = 7.292115090D-5
      real, parameter :: day2sec = 86400.D0
      real, parameter :: sec2day = 1.D0/86400.D0
      real, parameter :: year2day = 365.25D0
      real, parameter :: day2year = 1.D0/365.25D0
      real, parameter :: jul_off = 2440000.D0
      real, parameter :: g = 9.81D0
      real, parameter :: Cp = 3985.0D0
      real, parameter :: vonKar = 0.41D0
      real, parameter :: spval = -999.0D0
      logical, parameter :: mask_val = .true.
      integer(4), parameter :: Npts = 3
      logical, parameter :: use_host_device = .TRUE.
      logical :: NORTH_INTER
      logical :: SOUTH_INTER
      logical :: EAST_INTER
      logical :: WEST_INTER
      integer(4) :: p_NW
      logical :: CORNER_NW
      integer(4) :: p_SE
      logical :: CORNER_SE
      integer(4) :: p_NE
      logical :: CORNER_NE
      integer(4) :: p_SW
      logical :: CORNER_SW
      integer(4) :: p_N
      logical :: NORTH_INTER2
      integer(4) :: p_S
      logical :: SOUTH_INTER2
      integer(4) :: p_E
      logical :: EAST_INTER2
      integer(4) :: p_W
      logical :: WEST_INTER2
      integer(4) :: Mmmpi
      integer(4) :: jj
      integer(4) :: Lmmpi
      integer(4) :: ii
      integer(4) :: padd_E
      integer(4) :: Mm
      integer(4) :: padd_X
      integer(4) :: Lm
      real, dimension(1:3*3) :: buf_rev4
      real, dimension(1:3*3) :: buf_snd4
      real, dimension(1:3*3) :: buf_rev3
      real, dimension(1:3*3) :: buf_snd3
      real, dimension(1:3*3) :: buf_rev2
      real, dimension(1:3*3) :: buf_snd2
      real, dimension(1:3*3) :: buf_rev1
      real, dimension(1:3*3) :: buf_snd1
      real, allocatable, dimension(:) :: jbuf_revE
      real, allocatable, dimension(:) :: jbuf_revW
      real, allocatable, dimension(:) :: jbuf_sndE
      real, allocatable, dimension(:) :: jbuf_sndW
      real, allocatable, dimension(:) :: ibuf_revS
      real, allocatable, dimension(:) :: ibuf_sndS
      real, allocatable, dimension(:) :: ibuf_revN
      real, allocatable, dimension(:) :: ibuf_sndN
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: A
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
        end subroutine Sub_Loop_MessPass2D_3pts_tile

      end interface
      real, dimension(-1: Agrif_tabvars_i(2)%iarray0+2+ Agrif_tabvars_i(
     &13)%iarray0,-1: Agrif_tabvars_i(4)%iarray0+2+ Agrif_tabvars_i(14)%
     &iarray0) :: A
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
      

        call Sub_Loop_MessPass2D_3pts_tile(Istr,Iend,Jstr,Jend,A, Agrif_
     &tabvars_l(13)%larray0, Agrif_tabvars_l(14)%larray0, Agrif_tabvars_
     &l(11)%larray0, Agrif_tabvars_l(12)%larray0, Agrif_tabvars_i(186)%i
     &array0, Agrif_tabvars(335)%array1, Agrif_tabvars(337)%array1, Agri
     &f_tabvars_l(16)%larray0, Agrif_tabvars_i(185)%iarray0, Agrif_tabva
     &rs(330)%array1, Agrif_tabvars(332)%array1, Agrif_tabvars_l(18)%lar
     &ray0, Agrif_tabvars_i(187)%iarray0, Agrif_tabvars(334)%array1, Agr
     &if_tabvars(336)%array1, Agrif_tabvars_l(17)%larray0, Agrif_tabvars
     &_i(184)%iarray0, Agrif_tabvars(331)%array1, Agrif_tabvars(333)%arr
     &ay1, Agrif_tabvars_l(15)%larray0, Agrif_tabvars_i(183)%iarray0, Ag
     &rif_tabvars_l(9)%larray0, Agrif_tabvars_i(182)%iarray0, Agrif_tabv
     &ars_l(10)%larray0, Agrif_tabvars_i(181)%iarray0, Agrif_tabvars_l(7
     &)%larray0, Agrif_tabvars_i(180)%iarray0, Agrif_tabvars_l(8)%larray
     &0, Agrif_tabvars(322)%array1, Agrif_tabvars(323)%array1, Agrif_tab
     &vars(324)%array1, Agrif_tabvars(325)%array1, Agrif_tabvars(326)%ar
     &ray1, Agrif_tabvars(327)%array1, Agrif_tabvars(328)%array1, Agrif_
     &tabvars(329)%array1, Agrif_tabvars_i(8)%iarray0, Agrif_tabvars_i(1
     &79)%iarray0, Agrif_tabvars_i(7)%iarray0, Agrif_tabvars_i(178)%iarr
     &ay0, Agrif_tabvars_i(14)%iarray0, Agrif_tabvars_i(4)%iarray0, Agri
     &f_tabvars_i(13)%iarray0, Agrif_tabvars_i(2)%iarray0)

      end


      subroutine Sub_Loop_MessPass2D_3pts_tile(Istr,Iend,Jstr,Jend,A,NOR
     &TH_INTER,SOUTH_INTER,EAST_INTER,WEST_INTER,p_NW,buf_rev4,buf_snd4,
     &CORNER_NW,p_SE,buf_rev3,buf_snd3,CORNER_SE,p_NE,buf_rev2,buf_snd2,
     &CORNER_NE,p_SW,buf_rev1,buf_snd1,CORNER_SW,p_N,NORTH_INTER2,p_S,SO
     &UTH_INTER2,p_E,EAST_INTER2,p_W,WEST_INTER2,jbuf_revE,jbuf_revW,jbu
     &f_sndE,jbuf_sndW,ibuf_revS,ibuf_sndS,ibuf_revN,ibuf_sndN,Mmmpi,jj,
     &Lmmpi,ii,padd_E,Mm,padd_X,Lm)

      use Agrif_Types, only : Agrif_tabvars


      include 'mpif.h'
      integer(4), parameter :: LLm0 = 41
      integer(4), parameter :: MMm0 = 42
      integer(4), parameter :: N = 32
      integer(4), parameter :: N_sl = 0
      integer(4), parameter :: NP_XI = 1
      integer(4), parameter :: NP_ETA = 4
      integer(4), parameter :: NNODES = NP_XI*NP_ETA
      integer(4), parameter :: NPP = 1
      integer(4), parameter :: NSUB_X = 1
      integer(4), parameter :: NSUB_E = 1
      integer(4), parameter :: NWEIGHT = 1000
      integer(4), parameter :: Ntides = 8
      integer(4), parameter :: stdout = 6
      integer(4), parameter :: Np = N+1
      integer(4), parameter :: NpHz = (N+1+N_sl)
      integer(4), parameter :: NSA = 28
      real, parameter :: Vtransform = 2
      integer(4), parameter :: itemp = 1
      integer(4), parameter :: ntrc_temp = 1
      integer(4), parameter :: ntrc_salt = 1
      integer(4), parameter :: ntrc_pas = 0
      integer(4), parameter :: ntrc_bio = 0
      integer(4), parameter :: ntrc_subs = 0
      integer(4), parameter :: ntrc_substot = 0
      integer(4), parameter :: ntrc_sed = 0
      integer(4), parameter :: NTA = itemp+ntrc_salt
      integer(4), parameter :: NT = itemp+ntrc_salt+ntrc_pas+ntrc_bio+nt
     &rc_sed
      integer(4), parameter :: NTot = NT
      integer(4), parameter :: isalt = itemp+1
      integer(4), parameter :: ntrc_diabio = 0
      integer(4), parameter :: ntrc_diats = 0
      integer(4), parameter :: ntrc_diauv = 0
      integer(4), parameter :: ntrc_diavrt = 0
      integer(4), parameter :: ntrc_diaek = 0
      integer(4), parameter :: ntrc_diapv = 0
      integer(4), parameter :: ntrc_diaeddy = 0
      integer(4), parameter :: ntrc_surf = 0
      real, parameter :: pi = 3.14159265358979323846D0
      real, parameter :: deg2rad = pi/180.D0
      real, parameter :: rad2deg = 180.D0/pi
      real, parameter :: Eradius = 6371315.0D0
      real, parameter :: Erotation = 7.292115090D-5
      real, parameter :: day2sec = 86400.D0
      real, parameter :: sec2day = 1.D0/86400.D0
      real, parameter :: year2day = 365.25D0
      real, parameter :: day2year = 1.D0/365.25D0
      real, parameter :: jul_off = 2440000.D0
      real, parameter :: g = 9.81D0
      real, parameter :: Cp = 3985.0D0
      real, parameter :: vonKar = 0.41D0
      real, parameter :: spval = -999.0D0
      logical, parameter :: mask_val = .true.
      integer(4), parameter :: Npts = 3
      logical, parameter :: use_host_device = .TRUE.
      logical :: NORTH_INTER
      logical :: SOUTH_INTER
      logical :: EAST_INTER
      logical :: WEST_INTER
      integer(4) :: p_NW
      logical :: CORNER_NW
      integer(4) :: p_SE
      logical :: CORNER_SE
      integer(4) :: p_NE
      logical :: CORNER_NE
      integer(4) :: p_SW
      logical :: CORNER_SW
      integer(4) :: p_N
      logical :: NORTH_INTER2
      integer(4) :: p_S
      logical :: SOUTH_INTER2
      integer(4) :: p_E
      logical :: EAST_INTER2
      integer(4) :: p_W
      logical :: WEST_INTER2
      integer(4) :: Mmmpi
      integer(4) :: jj
      integer(4) :: Lmmpi
      integer(4) :: ii
      integer(4) :: padd_E
      integer(4) :: Mm
      integer(4) :: padd_X
      integer(4) :: Lm
      real, dimension(1:3*3) :: buf_rev4
      real, dimension(1:3*3) :: buf_snd4
      real, dimension(1:3*3) :: buf_rev3
      real, dimension(1:3*3) :: buf_snd3
      real, dimension(1:3*3) :: buf_rev2
      real, dimension(1:3*3) :: buf_snd2
      real, dimension(1:3*3) :: buf_rev1
      real, dimension(1:3*3) :: buf_snd1
      real, allocatable, dimension(:) :: jbuf_revE
      real, allocatable, dimension(:) :: jbuf_revW
      real, allocatable, dimension(:) :: jbuf_sndE
      real, allocatable, dimension(:) :: jbuf_sndW
      real, allocatable, dimension(:) :: ibuf_revS
      real, allocatable, dimension(:) :: ibuf_sndS
      real, allocatable, dimension(:) :: ibuf_revN
      real, allocatable, dimension(:) :: ibuf_sndN
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: A
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend

                                            
                             
                                            

                                                             
                     
                        

                                                            
                                           
                                                               
                                    
                                      
                                                          

                       

                                    

                        
                              

                       
                          

                                                
                                             
                          

                        

                                 

                                                
                        

                                                              
                      
                              

                                       
                                                                     
                                          
                         

                             

                             

                            

                            

                                             

                            

                                     

                                                               

                         

                                                      
                                                      
                                                                  
                               

                               

                              

                              

                               

                              

                              

                                

                             

                                                                  
                                                                       
                                                                 
                                 
                                
                                                                       
                                                                 
                                                                 
                                                                 
                                                        
                                                                       
                                                                 
                                                                 
            
                                              
                                                   
                     
                              
                               
                                 
                                                  
                                                                       
                                                                 
                                                                 
                        
                      
                           
                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                    
                           
                                      
                             
                                                 
                                                                       
                                                                 
                     
                                                      
                                                                       
                                                                 
              
                                          
                                                                       
                                                                 
       
                                                           
      real(8) :: Cu_Nbq_X
      real(8) :: Cu_Nbq_Y
      real(8) :: Cu_Nbq_Z
                                             
                                                                       
                                                                 
              
                                                  
                                                                       
                                                                 
              
                                  
                                           
                                                  
                                                                   
                                                               
                                                      
                                                                       
                                                                 
                      
                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                        
                                
                                                                       
                                                                 
                                                        

                                                                       
                                                                 
                  
                                                                       
                                                                 
                                                                 
                                                                 
                  

                          

              
                             

                  
                               

                 
                                

                       
                                   

!$AGRIF_DO_NOT_TREAT
      INTEGER*4 :: ocean_grid_comm
      common /cpl_comm/ ocean_grid_comm
!$AGRIF_END_DO_NOT_TREAT
                       
                     
                        

                                                     
                                           
      integer(4) :: sub_X
      integer(4) :: size_X
      integer(4) :: sub_E
      integer(4) :: size_E
                                                                       
                                                                 
                                                                 
                         
                                                                       
                                                                 
                                                                 
                                           
                                                                       
                                                                 
                                                                 
                                                                 
                                              
                                                              
      integer(4) :: size_Z
      integer(4) :: sub_X_3D
      integer(4) :: size_X_3D
      integer(4) :: sub_E_3D
      integer(4) :: size_E_3D
                                                                       
                                                                 
                                                                 
                                                 
                                                                       
                                                                 
                                                                 
                                         
                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                        
                          
      integer(4) :: ipts
      integer(4) :: jpts
                                            
                                                                       
                                                                 
                                                              
      integer(4) :: i
      integer(4) :: j
      integer(4) :: isize
      integer(4) :: jsize
      integer(4) :: ksize
      integer(4) :: iter
      integer(4), dimension(1:8) :: req
      integer(4), dimension(1:MPI_STATUS_SIZE,1:8) :: status
      integer(4) :: ierr
      integer(4) :: mdii
      integer(4) :: mdjj
                                                 
      integer(4) :: imin
      integer(4) :: imax
      integer(4) :: ishft
      integer(4) :: jmin
      integer(4) :: jmax
      integer(4) :: jshft
      if (ii.eq.0 .and. Istr.eq.1) then
        imin=Istr-1
      else
        imin=Istr
      endif
      if (ii.eq.NP_XI-1 .and. Iend.eq.Lmmpi) then
        imax=Iend+1
      else
        imax=Iend
      endif
      ishft=imax-imin+1
      if (jj.eq.0 .and. Jstr.eq.1) then
        jmin=Jstr-1
      else
        jmin=Jstr
      endif
      if (jj.eq.NP_ETA-1 .and. Jend.eq.Mmmpi) then
        jmax=Jend+1
      else
        jmax=Jend
      endif
      jshft=jmax-jmin+1
         sub_X=Lm
         size_X=Npts*(sub_X+2*Npts)-1
         sub_E=Mm
         size_E=Npts*(sub_E+2*Npts)-1
         if (.not. allocated(ibuf_sndN)) then
         Allocate(ibuf_sndN(0:size_X), ibuf_revN(0:size_X),
     &     ibuf_sndS(0:size_X), ibuf_revS(0:size_X),
     &     jbuf_sndW(0:size_E), jbuf_sndE(0:size_E),
     &     jbuf_revW(0:size_E), jbuf_revE(0:size_E))
         endif
      ksize=Npts*Npts
      isize=Npts*ishft
      jsize=Npts*jshft
      do iter=0,1
        mdii=mod(ii+iter,2)
        mdjj=mod(jj+iter,2)
        if (mdii.eq.0) then
          if (WEST_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do j=jmin,jmax
              do ipts=1,Npts
                jbuf_sndW(j-jmin+(ipts-1)*jshft)=A(ipts,j)
              enddo
            enddo
!$acc update host(jbuf_sndW) if(.not.use_host_device)
!$acc host_data if(compute_on_device.and.use_host_device)
!$acc& use_device(jbuf_revW, jbuf_sndW)
            call MPI_Irecv (jbuf_revW, jsize, MPI_DOUBLE_PRECISION,
     &                         p_W, 2, MPI_COMM_WORLD, req(1), ierr)
            call MPI_Send  (jbuf_sndW, jsize, MPI_DOUBLE_PRECISION,
     &                         p_W, 1, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        else
          if (EAST_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do j=jmin,jmax
              do ipts=1,Npts
                jbuf_sndE(j-jmin+(ipts-1)*jshft)=A(Lmmpi-Npts+ipts,j)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(jbuf_revE, jbuf_sndE)
            call MPI_Irecv (jbuf_revE, jsize, MPI_DOUBLE_PRECISION,
     &                         p_E, 1, MPI_COMM_WORLD, req(2), ierr)
            call MPI_Send  (jbuf_sndE, jsize, MPI_DOUBLE_PRECISION,
     &                         p_E, 2, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        endif
        if (mdjj.eq.0) then
          if (SOUTH_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do i=imin,imax
                ibuf_sndS(i-imin+(jpts-1)*ishft)=A(i,jpts)
              enddo
            enddo
!$acc update host(ibuf_sndS) if(.not.use_host_device)
!$acc host_data if(compute_on_device.and.use_host_device)
!$acc&  use_device(ibuf_revS, ibuf_sndS)
            call MPI_Irecv (ibuf_revS, isize, MPI_DOUBLE_PRECISION,
     &                         p_S, 4, MPI_COMM_WORLD, req(3), ierr)
            call MPI_Send  (ibuf_sndS, isize, MPI_DOUBLE_PRECISION,
     &                         p_S, 3, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        else
          if (NORTH_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do i=imin,imax
                ibuf_sndN(i-imin+(jpts-1)*ishft)=A(i,Mmmpi-Npts+jpts)
              enddo
            enddo
!$acc update host(ibuf_sndN) if(.not.use_host_device)
!$acc host_data if(compute_on_device.and.use_host_device)
!$acc&  use_device(ibuf_revN, ibuf_sndN)
            call MPI_Irecv (ibuf_revN, isize, MPI_DOUBLE_PRECISION,
     &                         p_N, 3, MPI_COMM_WORLD, req(4), ierr)
            call MPI_Send  (ibuf_sndN, isize, MPI_DOUBLE_PRECISION,
     &                         p_N, 4, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        endif
        if (mdii.eq.0) then
          if (CORNER_SW) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd1(ipts+Npts*(jpts-1))=A(ipts,jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev1,buf_snd1)
            call MPI_Irecv (buf_rev1,ksize, MPI_DOUBLE_PRECISION,  p_SW,
     &                               6, MPI_COMM_WORLD, req(5),ierr)
            call MPI_Send  (buf_snd1,ksize, MPI_DOUBLE_PRECISION,  p_SW,
     &                               5, MPI_COMM_WORLD,        ierr)
!$acc end host_data
          endif
        else
          if (CORNER_NE) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd2(ipts+Npts*(jpts-1))=
     &                                A(Lmmpi-Npts+ipts,Mmmpi-Npts+jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev2,buf_snd2)
            call MPI_Irecv (buf_rev2,ksize, MPI_DOUBLE_PRECISION,  p_NE,
     &                               5, MPI_COMM_WORLD, req(6),ierr)
            call MPI_Send  (buf_snd2,ksize, MPI_DOUBLE_PRECISION,  p_NE,
     &                               6, MPI_COMM_WORLD,        ierr)
!$acc end host_data
          endif
        endif
        if (mdii.eq.1) then
          if (CORNER_SE) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd3(ipts+Npts*(jpts-1))=
     &                                A(Lmmpi-Npts+ipts,jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev3,buf_snd3)
            call MPI_Irecv (buf_rev3,ksize, MPI_DOUBLE_PRECISION,  p_SE,
     &                               8, MPI_COMM_WORLD, req(7), ierr)
            call MPI_Send  (buf_snd3,ksize, MPI_DOUBLE_PRECISION,  p_SE,
     &                               7, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        else
          if (CORNER_NW) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd4(ipts+Npts*(jpts-1))=
     &                                A(ipts,Mmmpi-Npts+jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev4,buf_snd4)
            call MPI_Irecv (buf_rev4, ksize, MPI_DOUBLE_PRECISION, p_NW,
     &                               7, MPI_COMM_WORLD, req(8), ierr)
            call MPI_Send  (buf_snd4, ksize, MPI_DOUBLE_PRECISION, p_NW,
     &                               8, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        endif
      enddo
      if (WEST_INTER2) then
        call MPI_Wait (req(1),status(1,1),ierr)
!$acc update device(jbuf_revW) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(ipts-Npts,j)=jbuf_revW(j-jmin+(ipts-1)*jshft)
          enddo
        enddo
      endif
      if ( WEST_INTER .and. .not. WEST_INTER2 ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(ipts-Npts,j)=A(ipts,j)
          enddo
        enddo
      endif
      if (EAST_INTER2) then
        call MPI_Wait (req(2),status(1,2),ierr)
!$acc update device(jbuf_revE) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(Lmmpi+ipts,j)=jbuf_revE(j-jmin+(ipts-1)*jshft)
          enddo
        enddo
      endif
      if ( EAST_INTER .and. .not. EAST_INTER2 ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(Lmmpi+ipts,j)=A(Lmmpi-Npts+ipts,j)
          enddo
        enddo
      endif
      if (SOUTH_INTER2) then
        call MPI_Wait (req(3),status(1,3),ierr)
!$acc update device(ibuf_revS) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
       do jpts=1,Npts
          do i=imin,imax
           A(i,jpts-Npts)=ibuf_revS(i-imin+(jpts-1)*ishft)
          enddo
        enddo
      endif
      if ( SOUTH_INTER .and. .not. SOUTH_INTER2 ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do i=imin,imax
           A(i,jpts-Npts)=A(i,jpts)
          enddo
        enddo
      endif
      if (NORTH_INTER2) then
        call MPI_Wait (req(4),status(1,4),ierr)
!$acc update device(ibuf_revN) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do i=imin,imax
            A(i,Mmmpi+jpts)=ibuf_revN(i-imin+(jpts-1)*ishft)
          enddo
        enddo
      endif
      if (NORTH_INTER .AND. .not. NORTH_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do i=imin,imax
            A(i,Mmmpi+jpts)=A(i,Mmmpi-Npts+jpts)
          enddo
        enddo
      endif
      if ( CORNER_SW) then
        call MPI_Wait (req(5),status(1,5),ierr)
!$acc update device(buf_rev1) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
          A(ipts-Npts,jpts-Npts)=buf_rev1(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not.CORNER_SW .and.
     &  SOUTH_INTER .and.WEST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
           A(ipts-Npts,jpts-Npts)=A(ipts,jpts)
          enddo
        enddo
       endif
      if ( CORNER_NE) then
        call MPI_Wait (req(6),status(1,6),ierr)
!$acc update device(buf_rev2) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,Mmmpi+jpts)=buf_rev2(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not.CORNER_NE .and.
     &  NORTH_INTER .and.EAST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,Mmmpi+jpts)=A(Lmmpi+ipts-NPts,Mmmpi+jpts-Npts)
          enddo
        enddo
       endif
      if (CORNER_SE) then
        call MPI_Wait (req(7),status(1,7),ierr)
!$acc update device(buf_rev3) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,jpts-Npts)=buf_rev3(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not. CORNER_SE .and.
     &  SOUTH_INTER .and. EAST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,jpts-Npts)=A(Lmmpi+ipts-Npts,jpts)
          enddo
        enddo
      endif
      if (CORNER_NW) then
        call MPI_Wait (req(8),status(1,8),ierr)
!$acc update device(buf_rev4) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(ipts-Npts,Mmmpi+jpts)=buf_rev4(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not. CORNER_NW .and.
     &   NORTH_INTER .and.  WEST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
       do jpts=1,Npts
          do ipts=1,Npts
            A(ipts-Npts,Mmmpi+jpts)=A(ipts,Mmmpi+jpts-NPts)
          enddo
        enddo
       endif
      return
       
      

      end subroutine Sub_Loop_MessPass2D_3pts_tile

      subroutine MessPass2D_1pts_tile (Istr,Iend,Jstr,Jend, A)      


      use Agrif_Util
      interface
        subroutine Sub_Loop_MessPass2D_1pts_tile(Istr,Iend,Jstr,Jend,A,N
     &ORTH_INTER,SOUTH_INTER,EAST_INTER,WEST_INTER,p_NW,buf_rev4,buf_snd
     &4,CORNER_NW,p_SE,buf_rev3,buf_snd3,CORNER_SE,p_NE,buf_rev2,buf_snd
     &2,CORNER_NE,p_SW,buf_rev1,buf_snd1,CORNER_SW,p_N,NORTH_INTER2,p_S,
     &SOUTH_INTER2,p_E,EAST_INTER2,p_W,WEST_INTER2,jbuf_revE,jbuf_revW,j
     &buf_sndE,jbuf_sndW,ibuf_revS,ibuf_sndS,ibuf_revN,ibuf_sndN,Mmmpi,j
     &j,Lmmpi,ii,padd_E,Mm,padd_X,Lm)
          implicit none
      integer(4), parameter :: LLm0 = 41
      integer(4), parameter :: MMm0 = 42
      integer(4), parameter :: N = 32
      integer(4), parameter :: N_sl = 0
      integer(4), parameter :: NP_XI = 1
      integer(4), parameter :: NP_ETA = 4
      integer(4), parameter :: NNODES = NP_XI*NP_ETA
      integer(4), parameter :: NPP = 1
      integer(4), parameter :: NSUB_X = 1
      integer(4), parameter :: NSUB_E = 1
      integer(4), parameter :: NWEIGHT = 1000
      integer(4), parameter :: Ntides = 8
      integer(4), parameter :: stdout = 6
      integer(4), parameter :: Np = N+1
      integer(4), parameter :: NpHz = (N+1+N_sl)
      integer(4), parameter :: NSA = 28
      real, parameter :: Vtransform = 2
      integer(4), parameter :: itemp = 1
      integer(4), parameter :: ntrc_temp = 1
      integer(4), parameter :: ntrc_salt = 1
      integer(4), parameter :: ntrc_pas = 0
      integer(4), parameter :: ntrc_bio = 0
      integer(4), parameter :: ntrc_subs = 0
      integer(4), parameter :: ntrc_substot = 0
      integer(4), parameter :: ntrc_sed = 0
      integer(4), parameter :: NTA = itemp+ntrc_salt
      integer(4), parameter :: NT = itemp+ntrc_salt+ntrc_pas+ntrc_bio+nt
     &rc_sed
      integer(4), parameter :: NTot = NT
      integer(4), parameter :: isalt = itemp+1
      integer(4), parameter :: ntrc_diabio = 0
      integer(4), parameter :: ntrc_diats = 0
      integer(4), parameter :: ntrc_diauv = 0
      integer(4), parameter :: ntrc_diavrt = 0
      integer(4), parameter :: ntrc_diaek = 0
      integer(4), parameter :: ntrc_diapv = 0
      integer(4), parameter :: ntrc_diaeddy = 0
      integer(4), parameter :: ntrc_surf = 0
      real, parameter :: pi = 3.14159265358979323846D0
      real, parameter :: deg2rad = pi/180.D0
      real, parameter :: rad2deg = 180.D0/pi
      real, parameter :: Eradius = 6371315.0D0
      real, parameter :: Erotation = 7.292115090D-5
      real, parameter :: day2sec = 86400.D0
      real, parameter :: sec2day = 1.D0/86400.D0
      real, parameter :: year2day = 365.25D0
      real, parameter :: day2year = 1.D0/365.25D0
      real, parameter :: jul_off = 2440000.D0
      real, parameter :: g = 9.81D0
      real, parameter :: Cp = 3985.0D0
      real, parameter :: vonKar = 0.41D0
      real, parameter :: spval = -999.0D0
      logical, parameter :: mask_val = .true.
      integer(4), parameter :: Npts = 1
      logical, parameter :: use_host_device = .TRUE.
      logical :: NORTH_INTER
      logical :: SOUTH_INTER
      logical :: EAST_INTER
      logical :: WEST_INTER
      integer(4) :: p_NW
      logical :: CORNER_NW
      integer(4) :: p_SE
      logical :: CORNER_SE
      integer(4) :: p_NE
      logical :: CORNER_NE
      integer(4) :: p_SW
      logical :: CORNER_SW
      integer(4) :: p_N
      logical :: NORTH_INTER2
      integer(4) :: p_S
      logical :: SOUTH_INTER2
      integer(4) :: p_E
      logical :: EAST_INTER2
      integer(4) :: p_W
      logical :: WEST_INTER2
      integer(4) :: Mmmpi
      integer(4) :: jj
      integer(4) :: Lmmpi
      integer(4) :: ii
      integer(4) :: padd_E
      integer(4) :: Mm
      integer(4) :: padd_X
      integer(4) :: Lm
      real, dimension(1:3*3) :: buf_rev4
      real, dimension(1:3*3) :: buf_snd4
      real, dimension(1:3*3) :: buf_rev3
      real, dimension(1:3*3) :: buf_snd3
      real, dimension(1:3*3) :: buf_rev2
      real, dimension(1:3*3) :: buf_snd2
      real, dimension(1:3*3) :: buf_rev1
      real, dimension(1:3*3) :: buf_snd1
      real, allocatable, dimension(:) :: jbuf_revE
      real, allocatable, dimension(:) :: jbuf_revW
      real, allocatable, dimension(:) :: jbuf_sndE
      real, allocatable, dimension(:) :: jbuf_sndW
      real, allocatable, dimension(:) :: ibuf_revS
      real, allocatable, dimension(:) :: ibuf_sndS
      real, allocatable, dimension(:) :: ibuf_revN
      real, allocatable, dimension(:) :: ibuf_sndN
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: A
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
        end subroutine Sub_Loop_MessPass2D_1pts_tile

      end interface
      real, dimension(-1: Agrif_tabvars_i(2)%iarray0+2+ Agrif_tabvars_i(
     &13)%iarray0,-1: Agrif_tabvars_i(4)%iarray0+2+ Agrif_tabvars_i(14)%
     &iarray0) :: A
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
      

        call Sub_Loop_MessPass2D_1pts_tile(Istr,Iend,Jstr,Jend,A, Agrif_
     &tabvars_l(13)%larray0, Agrif_tabvars_l(14)%larray0, Agrif_tabvars_
     &l(11)%larray0, Agrif_tabvars_l(12)%larray0, Agrif_tabvars_i(186)%i
     &array0, Agrif_tabvars(335)%array1, Agrif_tabvars(337)%array1, Agri
     &f_tabvars_l(16)%larray0, Agrif_tabvars_i(185)%iarray0, Agrif_tabva
     &rs(330)%array1, Agrif_tabvars(332)%array1, Agrif_tabvars_l(18)%lar
     &ray0, Agrif_tabvars_i(187)%iarray0, Agrif_tabvars(334)%array1, Agr
     &if_tabvars(336)%array1, Agrif_tabvars_l(17)%larray0, Agrif_tabvars
     &_i(184)%iarray0, Agrif_tabvars(331)%array1, Agrif_tabvars(333)%arr
     &ay1, Agrif_tabvars_l(15)%larray0, Agrif_tabvars_i(183)%iarray0, Ag
     &rif_tabvars_l(9)%larray0, Agrif_tabvars_i(182)%iarray0, Agrif_tabv
     &ars_l(10)%larray0, Agrif_tabvars_i(181)%iarray0, Agrif_tabvars_l(7
     &)%larray0, Agrif_tabvars_i(180)%iarray0, Agrif_tabvars_l(8)%larray
     &0, Agrif_tabvars(322)%array1, Agrif_tabvars(323)%array1, Agrif_tab
     &vars(324)%array1, Agrif_tabvars(325)%array1, Agrif_tabvars(326)%ar
     &ray1, Agrif_tabvars(327)%array1, Agrif_tabvars(328)%array1, Agrif_
     &tabvars(329)%array1, Agrif_tabvars_i(8)%iarray0, Agrif_tabvars_i(1
     &79)%iarray0, Agrif_tabvars_i(7)%iarray0, Agrif_tabvars_i(178)%iarr
     &ay0, Agrif_tabvars_i(14)%iarray0, Agrif_tabvars_i(4)%iarray0, Agri
     &f_tabvars_i(13)%iarray0, Agrif_tabvars_i(2)%iarray0)

      end


      subroutine Sub_Loop_MessPass2D_1pts_tile(Istr,Iend,Jstr,Jend,A,NOR
     &TH_INTER,SOUTH_INTER,EAST_INTER,WEST_INTER,p_NW,buf_rev4,buf_snd4,
     &CORNER_NW,p_SE,buf_rev3,buf_snd3,CORNER_SE,p_NE,buf_rev2,buf_snd2,
     &CORNER_NE,p_SW,buf_rev1,buf_snd1,CORNER_SW,p_N,NORTH_INTER2,p_S,SO
     &UTH_INTER2,p_E,EAST_INTER2,p_W,WEST_INTER2,jbuf_revE,jbuf_revW,jbu
     &f_sndE,jbuf_sndW,ibuf_revS,ibuf_sndS,ibuf_revN,ibuf_sndN,Mmmpi,jj,
     &Lmmpi,ii,padd_E,Mm,padd_X,Lm)

      use Agrif_Types, only : Agrif_tabvars


      include 'mpif.h'
      integer(4), parameter :: LLm0 = 41
      integer(4), parameter :: MMm0 = 42
      integer(4), parameter :: N = 32
      integer(4), parameter :: N_sl = 0
      integer(4), parameter :: NP_XI = 1
      integer(4), parameter :: NP_ETA = 4
      integer(4), parameter :: NNODES = NP_XI*NP_ETA
      integer(4), parameter :: NPP = 1
      integer(4), parameter :: NSUB_X = 1
      integer(4), parameter :: NSUB_E = 1
      integer(4), parameter :: NWEIGHT = 1000
      integer(4), parameter :: Ntides = 8
      integer(4), parameter :: stdout = 6
      integer(4), parameter :: Np = N+1
      integer(4), parameter :: NpHz = (N+1+N_sl)
      integer(4), parameter :: NSA = 28
      real, parameter :: Vtransform = 2
      integer(4), parameter :: itemp = 1
      integer(4), parameter :: ntrc_temp = 1
      integer(4), parameter :: ntrc_salt = 1
      integer(4), parameter :: ntrc_pas = 0
      integer(4), parameter :: ntrc_bio = 0
      integer(4), parameter :: ntrc_subs = 0
      integer(4), parameter :: ntrc_substot = 0
      integer(4), parameter :: ntrc_sed = 0
      integer(4), parameter :: NTA = itemp+ntrc_salt
      integer(4), parameter :: NT = itemp+ntrc_salt+ntrc_pas+ntrc_bio+nt
     &rc_sed
      integer(4), parameter :: NTot = NT
      integer(4), parameter :: isalt = itemp+1
      integer(4), parameter :: ntrc_diabio = 0
      integer(4), parameter :: ntrc_diats = 0
      integer(4), parameter :: ntrc_diauv = 0
      integer(4), parameter :: ntrc_diavrt = 0
      integer(4), parameter :: ntrc_diaek = 0
      integer(4), parameter :: ntrc_diapv = 0
      integer(4), parameter :: ntrc_diaeddy = 0
      integer(4), parameter :: ntrc_surf = 0
      real, parameter :: pi = 3.14159265358979323846D0
      real, parameter :: deg2rad = pi/180.D0
      real, parameter :: rad2deg = 180.D0/pi
      real, parameter :: Eradius = 6371315.0D0
      real, parameter :: Erotation = 7.292115090D-5
      real, parameter :: day2sec = 86400.D0
      real, parameter :: sec2day = 1.D0/86400.D0
      real, parameter :: year2day = 365.25D0
      real, parameter :: day2year = 1.D0/365.25D0
      real, parameter :: jul_off = 2440000.D0
      real, parameter :: g = 9.81D0
      real, parameter :: Cp = 3985.0D0
      real, parameter :: vonKar = 0.41D0
      real, parameter :: spval = -999.0D0
      logical, parameter :: mask_val = .true.
      integer(4), parameter :: Npts = 1
      logical, parameter :: use_host_device = .TRUE.
      logical :: NORTH_INTER
      logical :: SOUTH_INTER
      logical :: EAST_INTER
      logical :: WEST_INTER
      integer(4) :: p_NW
      logical :: CORNER_NW
      integer(4) :: p_SE
      logical :: CORNER_SE
      integer(4) :: p_NE
      logical :: CORNER_NE
      integer(4) :: p_SW
      logical :: CORNER_SW
      integer(4) :: p_N
      logical :: NORTH_INTER2
      integer(4) :: p_S
      logical :: SOUTH_INTER2
      integer(4) :: p_E
      logical :: EAST_INTER2
      integer(4) :: p_W
      logical :: WEST_INTER2
      integer(4) :: Mmmpi
      integer(4) :: jj
      integer(4) :: Lmmpi
      integer(4) :: ii
      integer(4) :: padd_E
      integer(4) :: Mm
      integer(4) :: padd_X
      integer(4) :: Lm
      real, dimension(1:3*3) :: buf_rev4
      real, dimension(1:3*3) :: buf_snd4
      real, dimension(1:3*3) :: buf_rev3
      real, dimension(1:3*3) :: buf_snd3
      real, dimension(1:3*3) :: buf_rev2
      real, dimension(1:3*3) :: buf_snd2
      real, dimension(1:3*3) :: buf_rev1
      real, dimension(1:3*3) :: buf_snd1
      real, allocatable, dimension(:) :: jbuf_revE
      real, allocatable, dimension(:) :: jbuf_revW
      real, allocatable, dimension(:) :: jbuf_sndE
      real, allocatable, dimension(:) :: jbuf_sndW
      real, allocatable, dimension(:) :: ibuf_revS
      real, allocatable, dimension(:) :: ibuf_sndS
      real, allocatable, dimension(:) :: ibuf_revN
      real, allocatable, dimension(:) :: ibuf_sndN
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: A
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend

                                            
                             
                                            

                                                             
                     
                        

                                                            
                                           
                                                               
                                    
                                      
                                                          

                       

                                    

                        
                              

                       
                          

                                                
                                             
                          

                        

                                 

                                                
                        

                                                              
                      
                              

                                       
                                                                     
                                          
                         

                             

                             

                            

                            

                                             

                            

                                     

                                                               

                         

                                                      
                                                      
                                                                  
                               

                               

                              

                              

                               

                              

                              

                                

                             

                                                                  
                                                                       
                                                                 
                                 
                                
                                                                       
                                                                 
                                                                 
                                                                 
                                                        
                                                                       
                                                                 
                                                                 
            
                                              
                                                   
                     
                              
                               
                                 
                                                  
                                                                       
                                                                 
                                                                 
                        
                      
                           
                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                    
                           
                                      
                             
                                                 
                                                                       
                                                                 
                     
                                                      
                                                                       
                                                                 
              
                                          
                                                                       
                                                                 
       
                                                           
      real(8) :: Cu_Nbq_X
      real(8) :: Cu_Nbq_Y
      real(8) :: Cu_Nbq_Z
                                             
                                                                       
                                                                 
              
                                                  
                                                                       
                                                                 
              
                                  
                                           
                                                  
                                                                   
                                                               
                                                      
                                                                       
                                                                 
                      
                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                        
                                
                                                                       
                                                                 
                                                        

                                                                       
                                                                 
                  
                                                                       
                                                                 
                                                                 
                                                                 
                  

                          

              
                             

                  
                               

                 
                                

                       
                                   

!$AGRIF_DO_NOT_TREAT
      INTEGER*4 :: ocean_grid_comm
      common /cpl_comm/ ocean_grid_comm
!$AGRIF_END_DO_NOT_TREAT
                       
                     
                        

                                                     
                                           
      integer(4) :: sub_X
      integer(4) :: size_X
      integer(4) :: sub_E
      integer(4) :: size_E
                                                                       
                                                                 
                                                                 
                         
                                                                       
                                                                 
                                                                 
                                           
                                                                       
                                                                 
                                                                 
                                                                 
                                              
                                                              
      integer(4) :: size_Z
      integer(4) :: sub_X_3D
      integer(4) :: size_X_3D
      integer(4) :: sub_E_3D
      integer(4) :: size_E_3D
                                                                       
                                                                 
                                                                 
                                                 
                                                                       
                                                                 
                                                                 
                                         
                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                        
                          
      integer(4) :: ipts
      integer(4) :: jpts
                                            
                                                                       
                                                                 
                                                              
      integer(4) :: i
      integer(4) :: j
      integer(4) :: isize
      integer(4) :: jsize
      integer(4) :: ksize
      integer(4) :: iter
      integer(4), dimension(1:8) :: req
      integer(4), dimension(1:MPI_STATUS_SIZE,1:8) :: status
      integer(4) :: ierr
      integer(4) :: mdii
      integer(4) :: mdjj
                                                 
      integer(4) :: imin
      integer(4) :: imax
      integer(4) :: ishft
      integer(4) :: jmin
      integer(4) :: jmax
      integer(4) :: jshft
      if (ii.eq.0 .and. Istr.eq.1) then
        imin=Istr-1
      else
        imin=Istr
      endif
      if (ii.eq.NP_XI-1 .and. Iend.eq.Lmmpi) then
        imax=Iend+1
      else
        imax=Iend
      endif
      ishft=imax-imin+1
      if (jj.eq.0 .and. Jstr.eq.1) then
        jmin=Jstr-1
      else
        jmin=Jstr
      endif
      if (jj.eq.NP_ETA-1 .and. Jend.eq.Mmmpi) then
        jmax=Jend+1
      else
        jmax=Jend
      endif
      jshft=jmax-jmin+1
         sub_X=Lm
         size_X=Npts*(sub_X+2*Npts)-1
         sub_E=Mm
         size_E=Npts*(sub_E+2*Npts)-1
         if (.not. allocated(ibuf_sndN)) then
         Allocate(ibuf_sndN(0:size_X), ibuf_revN(0:size_X),
     &     ibuf_sndS(0:size_X), ibuf_revS(0:size_X),
     &     jbuf_sndW(0:size_E), jbuf_sndE(0:size_E),
     &     jbuf_revW(0:size_E), jbuf_revE(0:size_E))
         endif
      ksize=Npts*Npts
      isize=Npts*ishft
      jsize=Npts*jshft
      do iter=0,1
        mdii=mod(ii+iter,2)
        mdjj=mod(jj+iter,2)
        if (mdii.eq.0) then
          if (WEST_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do j=jmin,jmax
              do ipts=1,Npts
                jbuf_sndW(j-jmin+(ipts-1)*jshft)=A(ipts,j)
              enddo
            enddo
!$acc update host(jbuf_sndW) if(.not.use_host_device)
!$acc host_data if(compute_on_device.and.use_host_device)
!$acc& use_device(jbuf_revW, jbuf_sndW)
            call MPI_Irecv (jbuf_revW, jsize, MPI_DOUBLE_PRECISION,
     &                         p_W, 2, MPI_COMM_WORLD, req(1), ierr)
            call MPI_Send  (jbuf_sndW, jsize, MPI_DOUBLE_PRECISION,
     &                         p_W, 1, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        else
          if (EAST_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do j=jmin,jmax
              do ipts=1,Npts
                jbuf_sndE(j-jmin+(ipts-1)*jshft)=A(Lmmpi-Npts+ipts,j)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(jbuf_revE, jbuf_sndE)
            call MPI_Irecv (jbuf_revE, jsize, MPI_DOUBLE_PRECISION,
     &                         p_E, 1, MPI_COMM_WORLD, req(2), ierr)
            call MPI_Send  (jbuf_sndE, jsize, MPI_DOUBLE_PRECISION,
     &                         p_E, 2, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        endif
        if (mdjj.eq.0) then
          if (SOUTH_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do i=imin,imax
                ibuf_sndS(i-imin+(jpts-1)*ishft)=A(i,jpts)
              enddo
            enddo
!$acc update host(ibuf_sndS) if(.not.use_host_device)
!$acc host_data if(compute_on_device.and.use_host_device)
!$acc&  use_device(ibuf_revS, ibuf_sndS)
            call MPI_Irecv (ibuf_revS, isize, MPI_DOUBLE_PRECISION,
     &                         p_S, 4, MPI_COMM_WORLD, req(3), ierr)
            call MPI_Send  (ibuf_sndS, isize, MPI_DOUBLE_PRECISION,
     &                         p_S, 3, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        else
          if (NORTH_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do i=imin,imax
                ibuf_sndN(i-imin+(jpts-1)*ishft)=A(i,Mmmpi-Npts+jpts)
              enddo
            enddo
!$acc update host(ibuf_sndN) if(.not.use_host_device)
!$acc host_data if(compute_on_device.and.use_host_device)
!$acc&  use_device(ibuf_revN, ibuf_sndN)
            call MPI_Irecv (ibuf_revN, isize, MPI_DOUBLE_PRECISION,
     &                         p_N, 3, MPI_COMM_WORLD, req(4), ierr)
            call MPI_Send  (ibuf_sndN, isize, MPI_DOUBLE_PRECISION,
     &                         p_N, 4, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        endif
        if (mdii.eq.0) then
          if (CORNER_SW) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd1(ipts+Npts*(jpts-1))=A(ipts,jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev1,buf_snd1)
            call MPI_Irecv (buf_rev1,ksize, MPI_DOUBLE_PRECISION,  p_SW,
     &                               6, MPI_COMM_WORLD, req(5),ierr)
            call MPI_Send  (buf_snd1,ksize, MPI_DOUBLE_PRECISION,  p_SW,
     &                               5, MPI_COMM_WORLD,        ierr)
!$acc end host_data
          endif
        else
          if (CORNER_NE) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd2(ipts+Npts*(jpts-1))=
     &                                A(Lmmpi-Npts+ipts,Mmmpi-Npts+jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev2,buf_snd2)
            call MPI_Irecv (buf_rev2,ksize, MPI_DOUBLE_PRECISION,  p_NE,
     &                               5, MPI_COMM_WORLD, req(6),ierr)
            call MPI_Send  (buf_snd2,ksize, MPI_DOUBLE_PRECISION,  p_NE,
     &                               6, MPI_COMM_WORLD,        ierr)
!$acc end host_data
          endif
        endif
        if (mdii.eq.1) then
          if (CORNER_SE) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd3(ipts+Npts*(jpts-1))=
     &                                A(Lmmpi-Npts+ipts,jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev3,buf_snd3)
            call MPI_Irecv (buf_rev3,ksize, MPI_DOUBLE_PRECISION,  p_SE,
     &                               8, MPI_COMM_WORLD, req(7), ierr)
            call MPI_Send  (buf_snd3,ksize, MPI_DOUBLE_PRECISION,  p_SE,
     &                               7, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        else
          if (CORNER_NW) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
            do jpts=1,Npts
              do ipts=1,Npts
                buf_snd4(ipts+Npts*(jpts-1))=
     &                                A(ipts,Mmmpi-Npts+jpts)
              enddo
            enddo
!$acc host_data if(compute_on_device) use_device(buf_rev4,buf_snd4)
            call MPI_Irecv (buf_rev4, ksize, MPI_DOUBLE_PRECISION, p_NW,
     &                               7, MPI_COMM_WORLD, req(8), ierr)
            call MPI_Send  (buf_snd4, ksize, MPI_DOUBLE_PRECISION, p_NW,
     &                               8, MPI_COMM_WORLD,         ierr)
!$acc end host_data
          endif
        endif
      enddo
      if (WEST_INTER2) then
        call MPI_Wait (req(1),status(1,1),ierr)
!$acc update device(jbuf_revW) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(ipts-Npts,j)=jbuf_revW(j-jmin+(ipts-1)*jshft)
          enddo
        enddo
      endif
      if ( WEST_INTER .and. .not. WEST_INTER2 ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(ipts-Npts,j)=A(ipts,j)
          enddo
        enddo
      endif
      if (EAST_INTER2) then
        call MPI_Wait (req(2),status(1,2),ierr)
!$acc update device(jbuf_revE) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(Lmmpi+ipts,j)=jbuf_revE(j-jmin+(ipts-1)*jshft)
          enddo
        enddo
      endif
      if ( EAST_INTER .and. .not. EAST_INTER2 ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do j=jmin,jmax
          do ipts=1,Npts
           A(Lmmpi+ipts,j)=A(Lmmpi-Npts+ipts,j)
          enddo
        enddo
      endif
      if (SOUTH_INTER2) then
        call MPI_Wait (req(3),status(1,3),ierr)
!$acc update device(ibuf_revS) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
       do jpts=1,Npts
          do i=imin,imax
           A(i,jpts-Npts)=ibuf_revS(i-imin+(jpts-1)*ishft)
          enddo
        enddo
      endif
      if ( SOUTH_INTER .and. .not. SOUTH_INTER2 ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do i=imin,imax
           A(i,jpts-Npts)=A(i,jpts)
          enddo
        enddo
      endif
      if (NORTH_INTER2) then
        call MPI_Wait (req(4),status(1,4),ierr)
!$acc update device(ibuf_revN) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do i=imin,imax
            A(i,Mmmpi+jpts)=ibuf_revN(i-imin+(jpts-1)*ishft)
          enddo
        enddo
      endif
      if (NORTH_INTER .AND. .not. NORTH_INTER2) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do i=imin,imax
            A(i,Mmmpi+jpts)=A(i,Mmmpi-Npts+jpts)
          enddo
        enddo
      endif
      if ( CORNER_SW) then
        call MPI_Wait (req(5),status(1,5),ierr)
!$acc update device(buf_rev1) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
          A(ipts-Npts,jpts-Npts)=buf_rev1(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not.CORNER_SW .and.
     &  SOUTH_INTER .and.WEST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
           A(ipts-Npts,jpts-Npts)=A(ipts,jpts)
          enddo
        enddo
       endif
      if ( CORNER_NE) then
        call MPI_Wait (req(6),status(1,6),ierr)
!$acc update device(buf_rev2) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,Mmmpi+jpts)=buf_rev2(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not.CORNER_NE .and.
     &  NORTH_INTER .and.EAST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,Mmmpi+jpts)=A(Lmmpi+ipts-NPts,Mmmpi+jpts-Npts)
          enddo
        enddo
       endif
      if (CORNER_SE) then
        call MPI_Wait (req(7),status(1,7),ierr)
!$acc update device(buf_rev3) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,jpts-Npts)=buf_rev3(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not. CORNER_SE .and.
     &  SOUTH_INTER .and. EAST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(Lmmpi+ipts,jpts-Npts)=A(Lmmpi+ipts-Npts,jpts)
          enddo
        enddo
      endif
      if (CORNER_NW) then
        call MPI_Wait (req(8),status(1,8),ierr)
!$acc update device(buf_rev4) if(.not.use_host_device)
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
        do jpts=1,Npts
          do ipts=1,Npts
            A(ipts-Npts,Mmmpi+jpts)=buf_rev4(ipts+Npts*(jpts-1))
          enddo
        enddo
      endif
      if (.not. CORNER_NW .and.
     &   NORTH_INTER .and.  WEST_INTER ) then
!$acc parallel loop if(compute_on_device) independent
!$acc&  default(present) collapse(2)
       do jpts=1,Npts
          do ipts=1,Npts
            A(ipts-Npts,Mmmpi+jpts)=A(ipts,Mmmpi+jpts-NPts)
          enddo
        enddo
       endif
      return
       
      

      end subroutine Sub_Loop_MessPass2D_1pts_tile

      module buf_mpi_3D


        implicit none
        public :: Alloc_agrif_buf_mpi_3D
      contains
      subroutine Alloc_agrif_buf_mpi_3D(Agrif_Gr)
        use Agrif_Util
        type(Agrif_grid), pointer :: Agrif_Gr
        integer :: i
      end subroutine Alloc_agrif_buf_mpi_3D
      end module buf_mpi_3D
      module buf_mpi


        implicit none
        public :: Alloc_agrif_buf_mpi
      contains
      subroutine Alloc_agrif_buf_mpi(Agrif_Gr)
        use Agrif_Util
        type(Agrif_grid), pointer :: Agrif_Gr
        integer :: i
      !! ALLOCATION OF VARIABLE : buf_rev3
      do i = 330,337
          if (.not. allocated(Agrif_Gr % tabvars(i)% array1)) then
          allocate(Agrif_Gr % tabvars(i)% array1(1 : 3*3))
          Agrif_Gr % tabvars(i)% array1 = 0
      endif
      enddo
      end subroutine Alloc_agrif_buf_mpi
      end module buf_mpi
