












      subroutine set_scoord
      


      use Agrif_Util
      interface
        subroutine Sub_Loop_set_scoord(hmax,hmin,mynode,Cs_w,sc_w,sc_r,t
     &heta_b,theta_s,Cs_r,Tcline,hc)
          implicit none
      integer(4), parameter :: LLm0 = 41
      integer(4), parameter :: MMm0 = 42
      integer(4), parameter :: N = 32
      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 :: stdout = 6
      integer(4), parameter :: Np = N+1
      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.
      real :: hmax
      real :: hmin
      integer(4) :: mynode
      real :: theta_b
      real :: theta_s
      real :: Tcline
      real :: hc
      real, dimension(0:N) :: Cs_w
      real, dimension(0:N) :: sc_w
      real, dimension(1:N) :: sc_r
      real, dimension(1:N) :: Cs_r
        end subroutine Sub_Loop_set_scoord

      end interface
      

        call Sub_Loop_set_scoord( Agrif_tabvars_r(36)%array0, Agrif_tabv
     &ars_r(35)%array0, Agrif_tabvars_i(176)%iarray0, Agrif_tabvars(2)%a
     &rray1, Agrif_tabvars(1)%array1, Agrif_tabvars(3)%array1, Agrif_tab
     &vars_r(24)%array0, Agrif_tabvars_r(23)%array0, Agrif_tabvars(4)%ar
     &ray1, Agrif_tabvars_r(25)%array0, Agrif_tabvars_r(26)%array0)

      end


      subroutine Sub_Loop_set_scoord(hmax,hmin,mynode,Cs_w,sc_w,sc_r,the
     &ta_b,theta_s,Cs_r,Tcline,hc)

      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 :: 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 :: stdout = 6
      integer(4), parameter :: Np = N+1
      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.
      real :: hmax
      real :: hmin
      integer(4) :: mynode
      real :: theta_b
      real :: theta_s
      real :: Tcline
      real :: hc
      real, dimension(0:N) :: Cs_w
      real, dimension(0:N) :: sc_w
      real, dimension(1:N) :: sc_r
      real, dimension(1:N) :: Cs_r
                   

                                            
                             
                                            

                                                             
                                                            
                                           
                                                               
                                    
                                      
                                                          

                       

                                    

                        
                              

                                          
                                             
                          

                        

                                          
                        

                                                        
                      
                              

                                       
                                                                     
                                          
                         

                             

                             

                            

                            

                                             

                            

                                     

                                                               

                         

                                                      
                                                      
                                                                  
                               

                               

                              

                              

                               

                              

                              

                                

                             

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

                                                                       
                                                                 
                  
                                                                       
                                                                 
                                                                 
                                                                 
                  

                          

              
                             

                  
                               

                 
                                

                       
                                   

                  
      integer(4) :: k
                                           
      real :: cff
      real :: cff1
      real :: cff2
      real :: cff3
      real :: ds
      real :: sc
      real :: csf
      hc= Tcline
      ds=1.D0/float(N)
      do k=1,N,+1
        sc     = ds*(float(k-N)-0.5D0)
        Cs_r(k)=CSF(sc, theta_s,theta_b)
        sc_r(k)=sc
      enddo
      sc_w(0) = -1.0D0
      sc_w(N) =  0.D0
      Cs_w(0) = -1.0D0
      Cs_w(N) =  0.D0
      do k=1,N-1,+1
        sc     = ds*float(k-N)
        Cs_w(k)=CSF(sc, theta_s,theta_b)
        sc_w(k)=sc
      enddo
      if (mynode.eq.0) write(stdout,'(/1x,A/,/1x,A,10x,A/)')
     &                       'Vertical S-coordinate System:',
     &                       'level   S-coord     Cs-curve',
     &                       'at_hmin  over_slope     at_hmax'
      do k=N,0,-1
        sc=ds*(k-N)
        cff1 = hmin*(hc*sc + hmin*Cs_w(k))/(hc+hmin)
        cff2 = 0.5D0*hmax*(hc*sc + 0.5D0*hmax*Cs_w(k))/(hc+0.5D0*hmax)
        cff3 = hmax*(hc*sc + hmax*Cs_w(k))/(hc+hmax)
        if (mynode.eq.0) write(stdout,'(I6,2F12.7,4x,3F12.3)')
     &                     k, sc_w(k),Cs_w(k), cff1,cff2,cff3
      enddo
      return
       
      

      end subroutine Sub_Loop_set_scoord

      function CSF (sc, theta_s,theta_b)

      use Agrif_Types, only : Agrif_tabvars

      implicit none

      real :: sc
      real :: theta_s
      real :: theta_b
      real :: CSF
                   

                                         
      real :: csrf
      if (theta_s.gt.0.D0) then
        csrf=(1.D0-cosh(theta_s*sc))/(cosh(theta_s)-1.D0)
      else
        csrf=-sc**2
      endif
      if (theta_b.gt.0.D0) then
        CSF=(exp(theta_b*csrf)-1.D0)/(1.D0-exp(-theta_b))
      else
        CSF=csrf
      endif
      return
      end
