










      subroutine prsgrd (tile)      


      use Agrif_Util
      interface
        subroutine Sub_Loop_prsgrd(tile,N3d,N2d,A2d,A3d,Mmmpi,Lmmpi,N3dH
     &z)
          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
      integer(4) :: N3d
      integer(4) :: N2d
      integer(4) :: Mmmpi
      integer(4) :: Lmmpi
      integer(4) :: N3dHz
      real, dimension(1:N2d,1:NSA,0:NPP-1) :: A2d
      real, dimension(1:N3d,1:9,0:NPP-1) :: A3d
      integer(4) :: tile
        end subroutine Sub_Loop_prsgrd

      end interface
      integer(4) :: tile
      

        call Sub_Loop_prsgrd(tile, Agrif_tabvars_i(16)%iarray0, Agrif_ta
     &bvars_i(15)%iarray0, Agrif_tabvars(131)%array3, Agrif_tabvars(130)
     &%array3, Agrif_tabvars_i(8)%iarray0, Agrif_tabvars_i(7)%iarray0, A
     &grif_tabvars_i(17)%iarray0)

      end


      subroutine Sub_Loop_prsgrd(tile,N3d,N2d,A2d,A3d,Mmmpi,Lmmpi,N3dHz)

      use Agrif_Types, only : Agrif_tabvars

      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
      integer(4) :: N3d
      integer(4) :: N2d
      integer(4) :: Mmmpi
      integer(4) :: Lmmpi
      integer(4) :: N3dHz
      real, dimension(1:N2d,1:NSA,0:NPP-1) :: A2d
      real, dimension(1:N3d,1:9,0:NPP-1) :: A3d
      integer(4) :: tile

                   

                                              
      integer(4) :: trd
      integer(4) :: omp_get_thread_num
                                            
                             
                                            

                                                             
                     
                        

                                                            
                                           
                                                               
                                    
                                      
                                                          

                       

                                    

                        
                              

                       
                          

                                                
                                             
                          

                        

                                 

                                                
                        

                                                              
                      
                              

                                       
                                                                     
                                          
                         

                             

                             

                            

                            

                                             

                            

                                     

                                                               

                         

                                                      
                                                      
                                                                  
                               

                               

                              

                              

                               

                              

                              

                                

                             

                                                                       
                                                                 
               
                                 
                                            
                                      
                                                            
      integer(4) :: chunk_size_X
      integer(4) :: margin_X
      integer(4) :: chunk_size_E
      integer(4) :: margin_E
                                             
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
      integer(4) :: i_X
      integer(4) :: j_E
      chunk_size_X=(Lmmpi+NSUB_X-1)/NSUB_X
      margin_X=(NSUB_X*chunk_size_X-Lmmpi)/2
      chunk_size_E=(Mmmpi+NSUB_E-1)/NSUB_E
      margin_E=(NSUB_E*chunk_size_E-Mmmpi)/2
      j_E=tile/NSUB_X
      i_X=tile-j_E*NSUB_X
      Istr=1+i_X*chunk_size_X-margin_X
      Iend=Istr+chunk_size_X-1
      Istr=max(Istr,1)
      Iend=min(Iend,Lmmpi)
      Jstr=1+j_E*chunk_size_E-margin_E
      Jend=Jstr+chunk_size_E-1
      Jstr=max(Jstr,1)
      Jend=min(Jend,Mmmpi)
      trd=omp_get_thread_num()
      call prsgrd_tile (Istr,Iend,Jstr,Jend,
     &                  A3d(1,1,trd), A3d(1,2,trd), A3d(1,3,trd),
     &                  A2d(1,1,trd), A2d(1,2,trd), A2d(1,3,trd),
     &                  A2d(1,4,trd), A2d(1,5,trd), A2d(1,6,trd))
      return
       
      

      end subroutine Sub_Loop_prsgrd

      subroutine prsgrd_tile (Istr,Iend,Jstr,Jend, ru,rv, P,
     &                                       dR,dZ, FC,dZx,rx,dRx)      


      use Agrif_Util
      integer(4), parameter :: N = 32
      interface
        subroutine Sub_Loop_prsgrd_tile(Istr,Iend,Jstr,Jend,ru,rv,P,dR,d
     &Z,FC,dZx,rx,dRx,padd_E,Mm,padd_X,Lm,om_v,vmask,on_u,Hz,umask,Ptide
     &,rho,qp1,rho1,z_w,z_r,rho0,NORTH_INTER,Mmmpi,SOUTH_INTER,EAST_INTE
     &R,Lmmpi,WEST_INTER)
          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 :: OneFifth = 0.2D0
      real, parameter :: OneTwelfth = 1.D0/12.D0
      real, parameter :: epsil = 0.D0
      real, parameter :: qp2 = 0.0000172D0
      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) :: padd_E
      integer(4) :: Mm
      integer(4) :: padd_X
      integer(4) :: Lm
      real :: rho0
      logical :: NORTH_INTER
      integer(4) :: Mmmpi
      logical :: SOUTH_INTER
      logical :: EAST_INTER
      integer(4) :: Lmmpi
      logical :: WEST_INTER
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: om_v
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: vmask
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: on_u
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: Hz
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: umask
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: Ptide
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: rho
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: qp1
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: rho1
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,0:N) :: z_w
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: z_r
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2,1:N) :: ru
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2,1:N) :: rv
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2,1:N) :: P
      real, dimension(Istr-2:Iend+2,0:N) :: dR
      real, dimension(Istr-2:Iend+2,0:N) :: dZ
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: FC
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: dZx
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: rx
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: dRx
        end subroutine Sub_Loop_prsgrd_tile

      end interface
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2,1:N) :: ru
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2,1:N) :: rv
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2,1:N) :: P
      real, dimension(Istr-2:Iend+2,0:N) :: dR
      real, dimension(Istr-2:Iend+2,0:N) :: dZ
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: FC
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: dZx
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: rx
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: dRx
      

        call Sub_Loop_prsgrd_tile(Istr,Iend,Jstr,Jend,ru,rv,P,dR,dZ,FC,d
     &Zx,rx,dRx, Agrif_tabvars_i(14)%iarray0, Agrif_tabvars_i(4)%iarray0
     &, Agrif_tabvars_i(13)%iarray0, Agrif_tabvars_i(2)%iarray0, Agrif_t
     &abvars(111)%array2, Agrif_tabvars(91)%array2, Agrif_tabvars(112)%a
     &rray2, Agrif_tabvars(157)%array3, Agrif_tabvars(92)%array2, Agrif_
     &tabvars(225)%array2, Agrif_tabvars(153)%array3, Agrif_tabvars(152)
     &%array3, Agrif_tabvars(154)%array3, Agrif_tabvars(160)%array3, Agr
     &if_tabvars(156)%array3, Agrif_tabvars_r(12)%array0, Agrif_tabvars_
     &l(13)%larray0, Agrif_tabvars_i(8)%iarray0, Agrif_tabvars_l(14)%lar
     &ray0, Agrif_tabvars_l(11)%larray0, Agrif_tabvars_i(7)%iarray0, Agr
     &if_tabvars_l(12)%larray0)

      end


      subroutine Sub_Loop_prsgrd_tile(Istr,Iend,Jstr,Jend,ru,rv,P,dR,dZ,
     &FC,dZx,rx,dRx,padd_E,Mm,padd_X,Lm,om_v,vmask,on_u,Hz,umask,Ptide,r
     &ho,qp1,rho1,z_w,z_r,rho0,NORTH_INTER,Mmmpi,SOUTH_INTER,EAST_INTER,
     &Lmmpi,WEST_INTER)

      use Agrif_Types, only : Agrif_tabvars

      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 :: OneFifth = 0.2D0
      real, parameter :: OneTwelfth = 1.D0/12.D0
      real, parameter :: epsil = 0.D0
      real, parameter :: qp2 = 0.0000172D0
      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) :: padd_E
      integer(4) :: Mm
      integer(4) :: padd_X
      integer(4) :: Lm
      real :: rho0
      logical :: NORTH_INTER
      integer(4) :: Mmmpi
      logical :: SOUTH_INTER
      logical :: EAST_INTER
      integer(4) :: Lmmpi
      logical :: WEST_INTER
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: om_v
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: vmask
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: on_u
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: Hz
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: umask
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E) :: Ptide
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: rho
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: qp1
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: rho1
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,0:N) :: z_w
      real, dimension(-1:Lm+2+padd_X,-1:Mm+2+padd_E,1:N) :: z_r
      integer(4) :: Istr
      integer(4) :: Iend
      integer(4) :: Jstr
      integer(4) :: Jend
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2,1:N) :: ru
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2,1:N) :: rv
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2,1:N) :: P
      real, dimension(Istr-2:Iend+2,0:N) :: dR
      real, dimension(Istr-2:Iend+2,0:N) :: dZ
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: FC
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: dZx
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: rx
      real, dimension(Istr-2:Iend+2,Jstr-2:Jend+2) :: dRx

                   

                                                                
      integer(4) :: i
      integer(4) :: j
      integer(4) :: k
      integer(4) :: imin
      integer(4) :: imax
      integer(4) :: jmin
      integer(4) :: jmax
                                            
                             
                                            

                                                             
                     
                        

                                                            
                                           
                                                               
                                    
                                      
                                                          

                       

                                    

                        
                              

                       
                          

                                                
                                             
                          

                        

                                 

                                                
                        

                                                              
                      
                              

                                       
                                                                     
                                          
                         

                             

                             

                            

                            

                                             

                            

                                     

                                                               

                         

                                                      
                                                      
                                                                  
                               

                               

                              

                              

                               

                              

                              

                                

                             

                                                                       
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                                 
                                                             
      real :: dpth
      real :: cff1
      real :: cff2
      real :: cff
      real :: GRho
      real :: cfr
      real :: HalfGRho
                                                                   

                                            
                                               
                                            
                                               
                                                                 
                                                 
                                 
                                               
                                               
                                               
                                               
                                               
                                               
                                             
                                             
                                             
                                             
                                             
                                               
                                               
                                               
                                               
                                               
                                               
                                               
                                               
                                               
                                               
                                               
                                               
                                              
                                                  
                                                  
                                                  
                                                  
                                                 
                                                 
                                               
                                               
                                                      
                                                 
                                                 
                                                 
                                                 
                                                 
                                                 
                                                 
                                                           
                                                           
                                                           
                                    
                                                
                                                
                                                
                                                
                                                 
                           
                           
                           
                           
                             
                                              
                          
                                                
                                                
                                                   
                                              
                                               
                                                   
                                                
                                                  
                                                 
                                                 
                                                              
                             
                                                 
                                                  
                                                 
                                                
                                             
                                                
                            
               
                                 

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

                                                                       
                                                                 
                  
                                                                       
                                                                 
                                                                 
                                                                 
                  

                          

              
                             

                  
                               

                 
                                

                       
                                   

                           
                                     
                                                          
                                       
                                                            
                                           
                                                           
                                         
                                                           
                                         
                                                           
                                         
                                                           
                                         
                                                          
                                       
                                                            
                                           
                                                
                                 
                                        
      integer(4) :: IstrR
      integer(4) :: IendR
      integer(4) :: JstrR
      integer(4) :: JendR
                      
      integer(4) :: IstrU
                      
      integer(4) :: JstrV
      if ((istr.eq.1 .and. .not.WEST_INTER)) then
        IstrR=Istr-1
        IstrU=Istr+1
      else
        IstrR=Istr
        IstrU=Istr
      endif
      if ((iend.eq.Lmmpi .and. .not.EAST_INTER)) then
        IendR=Iend+1
      else
        IendR=Iend
      endif
      if ((jstr.eq.1.and. .not.SOUTH_INTER)) then
        JstrR=Jstr-1
        JstrV=Jstr+1
      else
        JstrR=Jstr
        JstrV=Jstr
      endif
      if ((jend.eq.Mmmpi .and. .not.NORTH_INTER)) then
        JendR=Jend+1
      else
        JendR=Jend
      endif
      GRho=g/rho0
      HalfGRho=0.5D0*GRho
