source: trunk/LMDZ.GENERIC/libf/phystd/gradients_kcm.F90 @ 486

subroutine gradients_kcm(profil_flag,rho_v,rho_n,T,dTdp,dPvdp,dPndp)

  use params_h
  use gases_h
  implicit none

  ! inputs
  integer profil_flag ! 0 = dry, 1 = moist, 2 = isothermal
  double precision rho_v,rho_n,T

  ! outputs
  double precision dTdp,dPndp,dPvdp
  double precision a_v

  ! internal
  double precision cp_n,cp_v

  double precision press, rho_plus, rho_minus, dVdT, rho_c
  double precision dlnr,dlna,dpsat,dsv
  double precision s_minus,s_plus
  double precision s_v,s_c,L
  double precision psat_plus,psat_minus,Pn
  double precision nul

  ! functions
  double precision cp_neutral

  cp_n = cp_neutral(T)


  select case(profil_flag)
  case(2) ! isothermal

     dTdp  = 0.
     a_v   = rho_v/rho_n ! constant here
     dPndp = 1/(1d0+m_n/m_v*a_v)
     dPvdp = 1 - dPndp

  case(1) ! moist

     Pn = rho_n*T*rmn

     if(ngasmx.eq.1)then
        print*,'Cannot have moist adiabat with one gas...'
        stop
     endif

     if(gnom(ngasmx).eq.'H2O')then

        call psat_H2O(T-2d-1,psat_minus)
        call psat_H2O(T+2d-1,psat_plus)
        call psat_H2O(T,press)

        rho_minus = m_v*psat_minus*1d6/(Rc*(T-2d-1))
        rho_plus  = m_v*psat_plus*1d6/(Rc*(T+2d-1))

        call therm(T-2d-1,rho_minus*1d-3,nul,nul,nul,nul,nul,nul,nul,&
                   nul,nul,press,s_minus,nul)
        call therm(T+2d-1,rho_plus*1d-3,nul,nul,nul,nul,nul,nul,nul,&
                   nul,nul,press,s_plus,nul)
        s_c = 2.06 * log(T/273.15)

        s_plus  = s_plus  * 1d3
        s_minus = s_minus * 1d3
        s_c     = s_c     * 1d3 ! convert to SI

        if(T.lt.280.0)then 
           dpsat = press*1d6 * ( 1730.63*log(10.) / (T-39.714)**2 )
        else
           call tdpsdt(T,dpsat)
           dpsat = dpsat * 1d6 / T
        endif

     elseif(gnom(ngasmx).eq.'NH3')then

        call psat_NH3(T-2d-1,psat_minus)
        call psat_NH3(T+2d-1,psat_plus)
        call psat_NH3(T,press)

        rho_minus = m_v*psat_minus*1d6/(Rc*(T-2d-1))
        rho_plus  = m_v*psat_plus*1d6/(Rc*(T+2d-1))

        call latheat_NH3(T-2d-1,nul,s_minus)
        call latheat_NH3(T+2d-1,nul,s_plus)
        call latheat_NH3(T,s_c,nul)

        dpsat = press*1d6 * (-2*1.5609d-4*T + 0.1236)

     endif

     dsv  = (s_plus-s_minus)/4d-1  ! dsv*T = ds / d ln[T]
     s_v  = (s_plus+s_minus)/2d0
     dlnr = T/rho_v * (rho_plus-rho_minus)/4d-1  ! d ln[rho_v] / d ln[T]

     if(rho_n/rho_v.lt.1e-5)then
        dlna = -T*dsv/(s_v-s_c)
     else
        a_v  = rho_v/rho_n
        dlna = (rmn*dlnr - cp_n + rmn - a_v*T*dsv)/(a_v*(s_v-s_c)+rmn)  
        ! d ln[alpha_v] / d ln[T]
        ! note cp_n + rmn = cv_n, which is what's required
     endif

     dTdp  = 1d0 / (dpsat + rho_n*rmn*(1d0 + dlnr - dlna)) ! c.f. Marcq S2.2.2
     dPvdp = dTdp * dpsat
     dPndp = 1d0 - dPvdp ! from p = p_v + p_n

  case(0) ! dry

     cp_v=0.0
     if(gnom(ngasmx).eq.'H2O')then
        cp_v = (32.24+1.923d-3*T+1.055d-5*T**2-3.511d-9*T**3)/m_v
     elseif(gnom(ngasmx).eq.'NH3')then
        cp_v = 2.058d3
     elseif(gnom(ngasmx).eq.'CH4')then
        cp_v = 2.226d3
     endif

     dTdp  = 1/(rho_n*cp_n+rho_v*cp_v)
     dPndp = 1/(1d0+m_n/m_v*rho_v/rho_n)
     dPvdp = 1/(1d0+m_v/m_n*rho_n/rho_v)
      
  end select


end subroutine gradients_kcm