!$acc kernels if(compute_on_device) default(present)
      do j=JstrV-1,Jend
        do k=1,N-1
          do i=IstrU-1,Iend
            dZ(i,k)=z_r(i,j,k+1)-z_r(i,j,k)
            dpth=z_w(i,j,N)-0.5D0*(z_r(i,j,k+1)+z_r(i,j,k))
            dR(i,k)=rho1(i,j,k+1)-rho1(i,j,k)
     &              +(qp1(i,j,k+1)-qp1(i,j,k))
     &                     *dpth*(1.D0-qp2*dpth)
          enddo
        enddo
        do i=IstrU-1,Iend
          dR(i,N)=dR(i,N-1)
          dR(i,0)=dR(i,1)
          dZ(i,N)=dZ(i,N-1)
          dZ(i,0)=dZ(i,1)
        enddo
        do k=N,1,-1
          do i=IstrU-1,Iend
            cff=2.D0*dZ(i,k)*dZ(i,k-1)
            dZ(i,k)=cff/(dZ(i,k)+dZ(i,k-1))
            cfr=2.D0*dR(i,k)*dR(i,k-1)
            if (cfr.gt.epsil) then
              dR(i,k)=cfr/(dR(i,k)+dR(i,k-1))
            else
              dR(i,k)=0.D0
            endif
            dpth=z_w(i,j,N)-z_r(i,j,k)
            dR(i,k)=dR(i,k)  -qp1(i,j,k)*dZ(i,k)*(1.D0-2.D0*qp2*dpth)
          enddo
        enddo
        do i=IstrU-1,Iend
          P(i,j,N)=g*z_w(i,j,N) + GRho*( rho(i,j,N)
     &            +0.5D0*(rho(i,j,N)-rho(i,j,N-1))*(z_w(i,j,N)-z_r(i,j,
     &                                                               N))
     &              /(z_r(i,j,N)-z_r(i,j,N-1)) )*(z_w(i,j,N)-z_r(i,j,N))
          P(i,j,N) = P(i,j,N) - g*Ptide(i,j)
        enddo
        do k=N-1,1,-1
          do i=IstrU-1,Iend
            P(i,j,k)=HalfGRho*( (rho(i,j,k+1)+rho(i,j,k))
     &                                    *(z_r(i,j,k+1)-z_r(i,j,k))
     &     -OneFifth*( (dR(i,k+1)-dR(i,k))*( z_r(i,j,k+1)-z_r(i,j,k)
     &                             -OneTwelfth*(dZ(i,k+1)+dZ(i,k)) )
     &                -(dZ(i,k+1)-dZ(i,k))*( rho(i,j,k+1)-rho(i,j,k)
     &                             -OneTwelfth*(dR(i,k+1)+dR(i,k)) )
     &                                                            ))
          enddo
        enddo
        enddo
        do k=N-1,1,-1
          do j=JstrV-1,Jend
            do i=IstrU-1,Iend
              P(i,j,k)=P(i,j,k)+P(i,j,k+1)
            enddo
          enddo
        enddo
      if ((istr.eq.1 .and. .not.WEST_INTER)) then
        imin=IstrU
      else
        imin=IstrU-1
      endif
      if ((iend.eq.Lmmpi .and. .not.EAST_INTER)) then
        imax=Iend
      else
        imax=Iend+1
      endif
        if ((jstr.eq.1.and. .not.SOUTH_INTER)) then
          jmin=JstrV
        else
          jmin=JstrV-1
        endif
        if ((jend.eq.Mmmpi .and. .not.NORTH_INTER)) then
          jmax=Jend
        else
          jmax=Jend+1
        endif
!$acc loop seq
      do k=N,1,-1
        do j=Jstr,Jend
          do i=imin,imax
            FC(i,j)=(z_r(i,j,k)-z_r(i-1,j,k))
     &                              *umask(i,j)
            dpth=0.5D0*( z_w(i,j,N)+z_w(i-1,j,N)
     &                -z_r(i,j,k)-z_r(i-1,j,k))
            rx(i,j)=( rho1(i,j,k)-rho1(i-1,j,k)
     &                +(qp1(i,j,k)-qp1(i-1,j,k))
     &                     *dpth*(1.D0-qp2*dpth) )
     &                              *umask(i,j)
          enddo
        enddo
        if ((istr.eq.1 .and. .not.WEST_INTER)) then
          do j=Jstr,Jend
            FC(imin-1,j)=FC(imin,j)
            rx(imin-1,j)=rx(imin,j)
          enddo
        endif
        if ((iend.eq.Lmmpi .and. .not.EAST_INTER)) then
          do j=Jstr,Jend
            FC(imax+1,j)=FC(imax,j)
            rx(imax+1,j)=rx(imax,j)
          enddo
        endif
        do j=Jstr,Jend
          do i=IstrU-1,Iend
            cff=2.D0*FC(i,j)*FC(i+1,j)
            if (cff.gt.epsil) then
              dZx(i,j)=cff/(FC(i,j)+FC(i+1,j))
            else
              dZx(i,j)=0.D0
            endif
            cfr=2.D0*rx(i,j)*rx(i+1,j)
            if (cfr.gt.epsil) then
              dRx(i,j)=cfr/(rx(i,j)+rx(i+1,j))
            else
              dRx(i,j)=0.D0
            endif
            dRx(i,j)=dRx(i,j) -qp1(i,j,k)*dZx(i,j)
     &         *(1.D0-2.D0*qp2*(z_w(i,j,N)-z_r(i,j,k)))
          enddo
        enddo
        do j=Jstr,Jend
          do i=IstrU,Iend
            ru(i,j,k)=0.5D0*(Hz(i,j,k)+Hz(i-1,j,k))*on_u(i,j)*(
     &                                             P(i-1,j,k)-P(i,j,k)
     &                           -HalfGRho*( (rho(i,j,k)+rho(i-1,j,k))
     &                                      *(z_r(i,j,k)-z_r(i-1,j,k))
     &     -OneFifth*( (dRx(i,j)-dRx(i-1,j))*( z_r(i,j,k)-z_r(i-1,j,k)
     &                             -OneTwelfth*(dZx(i,j)+dZx(i-1,j)) )
     &                -(dZx(i,j)-dZx(i-1,j))*( rho(i,j,k)-rho(i-1,j,k)
     &                             -OneTwelfth*(dRx(i,j)+dRx(i-1,j)) )
     &                                                             ))
     &    )
          enddo
        enddo
        do j=jmin,jmax
          do i=Istr,Iend
            FC(i,j)=(z_r(i,j,k)-z_r(i,j-1,k))
     &                              *vmask(i,j)
            dpth=0.5D0*( z_w(i,j,N)+z_w(i,j-1,N)
     &                -z_r(i,j,k)-z_r(i,j-1,k))
            rx(i,j)=( rho1(i,j,k)-rho1(i,j-1,k)
     &                +(qp1(i,j,k)-qp1(i,j-1,k))
     &                     *dpth*(1.D0-qp2*dpth) )
     &                              *vmask(i,j)
          enddo
        enddo
        if ((jstr.eq.1.and. .not.SOUTH_INTER)) then
          do i=Istr,Iend
            FC(i,jmin-1)=FC(i,jmin)
            rx(i,jmin-1)=rx(i,jmin)
          enddo
        endif
        if ((jend.eq.Mmmpi .and. .not.NORTH_INTER)) then
          do i=Istr,Iend
            FC(i,jmax+1)=FC(i,jmax)
            rx(i,jmax+1)=rx(i,jmax)
          enddo
        endif
        do j=JstrV-1,Jend
          do i=Istr,Iend
            cff=2.D0*FC(i,j)*FC(i,j+1)
            if (cff.gt.epsil) then
              dZx(i,j)=cff/(FC(i,j)+FC(i,j+1))
            else
              dZx(i,j)=0.D0
            endif
            cfr=2.D0*rx(i,j)*rx(i,j+1)
            if (cfr.gt.epsil) then
              dRx(i,j)=cfr/(rx(i,j)+rx(i,j+1))
            else
              dRx(i,j)=0.D0
            endif
            dRx(i,j)=dRx(i,j) -qp1(i,j,k)*dZx(i,j)
     &         *(1.D0-2.D0*qp2*(z_w(i,j,N)-z_r(i,j,k)))
          enddo
        enddo
        do j=JstrV,Jend
          do i=Istr,Iend
            rv(i,j,k)=0.5D0*(Hz(i,j,k)+Hz(i,j-1,k))*om_v(i,j)*(
     &                                             P(i,j-1,k)-P(i,j,k)
     &                           -HalfGRho*( (rho(i,j,k)+rho(i,j-1,k))
     &                                      *(z_r(i,j,k)-z_r(i,j-1,k))
     &     -OneFifth*( (dRx(i,j)-dRx(i,j-1))*( z_r(i,j,k)-z_r(i,j-1,k)
     &                             -OneTwelfth*(dZx(i,j)+dZx(i,j-1)) )
     &                -(dZx(i,j)-dZx(i,j-1))*( rho(i,j,k)-rho(i,j-1,k)
     &                             -OneTwelfth*(dRx(i,j)+dRx(i,j-1)) )
     &                                                             ))
     &                                                               )
          enddo
        enddo
      enddo
!$acc end kernels
      return
       
      

      end subroutine Sub_Loop_prsgrd_tile

