! Original code by P.J. Ross 2001-2007  See: Ross, P.J. (2003)
!     Modeling soil water and solute transport - fast, simplified numerical solutions. Agron. J. 95:1352-1361.
!
! Modified by V. Haverd 2008: matrix expanded by factor of 2 to allow solution of coupled heat/moisture fluxes
! Explicit calculation of heat/moisture fluxes at surface
! Switchable option for litter
! Isotope subroutine (V. Haverd and M. Cuntz, September 2008)
!
! Frozen Soil (V. Haverd, M. Cuntz Sep 2010 - Jan 2011)
! Pond lumped with top soil layer (V. Haverd Jan 2011)
! Snow included in layers -2:0 (V. Haverd Jan 2011)
! Convergence test for dthetaldT (V.Haverd Feb 2011)
! Include heat advection by liquid water flux (V.Haverd Feb 2011)

! Code cleaned and isotope routine updated (V. Haverd, M. Cuntz Aug-Sep 2012)
! lots of changes, especially relating to ponding and freezing together
! Outstanding problems with surface runoff and advection (set h0max large and turn off advection for now)
!
! Sep 17 2012 (V.Haverd)
! remove separate solution for maxpond (h0 > h0max)
! Instead, convert excess pond to runoff at t=tfin, and correct energy stores for loss of pond
! Advection and surface runoff now functioning
!
! Dec 31 2012 (V.Haverd)
! bug fixes to improve energy conservation associated with change in ice,
! especially correction at time of pond disappearance (removal of negative pond)
!
! Jan 5 2013 (V.Haverd)
! Remove iteration over frozen soil within "(while iok==0)" loop
! For frozen soil, at the time of updating variables, evaluate new T and ice content,
! consistent with J0 + deltaJ, where deltaJ is the change in energy obtained from the matrix solution (=LHS_h*dt)
!
! Jan 7-8 2013 (V.Haverd)
! Calls to soil_snow albedo and density
! Improve iteration convergence at time of updating new T and ice content in frozen soil
! Bug fix relating to moisture conservation in snow
!
! Jan 14-15 2013 (V. Haverd)
! Modified definition of Sliq for frozen soil (in hyofS): now defined relative to (theta_sat - theta_r - theta_ice)
! Allow for snow-pack initalisation in the absence of pond
!
! Feb 7 2013 (V.Haverd)
! Revised formulation of dphidT for frozen soil (see hyofS): fixes a few remaining -ve T spikes in frozen soil
!
! Feb 9 2013 (V.Haverd)
! Moved snow layer adjustments to subroutine
!
! Feb 24 2013 (V. Haverd)
! Snow structure expanded to accommodate 3 layers
!
! March 30 (V. Haverd)
!
! Jan 7 2014 (V. Haverd)
! Adjust snow surface bcs such that snow surface temperature can't be more than 0
!
! Jan 8 2014 (V Haverd)
! enable 2nd snow layer so that if snowpack exceeds 3 cm , the excess goes into the layer below.
!
! March 2014 (V. Haverd)
! Extract SEB calcs to subroutine in utils, and trial Force-Restore method
!
! October 2016 (S Wales)
! Restructured code of solve into several subroutines

MODULE sli_solve

  USE cable_def_types_mod, ONLY: r_2, i_d
  USE sli_numbers,         ONLY: &
       experiment, &
       zero, one, two, half, thousand, e3, e5, &  ! numbers
       Tzero, rlambda, lambdaf, lambdas, Dva, rhocp, rhow, gf, hmin, & ! parameters
       csice , cswat, &
       snmin, nsnow_max, fsnowliq_max, &
       params, vars_aquifer, vars_met, vars, vars_snow, solve_type, & ! types
       dSfac, h0min, Smax, h0max, dSmax, dSmaxr, dtmax, dSmax, dSmaxr, & ! numerical limits
       dtmax, dtmin, dTsoilmax, dTLmax, nsteps_ice_max, nsteps_max,tol_dthetaldT, &
       hbot, botbc, &
       Mw, Rgas, & ! boundary condition
       freezefac
  USE sli_utils,           ONLY: &
       x, Sofh, hyofh, hyofS, litter_props, massman_sparse, tri, &
       aquifer_props, Tfrz, thetalmax, Tthetalmax, dthetalmaxdTh, &
       getfluxes_vp, getheatfluxes, flux, sol, &
       csat, slope_csat, potential_evap, tri, setsol, zerovars, &
       esat_ice, slope_esat_ice, Tfrozen, rtbis_Tfrozen, GTFrozen, &
       JSoilLayer, esat, forcerestore, SEB
  USE cable_IO_vars_module, ONLY: logn

  IMPLICIT NONE

  PRIVATE

  PUBLIC :: solve ! solution routine

  INTEGER(i_d), DIMENSION(:), ALLOCATABLE :: nless, n_noconverge ! global counters

  ! Definitions of public entities and private parameters (see above for default
  ! values):
  ! botbc    - bottom boundary condn for water; "constant head", "free drainage",
  !    "seepage", or "zero flux". Constant head means that matric head h
  !    is specified. Free drainage means zero gradient of matric head,
  !    i.e. unit hydraulic gradient. Seepage means zero flux when the
  !    matric head is below zero and an upper limit of zero for the head.
  ! h0max    - max pond depth allowed before runoff.
  ! hbot    - matric head at bottom of profile when botbc set to "constant head".
  ! dSmax    - max change in S (the "effective saturation") of any unsaturated
  !    layer to aim for each time step; controls time step size.
  ! dSmaxr   - maximum negative relative change in S each time step. This
  !    parameter helps avoid very small or negative S.
  ! dtmax    - max time step allowed.
  ! dsmmax   - max solute change per time step (see dSmax); user should set this
  !    according to solute units used. Units for different solutes can be
  !    scaled by the user (e.g. to an expected max of around 1.0).
  ! dSfac    - a change in S of up to dSfac*dSmax is accepted.
  ! dpmaxr   - relative change in matric flux potential (MFP) phi that is
  !    accepted for convergence when finding head h at soil interfaces.
  ! h0min    - min (negative) value for surface pond when it empties.
  ! Smax    - max value for layer saturation to allow some overshoot.
  ! solve    - sub to call to solve RE
  !

CONTAINS

  SUBROUTINE get_fluxes_and_derivs( &
       irec, mp, qprec, qprec_snow, n, dx, h0, &
       Tsoil, S, &
       qh, vmet, vlit, vsnow, var, T0, Tsurface, &
       dxL, SL, Tl, &
       plit, par, &
       qali, &
       qvh, &
       qevap, &
       again, getq0,getqn,init, ns, nsat, &
       nsatlast, &
       phip, qpme, hint, phimin, &
       qexd, &
       q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb, qadv, qadvya, qadvyb, &
       qadvTa, qadvTb, vtmp, qliq, qv, qvT, qlya, qlyb, &
       qvya, qvyb, qlTb, qvTa, qvTb, &
       vtop, vbot, &
       lE0, G0, &
       Epot, surface_case, &
       iflux, litter, j, kk, &
       advection, dTqwdTa, dTqwdTb, Tqw, keff, &
       hice &
       )
    IMPLICIT NONE
    INTEGER(i_d)                                           :: irec, mp
    REAL(r_2),      DIMENSION(1:mp)                        :: qprec
    REAL(r_2),      DIMENSION(1:mp)                        :: qprec_snow
    INTEGER(i_d)                                           :: n
    REAL(r_2),      DIMENSION(1:n) :: dx
    REAL(r_2),      DIMENSION(1:mp)                        :: h0
    REAL(r_2),      DIMENSION(1:n) :: Tsoil, S
    REAL(r_2),      DIMENSION(-nsnow_max:n) :: qh
    TYPE(vars_met), DIMENSION(1:mp)                        :: vmet
    TYPE(vars),     DIMENSION(1:mp)                        :: vlit
    TYPE(vars_snow), DIMENSION(1:mp)                       :: vsnow
    TYPE(vars),     DIMENSION(1:n) :: var
    REAL(r_2),      DIMENSION(1:mp)                        :: T0, Tsurface
    REAL(r_2),      DIMENSION(1:mp)                        :: dxL
    REAL(r_2),      DIMENSION(1:mp)                        :: SL, Tl
    TYPE(params),   DIMENSION(1:mp)                        :: plit
    TYPE(params),   DIMENSION(1:n) :: par
    REAL(r_2),      DIMENSION(1:mp), OPTIONAL                        :: qali
    REAL(r_2),      DIMENSION(-nsnow_max:n) :: qvh
    REAL(r_2),    DIMENSION(1:mp)                          :: qevap
    LOGICAL,      DIMENSION(1:mp)                          :: again, getq0,getqn,init
    INTEGER(i_d), DIMENSION(1:mp)                          :: ns, nsat, nsatlast
    REAL(r_2),    DIMENSION(1:mp)                          :: phip
    REAL(r_2),    DIMENSION(1:mp)                          :: qpme
    REAL(r_2),    DIMENSION(1:n) :: hint, phimin, qexd
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qadv, qadvya, qadvyb, qadvTa, qadvTb
    TYPE(vars)                                             :: vtmp
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qliq, qv, qvT, qlya, qlyb, qvya, qvyb, qlTb, qvTa, qvTb
    TYPE(vars),         DIMENSION(1:mp)                    :: vtop, vbot
    REAL(r_2),          DIMENSION(1:mp)                    :: lE0, G0, Epot
    INTEGER(i_d),       DIMENSION(1:mp)                    :: surface_case
    INTEGER(i_d),       DIMENSION(1:mp)                    :: iflux
    LOGICAL                                                :: litter
    INTEGER(i_d)                                           :: j, kk
    INTEGER(i_d)                                           :: advection ! switches
    REAL(r_2)                                              :: dTqwdTa, dTqwdTb, Tqw, keff
    REAL(r_2),          DIMENSION(1:mp)                    :: hice


    !----- get fluxes and derivs
    ! get surface condition
    ! ns==1 if no pond or full pond, i.e. do not solve for change in pond height
    ! ns==0 then change for pond height
    IF ((var(1)%phi <= phip(kk) .AND. h0(kk) <= zero .AND. nsat(kk) < n) .OR. &
         (var(1)%isat==0)) THEN ! no ponding
       ns(kk)    = 1 ! start index for eqns
    ELSE ! ponding
       ns(kk)    = 0
       var(1)%phi = (one+e5)*var(1)%phie+(h0(kk)-hice(kk))*var(1)%Ksat
       TL(kk)    = vmet(kk)%Ta ! initialise pond T
       vtop(kk)%isat    = 1
       vtop(kk)%h       = h0(kk)
       vtop(kk)%phi     = MAX((var(1)%phie -var(1)%he*var(1)%Ksat), &
            (one+e5)*var(1)%phie)+(h0(kk)-hice(kk))*var(1)%Ksat
       vtop(kk)%K       = var(1)%Ksat
       vtop(kk)%rh      = one
       vtop(kk)%lambdav = rlambda
       vtop(kk)%lambdaf = lambdaf
       ! var(1)%phi = var(1)%phie
       ! calculates phi1,eff (pond + top soil layer)   !vh! does this get used???
       CALL flux(par(1), vtop(kk), var(1), half*dx(1), &
            q(0), qya(0), qyb(0), qTa(0), qTb(0))


    ENDIF

    IF (Sl(kk) >= one) THEN
       vlit(kk)%isat = 1
       vlit(kk)%h    = plit(kk)%he
    ENDIF

    ! get bottom boundary condn
    IF (botbc=="seepage") THEN
       vtmp = zerovars()
       vbot = SPREAD(vtmp,1,mp)
       IF (var(n)%h > -half*gf*dx(n)) THEN
          getqn(kk) = .TRUE.
          vbot(kk)%isat    = 1
          vbot(kk)%phi     = (zero-var(n)%he)*var(n)%Ksat+var(n)%phie ! (special for frozen soil)
          vbot(kk)%K       = var(n)%Ksat
          vbot(kk)%rh      = one
          vbot(kk)%lambdav = rlambda
          vbot(kk)%lambdaf = lambdaf
       ELSE
          getqn(kk) = .FALSE.
       ENDIF
    END IF

    ! Fluxes and derivatives at the air/surface interface
    IF (vsnow(kk)%nsnow > 0) THEN
       surface_case(kk) = 2
    ELSE
       surface_case(kk) = 1
    ENDIF
    SELECT CASE (surface_case(kk))
    CASE (1) ! no snow
       CALL SEB(n, par(:), vmet(kk), vsnow(kk), var(:), qprec(kk), qprec_snow(kk), dx(:), &
            h0(kk), Tsoil(:), &
            Tsurface(kk), G0(kk), lE0(kk),Epot(kk),  &
            q(0), qevap(kk), qliq(0), qv(0), &
            qyb(0), qTb(0), qlyb(0), qvyb(0), qlTb(0), qvTb(0), qh(0), &
            qadv(0), qhyb(0), qhTb(0), qadvyb(0), qadvTb(0), irec)
       qya(0)    = zero
       qTa(0)    = zero
       qlya(0)   = zero
       qvya(0)   = zero
       qvTa(0)   = zero
       qhya(0)   = zero
       qhTa(0)   = zero
       qadvya(0) = zero
       qadvTa(0) = zero

    CASE (2) ! snow
       CALL SEB(n, par(:), vmet(kk), vsnow(kk), var(:), qprec(kk), qprec_snow(kk), dx(:), &
            h0(kk), Tsoil(:), &
            Tsurface(kk), G0(kk), lE0(kk), Epot(kk),  &
            q(-vsnow(kk)%nsnow), qevap(kk), qliq(-vsnow(kk)%nsnow), qv(-vsnow(kk)%nsnow), &
            qyb(-vsnow(kk)%nsnow), qTb(-vsnow(kk)%nsnow), qlyb(-vsnow(kk)%nsnow), &
            qvyb(-vsnow(kk)%nsnow), qlTb(-vsnow(kk)%nsnow), qvTb(-vsnow(kk)%nsnow), &
            qh(-vsnow(kk)%nsnow), qadv(-vsnow(kk)%nsnow), qhyb(-vsnow(kk)%nsnow), &
            qhTb(-vsnow(kk)%nsnow), qadvyb(-vsnow(kk)%nsnow), qadvTb(-vsnow(kk)%nsnow), irec)
       qya(-vsnow(kk)%nsnow)    = zero
       qTa(-vsnow(kk)%nsnow)    = zero
       qlya(-vsnow(kk)%nsnow)   = zero
       qvya(-vsnow(kk)%nsnow)   = zero
       qvTa(-vsnow(kk)%nsnow)   = zero
       qhya(-vsnow(kk)%nsnow)   = zero
       qhTa(-vsnow(kk)%nsnow)   = zero
       qadvya(-vsnow(kk)%nsnow) = zero
       qadvTa(-vsnow(kk)%nsnow) = zero

    CASE default
       WRITE(*,*) "solve: illegal surface case."
       STOP 2
    END SELECT ! surface_case
    qpme(kk) = q(0) ! water flux into top of soil column
    ! finished all the surfaces

    ! get moisture fluxes and derivatives (at time t=0, i.e. q0 etc.)

    CALL getfluxes_vp(n, dx(1:n), vtop(kk), vbot(kk), par(1:n), var(1:n), & ! moisture fluxes
         hint(1:n), phimin(1:n), q(0:n), qya(0:n), qyb(0:n), qTa(0:n), qTb(0:n), &
         qliq(0:n), qlya(0:n), qlyb(0:n), qv(0:n), qvT(0:n), qvh(0:n), qvya(0:n), &
         qvyb(0:n), &
         iflux(kk), init(kk), getq0(kk), getqn(kk), Tsoil(1:n), T0(kk), nsat(kk), nsatlast(kk))
    qTa(n) = zero
    qTb(n) = zero
    qvTa(1:n) = qTa(1:n)
    qvTb(1:n) = qTb(1:n)
    qlTb(1:n) = zero


    ! get  fluxes heat and derivatives (at time t=0, i.e. q0 etc.)
    CALL getheatfluxes(n, dx(1:n), dxL(kk), &
         qh(0:n), qhya(0:n), qhyb(0:n), qhTa(0:n), qhTb(0:n), &
         var(1:n), vlit(kk), Tsoil(1:n), TL(kk), litter, &
         q(0:n), qya(0:n), qyb(0:n), qTa(0:n), qTb(0:n), &
         qadv(0:n),qadvya(0:n), qadvyb(0:n), qadvTa(0:n), qadvTb(0:n), &
         advection) ! heat fluxes

    ! get heat and vapour fluxes and derivatives in snow-pack
    IF (vsnow(kk)%nsnow>1) THEN
       ! vapour flux at interfaces between snow layers
       DO j=1, vsnow(kk)%nsnow-1
          keff = 2_r_2*((vsnow(kk)%kE(j)/(thousand*lambdaf))*(vsnow(kk)%kE(j+1)/(thousand*lambdaf))/ &
               ((vsnow(kk)%kE(j)/(thousand*lambdaf))*vsnow(kk)%depth(j+1)+(vsnow(kk)%kE(j+1)/ &
               (thousand*lambdaf))*vsnow(kk)%depth(j)) )
          q(j-vsnow(kk)%nsnow) = keff*(vsnow(kk)%tsn(j)-vsnow(kk)%tsn(j+1))
          qTa(j-vsnow(kk)%nsnow) = MERGE(keff,zero,vsnow(kk)%hliq(j)<=zero)
          qTb(j-vsnow(kk)%nsnow) = MERGE(-keff,zero,vsnow(kk)%hliq(j+1)<=zero)
          qya(j-vsnow(kk)%nsnow) = zero
          qyb(j-vsnow(kk)%nsnow) = zero
          ! conductive heat flux at interface between snow layers
          keff = 2_r_2*(vsnow(kk)%kth(j+1)*vsnow(kk)%kth(j))/ &
               (vsnow(kk)%kth(j+1)*vsnow(kk)%depth(j)+vsnow(kk)%kth(j)*vsnow(kk)%depth(j+1))  ! check this!
          qh(j-vsnow(kk)%nsnow) = keff*(vsnow(kk)%tsn(j)-vsnow(kk)%tsn(j+1))
          qhTa(j-vsnow(kk)%nsnow) = MERGE(zero,keff,vsnow(kk)%hliq(j)>zero)
          qhTb(j-vsnow(kk)%nsnow) = MERGE(zero,-keff,vsnow(kk)%hliq(j+1)>zero)

          ! advective heat flux at interface between snow layers
          Tqw  = MERGE(vsnow(kk)%tsn(j), vsnow(kk)%tsn(j+1), q(j-vsnow(kk)%nsnow)>zero)
          dTqwdTb = MERGE(zero,one, q(j-vsnow(kk)%nsnow)>zero)
          dTqwdTa = MERGE(one,zero, q(j-vsnow(kk)%nsnow)>zero)
          IF (vsnow(kk)%hliq(j)>zero) THEN
             qadv(j-vsnow(kk)%nsnow) = rhow*q(j-vsnow(kk)%nsnow)*cswat*Tqw
             qadvTa(j-vsnow(kk)%nsnow) = zero
          ELSE
             qadv(j-vsnow(kk)%nsnow) = rhow*q(j-vsnow(kk)%nsnow)*cswat*Tqw
             qadvTa(j-vsnow(kk)%nsnow) = rhow*cswat*q(j-vsnow(kk)%nsnow)*dTqwdTa  + &
                  rhow*cswat*Tqw*qTa(j-vsnow(kk)%nsnow)
          ENDIF
          qadvTb(0) = rhow*cswat*q(j-vsnow(kk)%nsnow)*dTqwdTb + rhow*cswat*Tqw*qTb(j-vsnow(kk)%nsnow)

          qh(j-vsnow(kk)%nsnow) = qh(j-vsnow(kk)%nsnow) + qadv(j-vsnow(kk)%nsnow)
          qhTa(j-vsnow(kk)%nsnow) = qhTa(j-vsnow(kk)%nsnow) +  qadvTa(j-vsnow(kk)%nsnow)
          qhTb(j-vsnow(kk)%nsnow) = qhTb(j-vsnow(kk)%nsnow) +  qadvTb(j-vsnow(kk)%nsnow)
       ENDDO
    ENDIF ! end fluxes at snow/snow interfaces

    IF (vsnow(kk)%nsnow.GE.1) THEN
       ! vapour flux at soil/snow interface
       IF (var(1)%isat==1) THEN
          keff = vsnow(kk)%kE(vsnow(kk)%nsnow)/(thousand*lambdaf)/vsnow(kk)%depth(vsnow(kk)%nsnow)/2_r_2
       ENDIF
       IF (var(1)%isat==0) THEN
          keff = 2_r_2*((vsnow(kk)%kE(vsnow(kk)%nsnow)/(thousand*lambdaf))*(var(1)%kE/thousand/var(1)%lambdav))/ &
               ((vsnow(kk)%kE(vsnow(kk)%nsnow)/(thousand*lambdaf))*dx(1)+(var(1)%kE/thousand/var(1)%lambdav)* &
               vsnow(kk)%depth(vsnow(kk)%nsnow))
       ENDIF
       q(0) = keff*(vsnow(kk)%tsn(vsnow(kk)%nsnow)-Tsoil(1))
       qTa(0) = keff
       qTb(0) =-keff

       qya(0) = zero
       qyb(0) = zero
       qv(0)   = q(0)
       qvyb(0) = qyb(0)
       qvTb(0) = qTb(0)
       qvya(0) = qya(0)
       qvTa(0) = qTa(0)
       qliq(0) = zero
       qlyb(0) = zero
       qlTb(0) = zero
       qlya(0) = zero
       qya(0) = zero;

       IF (vsnow(kk)%hliq(vsnow(kk)%nsnow)>zero) THEN
          qhTa(0) = zero
          qTa(0) = zero
       ENDIF

       ! conductive heat flux at snow/soil interface  ! check this!
       keff = 2._r_2*(vsnow(kk)%kth(vsnow(kk)%nsnow)*var(1)%kth)/ &
            (vsnow(kk)%kth(vsnow(kk)%nsnow)*dx(1)+var(1)%kth*vsnow(kk)%depth(vsnow(kk)%nsnow))
       qh(0) = keff*(vsnow(kk)%tsn(vsnow(kk)%nsnow)-Tsoil(1))
       IF (vsnow(kk)%hliq(1)>zero) THEN
          qhTa(0) = zero
       ELSE
          qhTa(0) = keff
       ENDIF
       qhTb(0) = -keff

       ! advective heat flux at snow/soil interface
       Tqw  = MERGE(vsnow(kk)%tsn(vsnow(kk)%nsnow), Tsoil(1), q(0)>zero)
       dTqwdTb = MERGE(zero,one, q(0)>zero)
       dTqwdTa = MERGE(one,zero, q(0)>zero)
       IF (vsnow(kk)%hliq(vsnow(kk)%nsnow)>zero) THEN
          qadv(0) = rhow*q(0)*cswat*Tqw
          qadvTa(0) = zero
       ELSE
          qadv(0) = rhow*q(0)*cswat*Tqw
          qadvTa(0) = rhow*cswat*q(0)*dTqwdTa  +  rhow*cswat*Tqw*qTa(0)
       ENDIF
       qadvTb(0) = rhow*cswat*q(0)*dTqwdTb + rhow*cswat*Tqw*qTb(0)
    ENDIF ! end of heat and vapour fluxes at soil/snow interface

    IF (ns(kk)==0) THEN ! pond included in top soil layer
       ! change qya(1) from dq/dphi (returned by getfluxes) to dq/dh
       qya(1) = var(1)%Ksat*qya(1)
       IF (advection==1) THEN
          qhya(1) = qhya(1) - qadvya(1)
          Tqw  = MERGE(Tsoil(1), Tsoil(2), q(1)>zero)
          qadvya(1) =  rhow*cswat*qya(1)*Tqw  ! apply corrected qya(1) to qadvya(1)
          qhya(1) = qhya(1) + qadvya(1)
       ENDIF
    ENDIF

    ! adjust for bottom boundary condition
    IF (botbc=="zero flux") THEN
       qliq(n) = zero
       qv(n)   = zero
       q(n)    = zero
       qya(n)  = zero
       qlya(n) = zero
       qvya(n) = zero
    ENDIF

    ! specify mositure flux at bottom of soil column (heat flux set to zero)
    IF (botbc /= "constant head") THEN
       SELECT CASE (botbc)
       CASE ("zero flux")
          q(n)   = zero
          qya(n) = zero
       CASE ("free drainage")
          q(n) = gf*var(n)%K
          IF (var(n)%isat == 0) THEN
             qya(n) = gf*var(n)%KS
          ELSE
             qya(n) = zero
          END IF
       CASE ("seepage")
          IF (var(n)%h <= -half*gf*dx(n)) THEN
             q(n)   = zero
             qya(n) = zero
          END IF
       CASE default
          WRITE(*,*) "solve: illegal bottom boundary condition."
          STOP 2
       END SELECT
    END IF
    IF (PRESENT(qali)) THEN
       IF (qali(kk)>zero) THEN
          q(n)   = -qali(kk)
          qya(n) = zero
       END IF
    ENDIF
    IF (experiment==7 .OR. experiment==8) THEN
       q(n)   = q(0)
       qya(n) = zero
    ENDIF
    IF (experiment==8) qh(n) = G0(kk)

    ! adjust lower heat flux for advection
    IF (advection==1) THEN
       qadv(n) = rhow*cswat*(Tsoil(n))*q(n)
       qadvya(n) = rhow*cswat*(Tsoil(n))*qya(n)
       qadvTa(n)= rhow*cswat*q(n)
       qh(n) = qh(n) + qadv(n)
       qhya(n) = qhya(n) + qadvya(n)
       qhTa(n) = qhTa(n) + qadvTa(n)
    ELSE
       qadv(:)   = zero
       qadvya(:) = zero
       qadvyb(:) = zero
       qadvTa(:) = zero
       qadvTb(:) = zero
    ENDIF

    qexd(1:n) = zero ! time derivative for root extraction (assumed fixed at input value)
    again(kk)  = .FALSE. ! flag for recalcn of fluxes (default=false)
    !----- end get fluxes and derivs
  END SUBROUTINE get_fluxes_and_derivs

  SUBROUTINE estimate_timestep( &
       irec, tfin, mp, n, dx, h0, &
       qh, qhTa, qadvTa, qhTb, qadvTb, &
       nsteps, vlit, vsnow, var, &
       dxL, &
       plit, par, &
       deltaTa, &
       qL, qhL, &
       again, ns, nsat, &
       nsatlast, nsteps0, dmax, dt, &
       qpme, t, &
       q, qadv, &
       tmp2d1, tmp2d2, &
       tmp1d1, tmp1d3, &
       iflux, litter, kk, &
       advection, &
       iqex &
       )
    IMPLICIT NONE
    REAL(r_2)                                              :: tfin
    INTEGER(i_d)                                           :: mp, irec
    INTEGER(i_d)                                           :: n
    REAL(r_2),      DIMENSION(1:n) :: dx
    REAL(r_2),      DIMENSION(1:mp)                        :: h0
    REAL(r_2),      DIMENSION(-nsnow_max:n) :: qh
    INTEGER(i_d),   DIMENSION(1:mp)                        :: nsteps
    TYPE(vars),     DIMENSION(1:mp)                        :: vlit
    TYPE(vars_snow), DIMENSION(1:mp)                       :: vsnow
    TYPE(vars),     DIMENSION(1:n) :: var
    REAL(r_2),      DIMENSION(1:mp)                        :: dxL
    TYPE(params),   DIMENSION(1:mp)                        :: plit
    TYPE(params),   DIMENSION(1:n) :: par
    REAL(r_2),      DIMENSION(1:mp)                        :: deltaTa
    REAL(r_2),    DIMENSION(1:mp)                          :: qL, qhL
    LOGICAL,      DIMENSION(1:mp)                          :: again
    INTEGER(i_d), DIMENSION(1:mp)                          :: ns, nsat, nsatlast, nsteps0
    REAL(r_2),    DIMENSION(1:mp)                          :: dmax, dt
    REAL(r_2),    DIMENSION(1:mp)                          :: qpme, t
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: q, qhTa, qhTb
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qadv, qadvTa, qadvTb
    REAL(r_2),    DIMENSION(0:n) :: tmp2d1, tmp2d2,  deltaTmax
    REAL(r_2),          DIMENSION(1:mp)                    :: tmp1d1, tmp1d3
    INTEGER(i_d),       DIMENSION(1:mp)                    :: iflux
    LOGICAL                                                :: litter
    INTEGER(i_d)                                           :: kk
    INTEGER(i_d)                                           :: advection ! switches
    REAL(r_2),          DIMENSION(1:n) :: iqex


    !----- first estimate of time step dt before the calculation
    !      gets revised after the calculation
    dmax(kk)  = zero
    tmp2d1(:) = zero ! 1st order estim of rate of change of moisture storage
    tmp2d2(:) = zero ! 1st order estim of rate of change of temperature
    ! estimate rate of change of moisture storage [m/s]
    WHERE (var(1:n)%isat==0.AND.var(1:n)%iice==0.) tmp2d1(1:n) = &
         ABS(q(1:n)-q(0:n-1)-iqex(1:n))/(par(1:n)%thre*dx(1:n))
    WHERE (var(1:n)%iice==1)  tmp2d1(1:n) =  tmp2d1(1:n)/2._r_2
    ! estimate rate of change of temperature [K/s]
    tmp2d2(1:n) = ABS(qh(1:n)-qh(0:n-1))/(var(1:n)%csoileff*dx(1:n))
    IF (advection==1) THEN
       ! first order estimate of rate of temperature change
       tmp2d2(1:n) = ABS((qh(1:n)-qadv(1:n))-(qh(0:n-1)-qadv(0:n-1)))/(var(1:n)%csoileff*dx(1:n))
       deltaTmax(1:n) = tmp2d2(1:n)*(tfin-t(kk)) ! maximum  T change
    ENDIF
    IF (litter .AND. ns(kk)==1 ) THEN ! litter , no pond
       IF (vlit(kk)%isat==0) THEN ! estimate rate of change of moisture storage [m/s]
          WRITE(*,*) 'Should not be here - QL 01 ', qL(kk)
          tmp2d1(0) = ABS(q(0) - qL(kk))/(plit(kk)%thre*dxL(kk))
       ENDIF
       WRITE(*,*) 'Should not be here - QHL 01 ', qhL(kk)
       tmp2d2(0)  = ABS(qh(0) - qhL(kk))/(vlit(kk)%csoileff*dxL(kk)) ! estimate rate of change of heat storage [K/s]
       tmp1d3(kk) = (dTLmax-ABS(deltaTa(kk))) / tmp2d2(0)
    ELSE
       tmp2d1(0)  = zero
       tmp2d2(0)  = zero
       tmp1d3(kk) = dtmax
    ENDIF

    dmax(kk)   = MAXVAL(tmp2d1(1:n),1) ! max derivative |dS/dt|
    tmp1d1(kk) = MAXVAL(tmp2d2(1:n),1) ! max derivative |dTsoil/dt|
    IF (dmax(kk) > zero) THEN
       dt(kk) = MIN(dSmax/dmax(kk), dTLmax/tmp1d1(kk), tmp1d3(kk)) ! constrained either by moisture or temp
    ELSE ! steady state flow
       IF (qpme(kk)>=q(n)) THEN ! if saturated soil columnn and more precip then drainige -> finish
          dt(kk) = tfin-t(kk) ! step to finish
       ELSE ! otherwise adjust dt because change of pond height
          dt(kk) = -(h0(kk)-half*h0min)/(qpme(kk)-q(n))
       END IF
       dt(kk) = MIN(dt(kk), dTLmax/tmp1d1(kk), tmp1d3(kk)) ! constrained by  temp
    END IF

    ! check that time step is short enough to prevent melting a top snow layer
    IF (vsnow(kk)%nsnow.GT.0 ) THEN
       ! energy required to melt ice in snow-pack
       tmp1d1(kk) = -rhow*(vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*(csice*vsnow(kk)%tsn(1) - lambdaf)
       IF (qh(-vsnow(kk)%nsnow)*dt(kk).GT.tmp1d1(kk)) THEN
          dt(kk) = 0.9_r_2*tmp1d1(kk)/qh(-vsnow(kk)%nsnow)
       ENDIF
    ENDIF

    IF (dt(kk)>dtmax) dt(kk) = dtmax ! user's limit

    ! if initial step, improve phi where S>=1
    ! might be that you get better derivatives, especially at sat/non-sat interfaces
    IF (nsteps(kk)==nsteps0(kk) .AND. nsat(kk)>0 .AND. iflux(kk)==1) THEN
       again(kk) = .TRUE.
       dt(kk)    = dtmin
    END IF
    ! if fully saturated but was not fully saturated before, adjust even within each time step iteration
    IF (nsat(kk)==n .AND. nsatlast(kk)<n .AND. iflux(kk)==1) THEN
       again(kk) = .TRUE. ! profile has just become saturated so adjust phi values
       dt(kk)    = dtmin
    END IF
    ! sprint to the end
    IF (t(kk)+1.1_r_2*dt(kk)>tfin) THEN ! step to finish
       dt(kk) = tfin-t(kk)
       t(kk)  = tfin
    ELSE
       t(kk) = t(kk)+dt(kk) ! tentative update
       IF (again(kk)) t(kk) = t(kk)-dt(kk)
    END IF

    !----- end estimate time step dt


  END SUBROUTINE estimate_timestep

  SUBROUTINE iflux_loop( &
       tfin, irec, mp, qprec, qprec_snow, n, dx, h0, S, thetai, &
       Jsensible, Tsoil, evap, infil, drainage, discharge, &
       qh, nsteps, vmet, vlit, vsnow, var, T0, Tsurface, Hcum, lEcum, &
       Gcum, Qadvcum, Jcol_sensible, &
       Jcol_latent_S, Jcol_latent_T, csoil, kth, phi, dxL, zdelta, SL, Tl, &
       plit, par, wex, ciso_snow, cisoice_snow, &
       qali, &
       qvsig, qlsig, qvTsig, qvh, deltaTa, &
       precip, qevap, qL, qhL, qybL, qTbL, qhTbL, qhybL, rexcol, wcol, &
       again, getq0,getqn,init, again_ice, ih0, iok, itmp, ns, nsat, &
       nsatlast, nsteps0, accel, dmax, dt, dwinfil, dwoff, fac, &
       phip, qpme, rsig, rsigdt, sig, t, hint, phimin, &
       qexd, aa, bb, cc, dd, ee, ff, gg, dy, aah, bbh, cch, ddh, eeh, ffh, ggh, &
       de, q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb, qadv, qadvya, qadvyb, &
       qadvTa, qadvTb, vtmp, qsig, qhsig, qadvsig, qliq, qv, qvT, qlya, qlyb, &
       qvya, qvyb, qlTb, qvTa, qvTb, deltaS, dTsoil, tmp2d1, tmp2d2, &
       cv0, &
       cisoliqice_snow, &
       dthetaldT, thetal, isave, nsteps_ice, imelt, vtop, vbot, v_aquifer, &
       dwcol, dwdrainage, drn,inlit, dwinlit, drexcol, dwdischarge, &
       dJcol_latent_S, dJcol_latent_T, dJcol_sensible, deltaJ_latent_S, &
       deltaJ_latent_T, deltaJ_sensible_S, deltaJ_sensible_T, qevapsig, &
       qrunoff, tmp1d1, tmp1d2, tmp1d3,  tmp1d4, deltah0, deltaSL, &
       lE0, G0, &
       Epot, Tfreezing, dtdT, LHS, RHS, LHS_h, RHS_h, surface_case, nns, &
       iflux, litter, i, j, k, kk, condition, littercase, isotopologue, &
       advection, c2, theta, dTqwdTa, dTqwdTb, Tqw, keff, cp, &
       cpeff, hice, h0_0, hice_0, h0_tmp, hice_tmp, qmelt, &
       qtransfer, delta_snowcol, delta_snowT, &
       delta_snowliq, thetai_0, J0, tmp1, tmp2, iqex, &
       nfac1, nfac2, nfac3, nfac4, nfac5, nfac6, nfac7, nfac8, nfac9, &
       nfac10, nfac11, nfac12, J0snow, wcol0snow, h_ex, wpi, err &
       )
    IMPLICIT NONE
    REAL(r_2)                                              :: tfin
    INTEGER(i_d)                                           :: irec, mp
    REAL(r_2),      DIMENSION(1:mp)                        :: qprec
    REAL(r_2),      DIMENSION(1:mp)                        :: qprec_snow
    INTEGER(i_d)                                           :: n
    REAL(r_2),      DIMENSION(1:n) :: dx
    REAL(r_2),      DIMENSION(1:mp)                        :: h0
    REAL(r_2),      DIMENSION(1:n) :: S
    REAL(r_2),      DIMENSION(1:n) :: thetai
    REAL(r_2),      DIMENSION(1:n) :: Jsensible
    REAL(r_2),      DIMENSION(1:n) :: Tsoil
    REAL(r_2),      DIMENSION(1:mp)                        :: evap
    REAL(r_2),      DIMENSION(1:mp)                        :: infil
    REAL(r_2),      DIMENSION(1:mp)                        :: drainage, discharge
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max:n)           :: qh
    INTEGER(i_d),   DIMENSION(1:mp)                        :: nsteps
    TYPE(vars_met), DIMENSION(1:mp)                        :: vmet
    TYPE(vars),     DIMENSION(1:mp)                        :: vlit
    TYPE(vars_snow), DIMENSION(1:mp)                       :: vsnow
    TYPE(vars),     DIMENSION(1:n) :: var
    REAL(r_2),      DIMENSION(1:mp)                        :: T0, Tsurface
    REAL(r_2),      DIMENSION(1:mp)                        :: Hcum, lEcum
    REAL(r_2),      DIMENSION(1:mp)                        :: Gcum, Qadvcum
    REAL(r_2),      DIMENSION(1:mp)                        :: Jcol_sensible, Jcol_latent_S, Jcol_latent_T
    REAL(r_2),      DIMENSION(1:n) :: csoil, kth
    REAL(r_2),      DIMENSION(1:n) :: phi
    REAL(r_2),      DIMENSION(1:mp)                        :: dxL
    REAL(r_2),      DIMENSION(1:mp)                        :: zdelta, SL, Tl
    TYPE(params),   DIMENSION(1:mp)                        :: plit
    TYPE(params),   DIMENSION(1:n) :: par
    REAL(r_2),      DIMENSION(1:mp,1:n), OPTIONAL                    :: wex
    REAL(r_2),      DIMENSION(1:mp,1:nsnow_max)            :: ciso_snow
    REAL(r_2),      DIMENSION(1:mp,1:nsnow_max)            :: cisoice_snow
    REAL(r_2),      DIMENSION(1:mp), OPTIONAL                        :: qali
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max:n)           :: qvsig, qlsig, qvTsig, qvh
    REAL(r_2),      DIMENSION(1:mp)                        :: deltaTa
    REAL(r_2),    DIMENSION(1:mp)                          :: precip, qevap
    REAL(r_2),    DIMENSION(1:mp)                          :: qL, qhL, qybL, qTbL, qhTbL, qhybL, rexcol, wcol
    LOGICAL,      DIMENSION(1:mp)                          :: again, getq0,getqn,init
    LOGICAL,      DIMENSION(1:mp,1:n)                      :: again_ice
    INTEGER(i_d), DIMENSION(1:mp)                          :: ih0, iok, itmp, ns, nsat, nsatlast, nsteps0
    REAL(r_2),    DIMENSION(1:mp)                          :: accel, dmax, dt, dwinfil, dwoff, fac, phip
    REAL(r_2),    DIMENSION(1:mp)                          :: qpme, rsig, rsigdt, sig, t
    REAL(r_2),    DIMENSION(1:n) :: hint, phimin, qexd
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: aa, bb, cc, dd, ee, ff, gg, dy
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: aah, bbh, cch, ddh, eeh, ffh, ggh, de
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qadv, qadvya, qadvyb, qadvTa, qadvTb
    TYPE(vars)                                             :: vtmp
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qsig, qhsig, qadvsig
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qliq, qv, qvT, qlya, qlyb, qvya, qvyb, qlTb, qvTa, qvTb
    REAL(r_2),    DIMENSION(1:n) :: deltaS, dTsoil
    REAL(r_2),    DIMENSION(0:n) :: tmp2d1, tmp2d2
    REAL(r_2),    DIMENSION(1:n) :: cv0
    REAL(r_2),      DIMENSION(1:nsnow_max) :: cisoliqice_snow
    REAL(r_2),    DIMENSION(1:n) :: dthetaldT, thetal
    INTEGER(i_d), DIMENSION(1:n) :: isave, nsteps_ice, imelt
    TYPE(vars),         DIMENSION(1:mp)                    :: vtop, vbot
    TYPE(vars_aquifer), DIMENSION(1:mp)                    :: v_aquifer
    REAL(r_2),          DIMENSION(1:mp)                    :: dwcol, dwdrainage, drn,inlit, dwinlit, drexcol, dwdischarge
    REAL(r_2),          DIMENSION(1:mp)                    :: dJcol_latent_S, dJcol_latent_T, dJcol_sensible
    REAL(r_2),          DIMENSION(1:n) :: deltaJ_latent_S, deltaJ_latent_T, deltaJ_sensible_S, deltaJ_sensible_T
    REAL(r_2),          DIMENSION(1:mp)                    :: qevapsig
    REAL(r_2),          DIMENSION(1:mp)                    :: qrunoff
    REAL(r_2),          DIMENSION(1:mp)                    :: tmp1d1, tmp1d2, tmp1d3,  tmp1d4
    REAL(r_2),          DIMENSION(1:mp)                    :: deltah0
    REAL(r_2),          DIMENSION(1:mp)                    :: deltaSL
    REAL(r_2),          DIMENSION(1:mp)                    :: lE0, G0, Epot
    REAL(r_2),          DIMENSION(1:mp)                    :: Tfreezing
    REAL(r_2),          DIMENSION(1:mp)                    :: dtdT
    REAL(r_2),          DIMENSION(-nsnow_max+1:n) :: LHS, RHS, LHS_h, RHS_h
    INTEGER(i_d),       DIMENSION(1:mp)                    :: surface_case
    INTEGER(i_d),       DIMENSION(1:mp)                    :: nns, iflux
    LOGICAL                                                :: litter
    INTEGER(i_d)                                           :: i, j, k, kk, condition
    INTEGER(i_d)                                           :: littercase, isotopologue, advection ! switches
    REAL(r_2)                                              :: c2, theta
    REAL(r_2)                                              :: dTqwdTa, dTqwdTb, Tqw, keff
    REAL(r_2),          DIMENSION(1:mp)                    :: cp, cpeff, hice, h0_0, hice_0, h0_tmp, hice_tmp
    REAL(r_2),          DIMENSION(nsnow_max)          :: qmelt, hsnow
    REAL(r_2),  DIMENSION(1:mp)                            :: qtransfer
    REAL(r_2),          DIMENSION(nsnow_max) :: delta_snowcol, delta_snowT, delta_snowliq
    REAL(r_2),      DIMENSION(1:n) :: thetai_0, J0
    REAL(r_2)                                              :: tmp1, tmp2
    REAL(r_2),          DIMENSION(1:n) :: iqex
    INTEGER(i_d),       DIMENSION(1:mp)                    :: nfac1, nfac2, nfac3, nfac4, nfac5, &
         nfac6, nfac7, nfac8, nfac9, nfac10, nfac11, nfac12
    REAL(r_2),          DIMENSION(1:mp)                    :: J0snow, wcol0snow
    REAL(r_2), DIMENSION(1:n)                              :: h_ex
    REAL(r_2)                                              :: wpi
    ! Error flag if nstep of SLI > nsteps_max: err=0 -> no error; err/=0 -> error
    INTEGER(i_d),        INTENT(INOUT), OPTIONAL           :: err

    hsnow(:) = zero

    DO WHILE (again(kk)) ! sometimes need twice to adjust phi at satn

       nsatlast(kk) = nsat(kk) ! for detecting onset of profile saturation
       nsat(kk)     = SUM(var(:)%isat,1) ! no. of sat layers
       sig(kk)      = half
       IF (nsat(kk) /= 0) sig(kk) = one ! time weighting sigma
       rsig(kk)     = one/sig(kk)

       ! update variables
       IF (iflux(kk)==1) THEN
          ! Calc flux matric potentials (and derivatives) from S
          ! this set var-structure
          isave(:) = var(:)%isat
          ! Debug for mp=1: remove elemental from hyofS and do loop instead of next line
          CALL hyofS(S(1:n), Tsoil(1:n), par(1:n), var(1:n))
          !do i=1, n
          !   call hyofS(S(i), Tsoil(i), par(i), var(i))
          !end do

          ! End debug hyofS
          cp(kk) = REAL(1-var(1)%iice,r_2)*cswat*rhow & ! heat capacity of pond
               + REAL(var(1)%iice,r_2)*rhow* &
               ((one-var(1)%thetai/par(1)%thre)*cswat + (var(1)%thetai/par(1)%thre)*csice)
          cpeff(kk) = cp(kk) + rhow*lambdaf*var(1)%dthetaldT/par(1)%thre
          ! phip(kk) = max(var(1)%phie-var(1)%he*var(1)%Ksat, (one+e5)*var(1)%phie) !at onset of ponding
          phip(kk) = (one+e5)*var(1)%phie !at onset of ponding
          var(:)%isat  = isave(:)
          thetai(:)    = var(:)%thetai ! ice profile
          thetal(:)    = var(:)%thetal ! liq water profile
          thetai_0(:)  = thetai(:) ! initial ice profile
          dthetaldT(:) = var(:)%dthetaldT
          hice(kk)   = h0(kk)*var(1)%thetai/par(1)%thre
          hice_0(kk) = hice(kk)
          h0_0(kk)   = h0(kk)
          ! sensible heat stored in top layer + pond
          Jsensible(1)   = (var(1)%csoil* dx(1)+h0(kk)*cp(kk))*(Tsoil(1))
          ! sensible heat stored in soil column (2:n)
          Jsensible(2:n) = var(2:n)%csoil*(Tsoil(2:n))* dx(2:n)


          ! calculate this here in case snow pack disappears: ciso of transferred water needs to be retained
          IF ((isotopologue /= 0).AND.(vsnow(kk)%hsnow(1).GT.zero)) THEN
             cisoliqice_snow(1:nsnow_max) = (ciso_snow(kk,1:nsnow_max)*vsnow(kk)%hliq(1:nsnow_max) + &
                  cisoice_snow(kk,1:nsnow_max)*(vsnow(kk)%hsnow(1:nsnow_max)-vsnow(kk)%hliq(1:nsnow_max))) / &
                  vsnow(kk)%hsnow(1:nsnow_max)

          ENDIF

          CALL snow_adjust(irec, mp, n, kk, ns, h0, hice, thetai(:), dx(:), vsnow, var, par, S(:), Tsoil(:), &
               Jcol_latent_S, Jcol_latent_T, Jcol_sensible, deltaJ_sensible_S(:), qmelt(:), qtransfer, j0snow)
          thetai(1) = var(1)%thetai  ! this is the value of thetaice prior to matrix call

          CALL hyofS(S(1), Tsoil(1), par(1), var(1))

       ENDIF ! iflux==1

       ! initialise litter vars
       IF (iflux(kk)==1 .AND. (littercase==1 .OR. littercase == 2)) THEN
          ! call litter_props(Sl(kk), Tl(kk), vlit(kk), plit(kk), h0(kk))
          CALL litter_props(Sl(kk), Tsoil(1), vlit(kk), plit(kk), h0(kk))
       ENDIF

       ! ! phi is solution var at satn, so h calc from phi where S>=1 - done in hyofS above for S<1
       ! where (S(:) >= one) & ! (special for frozen soil)
       !      var(:)%h = var(:)%he + (var(:)%phi-var(:)%phie)/var(:)%Ksat


       CALL get_fluxes_and_derivs( &
            irec, mp, qprec, qprec_snow, n, dx(:), h0, &
            Tsoil(:), S(:), &
            qh(kk,:), vmet, vlit, vsnow, var, T0, Tsurface, &
            dxL, SL, Tl, &
            plit, par, &
            qali, &
            qvh(kk,:), &
            qevap, &
            again, getq0,getqn,init, ns, nsat, &
            nsatlast, &
            phip, qpme, hint(:), phimin(:), &
            qexd(:), &
            q(:), qya(:), qyb(:), qTa(:), qTb(:),qhya(:), qhyb(:), qhTa(:), qhTb(:), qadv(:), qadvya(:), qadvyb(:), &
            qadvTa(:), qadvTb(:), vtmp, qliq(:), qv(:), qvT(:), qlya(:), qlyb(:), &
            qvya(:), qvyb(:), qlTb(:), qvTa(:), qvTb(:), &
            vtop, vbot, &
            lE0, G0, &
            Epot, surface_case, &
            iflux, litter, j, kk, &
            advection, dTqwdTa, dTqwdTb, Tqw, keff, &
            hice &
            )


       CALL estimate_timestep( &
            irec, tfin, mp, n, dx(:), h0, &
            qh(kk,:), qhTa(:), qadvTa(:), qhTb(:), qadvTb(:), &
            nsteps, vlit, vsnow, var, &
            dxL, &
            plit, par, &
            deltaTa, &
            qL, qhL, &
            again, ns, nsat, &
            nsatlast, nsteps0, dmax, dt, &
            qpme, t, &
            q(:), qadv(:), &
            tmp2d1(:), tmp2d2(:), &
            tmp1d1, tmp1d3, &
            iflux, litter, kk, &
            advection, &
            iqex(:) &
            )

       !----- get and solve eqns
       rsigdt(kk) = one/(sig(kk)*dt(kk))
       IF (.NOT. again(kk))  THEN
          dwoff(kk)   = MAX(h0(kk)*(one-var(1)%thetai/par(1)%thre)-h0max,zero)
          qrunoff(kk) = dwoff(kk)/dt(kk)
       ELSE
          qrunoff(kk) = zero
       ENDIF

       ! aa, bb, cc and dd hold coeffs and rhs of linear equation eqn set
       CALL get_and_solve_eqn( &
            irec, mp, qprec,  n, dx(:), h0, S(:), thetai(:), &
            Tsoil(:),       &
            qh(kk,:), nsteps,  vlit, vsnow, var,     &
            dxL,    &
            plit, par,        &
            deltaTa, &
            qevap, qL, qhL, qybL, qTbL, qhTbL, qhybL,    &
            again,  again_ice,  iok, itmp, ns,  &
            accel,  dt,   fac,   &
            phip,  rsig, rsigdt, sig, t,      &
            qexd(:), aa(:), bb(:), cc(:), dd(:), ee(:), ff(:), gg(:), dy(:), &
            aah(:), bbh(:), cch(:), ddh(:), eeh(:), ffh(:), ggh(:), &
            de(:), q(:), qya(:), qyb(:), qTa(:), qTb(:),qhya(:), qhyb(:), qhTa(:), qhTb(:), qadv(:), qadvya(:), qadvyb(:), &
            qadvTa(:), qadvTb(:),  qsig(:), qhsig(:), qadvsig(:),      &
            dTsoil(:), tmp2d1(:),   &
            dthetaldT(:),   nsteps_ice, imelt,     &
            deltaJ_latent_T(:), deltaJ_sensible_S(:),   &
            qrunoff, tmp1d1, tmp1d2, tmp1d3,  tmp1d4,     &
            G0, &
            Tfreezing,   LHS(:), RHS(:), LHS_h(:), RHS_h(:),  nns, &
            iflux, litter, i,   kk, condition,   &
            advection,  c2, theta,     cp, &
            cpeff, hice,    h0_tmp,   hsnow(:), &
            delta_snowT(:), &
            delta_snowliq(:),    J0(:),   iqex(:),  &
            nfac1, nfac2, nfac3, nfac4, nfac5, nfac6, nfac7, nfac8, nfac9, &
            nfac10, nfac11, nfac12, err     &
            )
       IF (err /= 0) RETURN

       CALL update_unknowns( &
            irec, mp, qprec, qprec_snow, n, dx(:), h0, S(:),  &
            Tsoil(:), evap,   infil, drainage, discharge, &
            qh(kk,:), nsteps, vmet, vlit, vsnow, var,   Hcum, lEcum, &
            Gcum, Qadvcum,  &
            csoil(:), kth(:), phi(:),  zdelta, SL, Tl, &
            par,  wex,      &
            qvsig(kk,:), qlsig(kk,:), qvTsig(kk,:),   &
            precip, qevap,       rexcol, wcol,  &
            again,   ih0,   ns,  &
            dt, dwinfil, dwoff,    &
            sig,       &
            qexd(:),        dy(:),        &
            de(:), q(:), qya(:), qyb(:), qTa(:), qTb(:),qhya(:), qhyb(:), qhTa(:), qhTb(:),    &
            qsig(:), qhsig(:), qadvsig(:), qliq(:), qv(:), qvT(:),  qlyb(:), &
            qvya(:), qvyb(:), qlTb(:), qvTa(:), qvTb(:),   dTsoil(:),    &
            v_aquifer,  &
            dwcol, dwdrainage, drn,inlit, dwinlit, drexcol, dwdischarge, &
            dJcol_latent_S, dJcol_latent_T, dJcol_sensible, deltaJ_latent_S(:), &
            deltaJ_latent_T(:), deltaJ_sensible_S(:), deltaJ_sensible_T(:), qevapsig, &
            qrunoff, tmp1d1, tmp1d2, tmp1d3,   deltah0,  deltaSL,  &
            LHS_h(:),  surface_case,  &
            litter, i, j,  kk,    &
            advection,    theta,   Tqw,  cp, &
            hsnow(:), &
            delta_snowcol(:), delta_snowT(:), &
            delta_snowliq(:),    J0(:),   iqex(:),  &
            J0snow, wcol0snow   &
            )

       CALL update_s_t( &
            mp,   n, dx(:), h0, S(:), thetai(:), &
            Tsoil(:),    infil,   &
            nsteps,    var,     &
            par,        &
            qlsig(kk,:),    &
            again,   ih0,   ns,  &
            dt,      &
            sig,       &
            dy(:),        &
            qhsig(:),       &
            deltaS(:), dTsoil(:),    &
            dJcol_latent_S, dJcol_latent_T, dJcol_sensible, deltaJ_latent_S(:), &
            deltaJ_latent_T(:), deltaJ_sensible_S(:), deltaJ_sensible_T(:),  &
            qrunoff, tmp1d1, tmp1d2, tmp1d3,  tmp1d4, deltah0,    &
            Tfreezing,  dtdT,   LHS_h(:),    &
            i, j, k, kk,    &
            theta,     cp, &
            hice,     hice_tmp,   &
            J0(:), tmp1, tmp2,   &
            h_ex, wpi &
            )

       IF (.NOT. again(kk)) THEN
          cv0(1:n)   = var(1:n)%cv  ! save cv before updating
          isave(1:n) = var(1:n)%iice ! save isat before updating
          ! update variables (particularly thetaice)
          ! Debug for mp=1: remove elemental from hyofS and do loop instead of next line
          CALL hyofS(S(1:n), Tsoil(1:n), par(1:n), var(1:n))
          !do i=1, n
          !   call hyofS(S(i), Tsoil(i), par(i), var(i))
          !end do
          ! End debug hyofS
          var(1:n)%iice = isave(1:n)
       ENDIF ! if .not.again

       iflux(kk) = iflux(kk) + 1

    END DO ! do while (again(kk)) ! iflux loop
  END SUBROUTINE iflux_loop

  SUBROUTINE update_s_t( &
       mp,   n, dx, h0, S, thetai, &
       Tsoil,    infil,   &
       nsteps,    var,     &
       par,        &
       qlsig,    &
       again,   ih0,   ns,  &
       dt,      &
       sig,       &
       dy,        &
       qhsig,       &
       deltaS, dTsoil,    &
       dJcol_latent_S, dJcol_latent_T, dJcol_sensible, deltaJ_latent_S, &
       deltaJ_latent_T, deltaJ_sensible_S, deltaJ_sensible_T,  &
       qrunoff, tmp1d1, tmp1d2, tmp1d3,  tmp1d4, deltah0,    &
       Tfreezing,  dtdT,   LHS_h,    &
       i, j, k, kk,    &
       theta,     cp, &
       hice,     hice_tmp,   &
       J0, tmp1, tmp2,   &
       h_ex, wpi &
       )
    IMPLICIT NONE
    INTEGER(i_d)                                           :: mp
    INTEGER(i_d)                                           :: n
    REAL(r_2),      DIMENSION(1:n) :: dx
    REAL(r_2),      DIMENSION(1:mp)                        :: h0
    REAL(r_2),      DIMENSION(1:n) :: S
    REAL(r_2),      DIMENSION(1:n) :: thetai
    REAL(r_2),      DIMENSION(1:n) :: Tsoil
    REAL(r_2),      DIMENSION(1:mp)                        :: infil
    INTEGER(i_d),   DIMENSION(1:mp)                        :: nsteps
    TYPE(vars),     DIMENSION(1:n) :: var
    TYPE(params),   DIMENSION(1:n) :: par
    REAL(r_2),      DIMENSION(-nsnow_max:n) :: qlsig
    LOGICAL,      DIMENSION(1:mp)                          :: again
    INTEGER(i_d), DIMENSION(1:mp)                          :: ih0, ns
    REAL(r_2),    DIMENSION(1:mp)                          :: dt
    REAL(r_2),    DIMENSION(1:mp)                          :: sig
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: dy
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qhsig
    REAL(r_2),    DIMENSION(1:n) :: deltaS, dTsoil
    REAL(r_2),          DIMENSION(1:mp)                    :: dJcol_latent_S, dJcol_latent_T, dJcol_sensible
    REAL(r_2),          DIMENSION(1:n) :: deltaJ_latent_S, deltaJ_latent_T, deltaJ_sensible_S, deltaJ_sensible_T
    REAL(r_2),          DIMENSION(1:mp)                    :: qrunoff
    REAL(r_2),          DIMENSION(1:mp)                    :: tmp1d1, tmp1d2, tmp1d3,  tmp1d4
    REAL(r_2),          DIMENSION(1:mp)                    :: deltah0
    REAL(r_2),          DIMENSION(1:mp)                    :: Tfreezing
    REAL(r_2),          DIMENSION(1:mp)                    :: dtdT
    REAL(r_2),          DIMENSION(-nsnow_max+1:n) :: LHS_h
    INTEGER(i_d)                                           :: i, j, k, kk
    REAL(r_2)                                              :: theta
    REAL(r_2),          DIMENSION(1:mp)                    :: cp, hice, hice_tmp
    REAL(r_2),      DIMENSION(1:n) :: J0
    REAL(r_2)                                              :: tmp1, tmp2

    REAL(r_2), DIMENSION(1:n)                              :: h_ex
    REAL(r_2)                                              :: wpi
    ! update variables (S,T) to end of time step
    ! update variables to sig for use in isotope routine
    DO i=1, n

       IF (.NOT.again(kk)) Tsoil(i)  = Tsoil(i) + dTsoil(i)
       IF (var(i)%isat==0) THEN
          IF (.NOT.again(kk)) THEN
             deltaS(i) = dy(i)  !required for isotope subroutine
             S(i)      = S(i)+dy(i)
             IF (S(i)>one .AND. dy(i)>zero) THEN ! onset of saturation of layer
                var(i)%isat = 1
                var(i)%K    = var(i)%Ksat
                var(i)%phi  = var(i)%phie
             ENDIF
          ENDIF
       ELSE
          deltaS(i)  = zero    !required for isotope subroutine
          IF (i==1) THEN
             var(i)%phi = var(i)%phi + dy(i)*REAL(ns(kk),r_2) ! pond included in top soil layer
          ELSE
             var(i)%phi = var(i)%phi + dy(i)
          ENDIF

          ! var(i)%phi = zero from Ross
          ! VH thinks it is o.k. because hyofS is called later again
          ! MC think that we should probably get rid of -he*Ksat in phip etc.
          !   because we merged the pond with the first layer.
          IF (i==1 .AND. ih0(kk)/=0 .AND. var(i)%phi>=var(i)%phie) var(i)%phi = zero ! pond gone
          IF (var(i)%phi<var(i)%phie .AND. var(i)%iice==0) THEN ! desaturation of layer
             var(i)%isat = 0
             var(i)%K    = var(i)%Ksat
             var(i)%phi  = var(i)%phie
             var(i)%KS   = par(i)%KSe
             var(i)%phiS = par(i)%phiSe
          ELSEIF (var(i)%phi<var(i)%phie .AND. var(i)%iice==1) THEN
             var(i)%isat = 0
             var(i)%K    = var(i)%Ksat
             var(i)%phi  = var(i)%phie
             var(i)%KS   = var(i)%KS
             var(i)%phiS = var(i)%phiS
          ENDIF
       END IF

       IF (.NOT. again(kk)) THEN
!                   if (h0(kk)<zero .and. var(1)%isat==0 .and. (i==1)) then ! start negative pond correction
!                      infil(kk)     = infil(kk)+h0(kk)
!                      ! negative pond converted to loss of soil moisture in top two layers
!                      S(1) = S(1) + h0(kk)/(dx(1)*par(1)%thre)* dx(1)/(dx(1)+dx(2))
!                      deltaS(1) = h0(kk)/(dx(1)*par(1)%thre)* dx(1)/(dx(1)+dx(2))
!                      ! adjust flux between layer 1 and layer 2
!                      qlsig(1) = qlsig(1) + h0(kk)* dx(2)/(dx(1)+dx(2))/dt(kk)
!                      deltaS(2) =   h0(kk)/(dx(2)*par(2)%thre)* dx(2)/(dx(1)+dx(2))
!                      if (var(2)%isat.eq.0) then
!                         dy(2) = dy(2) + deltaS(2)
!                      else
!                         dy(2) = deltaS(2)
!                         var(2)%isat = 0
!                      endif
!
!                      deltah0(kk) = -(h0(kk)-deltah0(kk)) ! whole pond lost (new change = - original pond height)
!                      h0(kk) = zero  ! zero pond remaining
!                   endif

          ! water in profile initially
          wpi = SUM((par(:)%thr + (par(:)%the-par(:)%thr)*S(:))*dx(:))
          IF (h0(kk)<zero .AND. var(1)%isat==0 .AND. (i==1)) THEN ! start negative pond correction
             wpi = SUM((par(:)%thr + (par(:)%the-par(:)%thr)*S(:))*dx(:))

             infil(kk)     = infil(kk)+h0(kk)
             DO j=1,n
                h_ex(j) = -h0(kk)* (par(j)%the-par(j)%thr)*S(j)* dx(j)/wpi
             ENDDO

             DO j=1,n-1
                qlsig(j) = qlsig(j) +SUM(h_ex(j:n))
             ENDDO

             DO j = 1,n
                IF (j<n .AND. ( S(j)*(dx(j)*par(j)%thre) + h_ex(j)).LT.zero) THEN
                   h_ex(j+1) = h_ex(j+1) +(h_ex(j)- S(j)*(dx(j)*par(j)%thre))
                   h_ex(j) = S(j)*(dx(j)*par(j)%thre)
                ENDIF
                deltaS(j)= -MIN(h_ex(j)/(dx(j)*par(j)%thre),S(j))
                IF (var(j)%isat.EQ.0) THEN
                   dy(j) = dy(j) + deltaS(j)
                ELSE
                   dy(j) = deltaS(j)
                   var(j)%isat = 0
                ENDIF
                IF (j==1) S(j)=S(j)+deltaS(j)

             ENDDO
             deltah0(kk) = -(h0(kk)-deltah0(kk)) ! whole pond lost (new change = - original pond height)
             h0(kk) = zero  ! zero pond remaining

          ENDIF


          IF (S(i)<zero .AND. i<n) THEN ! start correction for negative soil moisture in any layer
             wpi = SUM((par(i+1:n)%thr + (par(i+1:n)%the-par(i+1:n)%thr)*S(i+1:n))*dx(i+1:n))

             DO j=i+1,n
                h_ex(j) = -deltaS(i)*dx(i)*par(i)%thre * &
                     (par(j)%thr + (par(j)%the-par(j)%thr)*S(j))*dx(j) /wpi
             ENDDO

             DO j=i+1,n
                qlsig(j) = qlsig(j) +SUM(h_ex(j:n))
             ENDDO

             DO j = i+1,n
                IF (j<n .AND. ( S(j)*(dx(j)*par(j)%thre) - h_ex(j)).LT.zero) THEN
                   h_ex(j+1) = h_ex(j+1) +(h_ex(j)- S(j)*(dx(j)*par(j)%thre))
                   h_ex(j) = S(j)*(dx(j)*par(j)%thre)
                ENDIF
                deltaS(j)= -MIN(h_ex(j)/(dx(j)*par(j)%thre),S(j))
                IF (var(j)%isat.EQ.0) THEN
                   dy(j) = dy(j) + deltaS(j)
                ELSE
                   dy(j) = deltaS(j)
                   var(j)%isat = 0
                ENDIF
                IF (j==i) S(j)=S(j)+deltaS(j)

             ENDDO

             S(i)=S(i)-deltaS(i)
             deltaS(i) = zero

          ENDIF

          ! corrections for onset of freezing and melting
          ! calculate freezing point temperature at new S
          Tfreezing(kk) = Tfrz(S(i), par(i)%he, one/(par(i)%lambc*freezefac))
          ! check for onset of freezing and adjust (increase) temperature to account for latent heat
          ! release by ice formation

          IF (experiment /= 184) THEN
             IF (Tsoil(i) < Tfreezing(kk) .AND. var(i)%iice==0) THEN  ! start correction for onset of freezing
                dtdT(kk)      = dthetalmaxdTh(Tfreezing(kk), S(i), par(i)%he, one/(par(i)%lambc*freezefac), &
                     par(i)%thre,par(i)%the)
                tmp1d3(kk) = 1000._r_2
                tmp1d2(kk) = Tsoil(i) - dTsoil(i)
                k = 1
                IF ((i==1).AND.(h0(kk)- deltah0(kk))>zero) THEN
                   h0(kk) = h0(kk) - deltah0(kk)  ! calculate stored heat using h0 at t-dt

                   DO WHILE ((k<nsteps_ice_max).AND.(tmp1d3(kk)>tol_dthetaldT))
                      tmp1d1(kk)  = LHS_h(i)*dt(kk)-deltaJ_sensible_S(i) + tmp1d2(kk)* &
                           (var(i)%csoil*dx(i)+cp(kk)*h0(kk)) + &
                           Tfreezing(kk)*rhow*(lambdaf+(tmp1d2(kk))*(cswat-csice)) * &
                           dtdT(kk)*(dx(i)+h0(kk)/par(i)%thre)
                      tmp1d1(kk)  = tmp1d1(kk) /( (var(i)%csoil*dx(i)+cp(kk)*h0(kk)) + &
                           rhow*(lambdaf+(tmp1d2(kk))*(cswat-csice)) * &
                           dtdT(kk)*(dx(i)+h0(kk)/par(i)%thre))
                      dtdT(kk) = (thetalmax(tmp1d1(kk), S(i), par(i)%he, one/(par(i)%lambc*freezefac), &
                           par(i)%thre, par(i)%the) &
                           - (S(i)*par(i)%thre + (par(i)%the-par(i)%thre)))/ &
                           (tmp1d1(kk) - Tfreezing(kk))
                      tmp1d3(kk) = ABS((tmp1d1(kk)- Tfreezing(kk))*dtdT(kk))
                      k = k + 1
                   ENDDO  ! end of do while
                   dTsoil(i) = tmp1d1(kk) - tmp1d2(kk)
                   Tsoil(i) = tmp1d1(kk)
                   deltaJ_sensible_T(i) = (var(i)%csoil*dx(i)+ cp(kk)*h0(kk))*dTsoil(i) + &
                        (Tsoil(i)-Tfreezing(kk))*rhow*dtdT(kk)*(dx(1)+h0(kk)/par(1)%thre)* &
                        ((cswat-csice)*(tmp1d2(kk)))
                   deltaJ_latent_T(i) = (Tsoil(i)-Tfreezing(kk))*rhow*dtdT(kk)*lambdaf* &
                        (dx(1)+h0(kk)/par(1)%thre)
                   h0(kk) = h0(kk) + deltah0(kk)

                   ! change in heat stored in soil column
                   dJcol_latent_S(kk) = SUM(deltaJ_latent_S(1:n))
                   dJcol_latent_T(kk) = SUM(deltaJ_latent_T(1:n))
                   dJcol_sensible(kk) = SUM(deltaJ_sensible_T(1:n)) + SUM(deltaJ_sensible_S(1:n))
                   ! tmp1d1(kk) = dJcol_latent_S(kk) + dJcol_latent_T(kk) + &
                   !      dJcol_sensible(kk) - (qhsig(0)-qhsig(6))*dt(kk) + &
                   !      qrunoff(kk)*cswat*rhow*(Tsoil(1) + sig(kk)*dTsoil(1))*dt(kk)
                   tmp1d1(kk) = dJcol_latent_S(kk) + dJcol_latent_T(kk) + &
                        dJcol_sensible(kk) - (qhsig(0)-qhsig(n))*dt(kk) + &
                        qrunoff(kk)*cswat*rhow*(Tsoil(1) + sig(kk)*dTsoil(1))*dt(kk)
                   ! if (abs(tmp1d1(kk)).gt.10.) then
                   !    write(*,*) 'E imbalance check 2'
                   ! endif
                ELSE
                   DO WHILE ((k<nsteps_ice_max).AND.(tmp1d3(kk)>tol_dthetaldT))
                      ! zeroth estimate of corrected temperature
                      tmp1d1(kk)  = LHS_h(i)*dt(kk)-deltaJ_sensible_S(i) + tmp1d2(kk)* &
                           (var(i)%csoil*dx(i)) + Tfreezing(kk)*rhow*(lambdaf+(tmp1d2(kk))*(cswat-csice)) * &
                           dtdT(kk)*dx(i)
                      tmp1d1(kk)  = tmp1d1(kk) /( (var(i)%csoil*dx(i)) + &
                           rhow*(lambdaf+(tmp1d2(kk))*(cswat-csice)) * dtdT(kk)*dx(i))
                      dtdT(kk) =  (thetalmax(tmp1d1(kk), S(i), par(i)%he, &
                           one/(par(i)%lambc*freezefac), par(i)%thre, par(i)%the) &
                           - (S(i)*par(i)%thre + (par(i)%the-par(i)%thre)))/ &
                           (tmp1d1(kk) - Tfreezing(kk))
                      tmp1d3(kk) = ABS((tmp1d1(kk)- Tfreezing(kk))*dtdT(kk))
                      k = k + 1
                   ENDDO  ! end of do while
                   dTsoil(i) = tmp1d1(kk)- (Tsoil(i)-dTsoil(i))
                   Tsoil(i) = tmp1d1(kk)
                   deltaJ_sensible_T(i) = (var(i)%csoil*dx(i))*dTsoil(i) + &
                        (Tsoil(i)-Tfreezing(kk))*rhow*dtdT(kk)*dx(i)* &
                        ((cswat-csice)*(tmp1d2(kk)))
                   deltaJ_latent_T(i) = (Tsoil(i)-Tfreezing(kk))*rhow*dtdT(kk)*lambdaf*dx(i)
                ENDIF
             ENDIF  ! end correction for onset of freezing
          ENDIF

          IF (var(i)%iice==1) THEN
             theta         = S(i)*(par(i)%thre) + (par(i)%the - par(i)%thre)
             tmp1d1(kk) = Tsoil(i) - dTsoil(i)
             ! energy for complete melting
             IF ((i==1).AND.(h0(kk)>zero)) THEN
                tmp1d3(kk) = thetai(i)*dx(i)*rhow*lambdaf + &
                     thetai(i)*(h0(kk)- deltah0(kk))/par(i)%thre*rhow*lambdaf

                tmp1d2(kk) = (Tfreezing(kk))*(rhow*cswat*(theta*dx(1)+h0(kk))+ &
                     par(1)%rho*par(1)%css*dx(1)) - &
                     (tmp1d1(kk))*(rhow*cswat*(var(i)%thetal*dx(1)+(h0(kk)- deltah0(kk))* &
                     (one-thetai(1)/par(1)%thre))+par(1)%rho*par(1)%css*dx(1)) - &
                     (tmp1d1(kk))*(rhow*csice*(thetai(i)*dx(1)+(h0(kk)- deltah0(kk))* &
                     thetai(1)/par(1)%thre))
             ELSE
                tmp1d3(kk) = thetai(i)*dx(i)*rhow*lambdaf

                tmp1d2(kk) = (Tfreezing(kk))*(rhow*cswat*(theta*dx(i))+par(i)%rho*par(i)%css*dx(i)) - &
                     (tmp1d1(kk))*(rhow*cswat*(var(i)%thetal*dx(i))+par(i)%rho*par(i)%css*dx(i)) - &
                     (tmp1d1(kk))*(rhow*csice*(thetai(i)*dx(i)))
             ENDIF
          ENDIF
          ! check for onset of thawing and decrease temperature to account for latent heat required to melt ice

          IF ((var(i)%iice==1).AND.((J0(i) + LHS_h(i)*dt(kk)).GE.JSoilLayer(Tfreezing(kk), &
               dx(i), theta,par(i)%css, par(i)%rho, &
               MERGE(h0(kk),zero,i==1), par(i)%thre, par(i)%the, &
               par(i)%he, one/(par(i)%lambc*freezefac)))) THEN
             ! start correction for onset of thawing
             ! Correct for "overthawing". This extra energy is used to heat the soil even more
             ! The correction comes from equating the energy balances before and after correction.
             tmp1d1(kk) = Tsoil(i) - dTsoil(i)

             IF ((i==1) .AND. (h0(kk)>zero)) THEN
                deltaJ_latent_T(i)=      tmp1d3(kk)
                deltaJ_latent_S(i) = zero
                h0(kk) = h0(kk) - deltah0(kk)

                deltaJ_sensible_S(i) = (tmp1d1(kk))*(rhow*cswat*(theta*dx(1)+(h0(kk)+deltah0(kk)))+ &
                     par(1)%rho*par(1)%css*dx(1)) - &
                     (tmp1d1(kk))*(rhow*cswat*(var(i)%thetal*dx(1)+(h0(kk))* &
                     (one-thetai(1)/par(1)%thre))+par(1)%rho*par(1)%css*dx(1)) - &
                     (tmp1d1(kk))*(rhow*csice*(thetai(i)*dx(1)+(h0(kk))* &
                     thetai(1)/par(1)%thre))

                dTsoil(i) = (LHS_h(i)*dt(kk) - (deltaJ_latent_T(i) + deltaJ_sensible_S(i)))/ &
                     (rhow*cswat*(theta*dx(1)+(h0(kk)+deltah0(kk)))+par(1)%rho*par(1)%css*dx(1))

                deltaJ_sensible_T(i) = dTsoil(i)* &
                     (rhow*cswat*(theta*dx(1)+(h0(kk)+deltah0(kk)))+par(1)%rho*par(1)%css*dx(1))

                h0(kk) = h0(kk) + deltah0(kk)
             ELSE
                deltaJ_latent_T(i) = thetai(i)*dx(i)*rhow*lambdaf
                deltaJ_latent_S(i) = zero

                theta         = S(i)*(par(i)%thre) + (par(i)%the - par(i)%thre)
                var(i)%csoil = cswat*theta*rhow + par(i)%css*par(i)%rho

                deltaJ_sensible_S(i) = (tmp1d1(kk))*(rhow*cswat*(theta*dx(i))+ &
                     par(i)%rho*par(i)%css*dx(i)) - &
                     (tmp1d1(kk))*(rhow*cswat*(var(i)%thetal*dx(i))+par(i)%rho*par(i)%css*dx(i)) - &
                     (tmp1d1(kk))*(rhow*csice*(thetai(i)*dx(i)))
                dTsoil(i) = (LHS_h(i)*dt(kk) - (deltaJ_latent_T(i) + deltaJ_sensible_S(i)))/ &
                     (dx(i)*var(i)%csoil)
                deltaJ_sensible_T(i) = var(i)%csoil*dTsoil(i)*dx(i)
             ENDIF
             Tsoil(i) = tmp1d1(kk) + dTsoil(i)
             ! correct thetai and T in frozen soil
          ELSEIF ((var(i)%iice==1).AND.((J0(i) + LHS_h(i)*dt(kk))<JSoilLayer(Tfreezing(kk), &
               dx(i), theta,par(i)%css, par(i)%rho, &
               MERGE(h0(kk),zero,i==1), par(i)%thre, par(i)%the, &
               par(i)%he, one/(par(i)%lambc*freezefac)))) THEN

             tmp1d2(kk) = J0(i) + LHS_h(i)*dt(kk) ! total energy in  soil layer
             IF (Tsoil(i) .LT. -40.0_r_2) THEN
                ! assume no lquid below min temp threshhold
                var(i)%thetal = 0.0_r_2
                var(i)%thetai = theta
                IF (i.EQ.1) hice(kk) = h0(kk)
                tmp1d3(kk) = (tmp1d2(kk) + rhow*lambdaf*(theta*dx(i) +  MERGE(h0(kk),zero,i==1)))/ &
                     (dx(i)*par(i)%css*par(i)%rho + rhow*csice*(theta*dx(i) + &
                     MERGE(h0(kk),zero,i==1)))
             ELSE
                !check there is a zero
                tmp1 = GTfrozen(Tsoil(i)-dTsoil(i)-50._r_2, tmp1d2(kk), dx(i), theta,par(i)%css, par(i)%rho, &
                     MERGE(h0(kk),zero,i==1), par(i)%thre, par(i)%the, par(i)%he, one/(par(i)%lambc*freezefac))

                tmp2 = GTFrozen(Tfreezing(kk), tmp1d2(kk), dx(i), theta,par(i)%css, par(i)%rho, &
                     MERGE(h0(kk),zero,i==1), par(i)%thre, par(i)%the, par(i)%he, one/(par(i)%lambc*freezefac))
                ! there is a zero in between
                IF ((tmp1*tmp2) < zero) THEN
                   tmp1d3(kk) = rtbis_Tfrozen(tmp1d2(kk), dx(i), theta,par(i)%css, par(i)%rho, &
                        MERGE(h0(kk),zero,i==1), par(i)%thre, par(i)%the, &
                        par(i)%he, one/(par(i)%lambc*freezefac), &
                        Tsoil(i)-dTsoil(i)-50._r_2, Tfreezing(kk), 0.0001_r_2)
                   tmp1d4(kk) = thetalmax(tmp1d3(kk), S(i), par(i)%he, one/(par(i)%lambc*freezefac), &
                        par(i)%thre, par(i)%the) ! liquid content at solution for Tsoil
                ELSE
                   WRITE(logn,*) "Found no solution for Tfrozen 1. ", kk, i
                   WRITE(logn,*) "Assume soil is totally frozen"
                   var(i)%thetal = 0.0_r_2
                   var(i)%thetai = theta
                   IF (i.EQ.1) hice(kk) = h0(kk)
                   tmp1d3(kk) = (tmp1d2(kk) + rhow*lambdaf*(theta*dx(i) +  MERGE(h0(kk),zero,i==1)))/ &
                        (dx(i)*par(i)%css*par(i)%rho + rhow*csice*(theta*dx(i) + &
                        MERGE(h0(kk),zero,i==1)))
                   WRITE(logn,*) "frozen soil temperature: ", tmp1d3(kk)
                   WRITE(logn,*) nsteps(kk), S(i), Tsoil(i), dTsoil(i), h0(kk), tmp1, tmp2, tmp1d2(kk), theta, &
                        JSoilLayer(Tfreezing(kk), &
                        dx(i), theta,par(i)%css, par(i)%rho, &
                        MERGE(h0(kk),zero,i==1), par(i)%thre, par(i)%the, &
                        par(i)%he, one/(par(i)%lambc*freezefac)), J0(i) + LHS_h(i)*dt(kk), Tfreezing(kk)
                ENDIF
                var(i)%thetal = tmp1d4(kk)
                var(i)%thetai = theta - tmp1d4(kk)
             ENDIF ! Tsoil <-40
             IF (i==1) THEN
                hice_tmp(kk) = hice(kk)
                hice(kk) = h0(kk)*var(1)%thetai/par(1)%thre

                ! correct total energy stored in pond + soil
                deltaJ_latent_S(i) = - rhow*lambdaf*((hice(kk)-hice_tmp(kk)) + &
                     dx(1)*(var(1)%thetai-thetai(1)))
             ELSE
                ! correct total energy stored in  soil
                deltaJ_latent_S(i) = - rhow*lambdaf*( + &
                     dx(i)*(var(i)%thetai-thetai(i)))


             ENDIF

             deltaJ_latent_T(i) = zero

             deltaJ_sensible_T(i) = JSoilLayer(tmp1d3(kk), &
                  dx(i), theta,par(i)%css, par(i)%rho, &
                  MERGE(h0(kk),zero,i==1), par(i)%thre, par(i)%the, &
                  par(i)%he, one/(par(i)%lambc*freezefac)) - &
                  J0(i)- &
                  deltaJ_latent_S(i)

             deltaJ_sensible_S(i) = 0._r_2

             thetai(i) = var(i)%thetai
             Tsoil(i) = tmp1d3(kk)

          ENDIF ! soil remains frozen

       ENDIF ! if .not.again

    END DO ! i=1, n => update variables S,T
  END SUBROUTINE update_s_t


  SUBROUTINE update_unknowns( &
       irec, mp, qprec, qprec_snow, n, dx, h0, S,  &
       Tsoil, evap,   infil, drainage, discharge, &
       qh, nsteps, vmet, vlit, vsnow, var,   Hcum, lEcum, &
       Gcum, Qadvcum,  &
       csoil, kth, phi,  zdelta, SL, Tl, &
       par,  wex,      &
       qvsig, qlsig, qvTsig,   &
       precip, qevap,       rexcol, wcol,  &
       again,   ih0,   ns,  &
       dt, dwinfil, dwoff,    &
       sig,       &
       qexd,        dy,        &
       de, q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb,    &
       qsig, qhsig, qadvsig, qliq, qv, qvT,  qlyb, &
       qvya, qvyb, qlTb, qvTa, qvTb,   dTsoil,    &
       v_aquifer,  &
       dwcol, dwdrainage, drn,inlit, dwinlit, drexcol, dwdischarge, &
       dJcol_latent_S, dJcol_latent_T, dJcol_sensible, deltaJ_latent_S, &
       deltaJ_latent_T, deltaJ_sensible_S, deltaJ_sensible_T, qevapsig, &
       qrunoff, tmp1d1, tmp1d2, tmp1d3,   deltah0,  deltaSL,  &
       LHS_h,  surface_case,  &
       litter, i, j,  kk,    &
       advection,    theta,   Tqw,  cp, &
       hsnow, &
       delta_snowcol, delta_snowT, &
       delta_snowliq,    J0,   iqex,  &
       J0snow, wcol0snow   &
       )
    IMPLICIT NONE
    INTEGER(i_d)                                           :: irec, mp
    REAL(r_2),      DIMENSION(1:mp)                        :: qprec
    REAL(r_2),      DIMENSION(1:mp)                        :: qprec_snow
    INTEGER(i_d)                                           :: n
    REAL(r_2),      DIMENSION(1:n) :: dx
    REAL(r_2),      DIMENSION(1:mp)                        :: h0
    REAL(r_2),      DIMENSION(1:n) :: S
    REAL(r_2),      DIMENSION(1:n) :: Tsoil
    REAL(r_2),      DIMENSION(1:mp)                        :: evap
    REAL(r_2),      DIMENSION(1:mp)                        :: infil
    REAL(r_2),      DIMENSION(1:mp)                        :: drainage, discharge
    REAL(r_2),      DIMENSION(-nsnow_max:n) :: qh
    INTEGER(i_d),   DIMENSION(1:mp)                        :: nsteps
    TYPE(vars_met), DIMENSION(1:mp)                        :: vmet
    TYPE(vars),     DIMENSION(1:mp)                        :: vlit
    TYPE(vars_snow), DIMENSION(1:mp)                       :: vsnow
    TYPE(vars),     DIMENSION(1:n) :: var
    REAL(r_2),      DIMENSION(1:mp)                        :: Hcum, lEcum
    REAL(r_2),      DIMENSION(1:mp)                        :: Gcum, Qadvcum
    REAL(r_2),      DIMENSION(1:n) :: csoil, kth
    REAL(r_2),      DIMENSION(1:n) :: phi
    REAL(r_2),      DIMENSION(1:mp)                        :: zdelta, SL, Tl
    TYPE(params),   DIMENSION(1:n) :: par
    REAL(r_2),      DIMENSION(1:mp,1:n), OPTIONAL                    :: wex
    REAL(r_2),      DIMENSION(-nsnow_max:n) :: qvsig, qlsig, qvTsig
    REAL(r_2),    DIMENSION(1:mp)                          :: precip, qevap
    REAL(r_2),    DIMENSION(1:mp)                          :: rexcol, wcol
    LOGICAL,      DIMENSION(1:mp)                          :: again
    INTEGER(i_d), DIMENSION(1:mp)                          :: ih0, ns
    REAL(r_2),    DIMENSION(1:mp)                          :: dt, dwinfil, dwoff
    REAL(r_2),    DIMENSION(1:mp)                          :: sig
    REAL(r_2),    DIMENSION(1:n) :: qexd
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: dy
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: de
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qsig, qhsig, qadvsig
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qliq, qv, qvT, qlyb, qvya, qvyb, qlTb, qvTa, qvTb
    REAL(r_2),    DIMENSION(1:n) :: dTsoil
    TYPE(vars_aquifer), DIMENSION(1:mp)                    :: v_aquifer
    REAL(r_2),          DIMENSION(1:mp)                    :: dwcol, dwdrainage, drn,inlit, dwinlit, drexcol, dwdischarge
    REAL(r_2),          DIMENSION(1:mp)                    :: dJcol_latent_S, dJcol_latent_T, dJcol_sensible
    REAL(r_2),          DIMENSION(1:n) :: deltaJ_latent_S, deltaJ_latent_T, deltaJ_sensible_S, deltaJ_sensible_T
    REAL(r_2),          DIMENSION(1:mp)                    :: qevapsig
    REAL(r_2),          DIMENSION(1:mp)                    :: qrunoff
    REAL(r_2),          DIMENSION(1:mp)                    :: tmp1d1, tmp1d2, tmp1d3
    REAL(r_2),          DIMENSION(1:mp)                    :: deltah0
    REAL(r_2),          DIMENSION(1:mp)                    :: deltaSL
    REAL(r_2),          DIMENSION(-nsnow_max+1:n) :: LHS_h
    INTEGER(i_d),       DIMENSION(1:mp)                    :: surface_case
    LOGICAL                                                :: litter
    INTEGER(i_d)                                           :: i, j, kk
    INTEGER(i_d)                                           :: advection ! switches
    REAL(r_2)                                              :: theta
    REAL(r_2)                                              :: Tqw
    REAL(r_2),          DIMENSION(1:mp)                    :: cp
    REAL(r_2),          DIMENSION(nsnow_max) :: hsnow
    REAL(r_2),          DIMENSION(nsnow_max) :: delta_snowcol, delta_snowT, delta_snowliq
    REAL(r_2),      DIMENSION(1:n) :: J0
    REAL(r_2),          DIMENSION(1:n) :: iqex

    REAL(r_2),          DIMENSION(1:mp)                    :: J0snow, wcol0snow
    !----- update unknowns
    ! i.e. update state variables to end of time step
    !      cumulate some surface fluxes
    ih0(kk) = 0
    IF (.NOT. again(kk)) THEN
       ! get surface fluxes at sigma of the time step
       dwoff(kk)  = zero
       deltah0(kk) = zero
       precip(kk) = precip(kk) + (qprec(kk)+qprec_snow(kk))*dt(kk)
       dwcol(kk) = SUM(par(1:n)%thre*dx(1:n)*dy(1:n)*(ABS(var(1:n)%isat-1)),1) + &
            REAL(1-ns(kk),r_2)*dy(1)

       IF (vsnow(kk)%nsnow==1) dwcol(kk) = dwcol(kk) + dy(0)

       ! absolute heat stored in soil column before update
       DO j=1, n
          theta  =  S(j)*(par(j)%thre) + (par(j)%the - par(j)%thre)
          J0(j) = JSoilLayer(Tsoil(j), &
               dx(j), theta,par(j)%css, par(j)%rho, &
               MERGE(h0(kk),zero,j.EQ.1), par(j)%thre, par(j)%the, &
               par(j)%he, one/(par(j)%lambc*freezefac))
       END DO

       ! change in heat stored in soil column
       DO j=1, n
          IF (j==1) THEN
             ! pond included in top soil layer
             deltaJ_latent_S(j) = -dx(j)*dy(j)*par(j)%thre*REAL(var(j)%iice,r_2)* &
                  REAL(1-var(j)%isat,r_2)*rhow*lambdaf - &
                  REAL(1-ns(kk),r_2)*dy(1)*REAL(var(j)%iice,r_2)*rhow*lambdaf*(var(1)%thetai/par(1)%thre)

             deltaJ_latent_T(j) = var(j)%dthetaldT*dx(j)*dTsoil(j)*rhow*lambdaf* &
                  REAL(var(j)%iice,r_2) + &
                  h0(kk)/par(1)%thre*var(j)%dthetaldT*dTsoil(j)*rhow*lambdaf*REAL(var(j)%iice,r_2)

             deltaJ_sensible_T(j) = var(j)%csoil*dx(j)*dTsoil(j) + &
                  cp(kk)*h0(kk)*dTsoil(j) + &
                  var(1)%iice*var(j)%dthetaldT*(Tsoil(j))*rhow*(cswat-csice)*dx(j)*dTsoil(j) + &
                  var(j)%iice*var(j)%dthetaldT*(Tsoil(j))*rhow*(cswat-csice)* &
                  h0(kk)/par(j)%thre*dTsoil(j)

             IF (advection==1) THEN
                deltaJ_sensible_S(j) = rhow*cswat*(Tsoil(j))*dx(j)*par(j)%thre*dy(j)* &
                     REAL(1-var(j)%isat,r_2)*REAL(1-var(j)%iice,r_2)  + &
                     rhow*csice*(Tsoil(j))*dx(j)*par(j)%thre*dy(j)* &
                     REAL(1-var(j)%isat,r_2)*REAL(var(j)%iice,r_2) + &
                     REAL(1-ns(kk),r_2)*REAL(1-var(1)%iice,r_2)* &
                     dy(1)*rhow*cswat*(Tsoil(1))  + &
                     REAL(1-ns(kk),r_2)*REAL(var(1)%iice,r_2)* &
                     dy(1)*rhow*csice*(Tsoil(1))*(var(1)%thetai/par(1)%thre) + &
                     REAL(1-ns(kk),r_2)*REAL(var(1)%iice,r_2)* &
                     dy(1)*rhow*cswat*(Tsoil(1))*(one-(var(1)%thetai/par(1)%thre))
             ENDIF
          ELSE ! (j>1)
             deltaJ_latent_S(j) = -dx(j)*dy(j)*par(j)%thre*REAL(var(j)%iice,r_2)* &
                  REAL(1-var(j)%isat,r_2)*rhow*lambdaf
             deltaJ_sensible_T(j) = var(j)%csoil*dx(j)*dTsoil(j) + &
                  var(j)%iice*var(j)%dthetaldT*(Tsoil(j))*rhow*(cswat-csice)*dx(j)*dTsoil(j)


             IF (advection==1) THEN
                deltaJ_sensible_S(j) = rhow*cswat*(Tsoil(j))*dx(j)*dy(j)*par(j)%thre* &
                     REAL(1-var(j)%isat,r_2)*REAL(1-var(j)%iice,r_2) &
                     + rhow*csice*(Tsoil(j))*dx(j)*dy(j)*par(j)%thre &
                     *REAL(1-var(j)%isat,r_2)*REAL(var(j)%iice,r_2)
             ENDIF

             deltaJ_latent_T(j) = var(j)%dthetaldT*dx(j)*dTsoil(j)*rhow*lambdaf*REAL(var(j)%iice,r_2)
          ENDIF
       END DO

       ! change in heat stored in soil column
       dJcol_latent_S(kk) = SUM(deltaJ_latent_S(1:n))
       dJcol_latent_T(kk) = SUM(deltaJ_latent_T(1:n))
       dJcol_sensible(kk) = SUM(deltaJ_sensible_T(1:n)) + SUM(deltaJ_sensible_S(1:n))
       ! tmp1d1(kk) = dJcol_latent_S(kk) + dJcol_latent_T(kk) + dJcol_sensible(kk) - (qhsig(0)-qhsig(6))*dt(kk) &
       !      + qrunoff(kk)*cswat*rhow*(Tsoil(1) + sig(kk)*dTsoil(1))*dt(kk)
       tmp1d1(kk) = dJcol_latent_S(kk) + dJcol_latent_T(kk) + dJcol_sensible(kk) - (qhsig(0)-qhsig(n))*dt(kk) &
            + qrunoff(kk)*cswat*rhow*(Tsoil(1) + sig(kk)*dTsoil(1))*dt(kk)

       IF (ns(kk)<1) THEN ! change in pond height
          h0(kk) = h0(kk) + dy(1)
          deltah0(kk) = dy(1)
          IF (h0(kk)<zero .AND. dy(1)<zero) THEN
             ih0(kk)=1 ! pond gone
          ENDIF
       ENDIF

       ! cumulate evaporation from top of soil column or top of litter/pond or top of snow pack
       SELECT CASE (surface_case(kk))
       CASE(1)  ! no snow
          evap(kk)     = evap(kk) +qevap(kk)*dt(kk) - sig(kk)*(qyb(0)*dy(1)+qTb(0)*dTsoil(1))*dt(kk)
          qevapsig(kk) = qevap(kk) - sig(kk)*(qyb(0)*dy(1)+qTb(0)*dTsoil(1))
          Gcum(kk) = Gcum(kk)+(qhsig(0)-qadvsig(0))*dt(kk)
          Qadvcum(kk) = Qadvcum(kk) + qadvsig(0)*dt(kk) - qadvsig(n)*dt(kk)
          lEcum(kk)    = lEcum(kk) + qevapsig(kk)*thousand*var(1)%lambdav*dt(kk)
          Hcum(kk) = Hcum(kk) + (vmet(kk)%Rn*dt(kk)-(qhsig(0)-qadvsig(0))*dt(kk)- &
               qevapsig(kk)*thousand*var(1)%lambdav*dt(kk))
          dwinfil(kk) = (qprec(kk)+qprec_snow(kk)-qevapsig(kk))*dt(kk)
       CASE(2) ! dedicated snow layer
          evap(kk)     = evap(kk) +qevap(kk)*dt(kk) - sig(kk)*(qyb(-vsnow(kk)%nsnow)*dy(1-vsnow(kk)%nsnow)+ &
               qTb(-vsnow(kk)%nsnow)*de(1-vsnow(kk)%nsnow))*dt(kk)
          qevapsig(kk) = qevap(kk) - sig(kk)*(qyb(-vsnow(kk)%nsnow)*dy(1-vsnow(kk)%nsnow)+ &
               qTb(-vsnow(kk)%nsnow)*de(1-vsnow(kk)%nsnow))
          Gcum(kk) = Gcum(kk)+(qhsig(-vsnow(kk)%nsnow)-qadvsig(-vsnow(kk)%nsnow))*dt(kk)
          Qadvcum(kk) = Qadvcum(kk) + qadvsig(-vsnow(kk)%nsnow)*dt(kk) - qadvsig(n)*dt(kk)
          IF (vsnow(kk)%hliq(1).GT.zero) THEN
             lEcum(kk)    = lEcum(kk) + qevapsig(kk)*thousand*lambdaf*dt(kk)
             Hcum(kk) = Hcum(kk) + (vmet(kk)%Rn*dt(kk)-(qhsig(-vsnow(kk)%nsnow)-qadvsig(-vsnow(kk)%nsnow))*dt(kk)- &
                  qevapsig(kk)*thousand*lambdaf*dt(kk))
          ELSE
             lEcum(kk)    = lEcum(kk) + qevapsig(kk)*thousand*lambdas*dt(kk)
             Hcum(kk) = Hcum(kk) + (vmet(kk)%Rn*dt(kk)-(qhsig(-vsnow(kk)%nsnow)-qadvsig(-vsnow(kk)%nsnow))*dt(kk)- &
                  qevapsig(kk)*thousand*lambdas*dt(kk))
          ENDIF
          dwinfil(kk) = (qprec(kk)+qprec_snow(kk)-qevapsig(kk))*dt(kk)
       END SELECT ! surface_case

       dwdrainage(kk)     = q(n)*dt(kk) +sig(kk)*dt(kk)*(qya(n)*dy(n)+qTa(n)*dTsoil(n))
       IF (botbc=="aquifer" .AND. v_aquifer(kk)%isat==0) THEN
          dwdischarge(kk) = v_aquifer(kk)%discharge*dt(kk)
       ELSE
          dwdischarge(kk) = dwdrainage(kk)
       ENDIF

       drexcol(kk) = SUM(iqex(:),1)*dt(kk)
       ! cumulative fluxes
       infil(kk)     = infil(kk) + dwinfil(kk)
       inlit(kk)     = inlit(kk) + dwinlit(kk)
       wcol(kk)      = wcol(kk) + dwcol(kk)
       drainage(kk)  = drainage(kk) + dwdrainage(kk)
       discharge(kk) = discharge(kk) + qrunoff(kk)*dt(kk)
       rexcol(kk)    = rexcol(kk) + drexcol(kk)
       Qadvcum(kk) = Qadvcum(kk) - SUM(iqex(:)*(Tsoil(:)),1)*dt(kk)*rhow*cswat - &
            qrunoff(kk)*(Tsoil(1))*dt(kk)*rhow*cswat
       ! if (irec.eq.109) then
       !     write(*,"(1i8,16e16.6)") irec, infil(kk)-(wcol(kk)+discharge(kk)+drainage(kk))-rexcol(kk), &
       !         wcol(kk), deltah0(kk), h0(kk), discharge(kk), evap(kk), &
       !         drainage(kk), rexcol(kk)
       !     write(*,"(1i8,16e16.6)") irec, dwinfil(kk)-dwcol(kk)-dwdrainage(kk)-drexcol(kk)-qrunoff(kk)*dt(kk)
       ! endif

       ! evaluate soil fluxes at sigma of time step for use in isotope routine

       SELECT CASE (surface_case(kk))
       CASE(1)  ! no snow
          qsig(0)  = q(0)  + sig(kk)*(qyb(0)*dy(1)  + qya(0)*dy(0)  + qTb(0)*de(1) &
               + qTa(0)*de(0))
          qhsig(0) = qh(0) + sig(kk)*(qhyb(0)*dy(1) + qhya(0)*dy(0) + qhTb(0)*de(1) &
               + qhTa(0)*de(0))
          qvsig(0) = qv(0)+sig(kk)*qvyb(0)*dy(1)+sig(kk)*qvTb(0)*de(1)
          qlsig(0) = qliq(0)+sig(kk)*qlyb(0)*dy(1)+sig(kk)*qlTb(0)*de(1)

          qsig(1:n-1)   = q(1:n-1) + sig(kk)*(qya(1:n-1)*dy(1:n-1) + qyb(1:n-1)*dy(2:n) &
               + qTa(1:n-1)*de(1:n-1) + qTb(1:n-1)*de(2:n))
          qsig(n)       = q(n) + sig(kk)*(qya(n)*dy(n) + qTa(n)*de(n))
          qhsig(1:n-1)  = qh(1:n-1) + sig(kk)*(qhya(1:n-1)*dy(1:n-1) + qhyb(1:n-1)*dy(2:n) &
               + qhTa(1:n-1)*de(1:n-1) + qhTb(1:n-1)*de(2:n))
          qhsig(n)      = qh(n) + sig(kk)*(qhya(n)*dy(n) + qhTa(n)*de(n))
          qvsig(1:n-1)  = qv(1:n-1) + sig(kk)*(qvya(1:n-1)*dy(1:n-1) + qvyb(1:n-1)*dy(2:n) &
               + qvTa(1:n-1)*de(1:n-1) + qvTb(1:n-1)*de(2:n))
          qvsig(n)      = zero

          qvTsig(0)     = qvT(0) + sig(kk)*qvTb(0)*de(1)
          qvTsig(1:n-1) = qvT(1:n-1) + sig(kk)*(qvTa(1:n-1)*de(1:n-1) + qvTb(1:n-1)*de(2:n))
          qvTsig(n)     = zero
          qlsig(1:n-1)  = qsig(1:n-1) - qvsig(1:n-1)
          qlsig(n)      = qsig(n)

       CASE(2) ! dedicated snow layer
          qsig(-vsnow(kk)%nsnow)  = q(-vsnow(kk)%nsnow)  + &
               sig(kk)*(qyb(-vsnow(kk)%nsnow)*dy(-vsnow(kk)%nsnow+1)  + &
                                ! qya(-vsnow(kk)%nsnow)*dy(-vsnow(kk)%nsnow)  + &
               qTb(-vsnow(kk)%nsnow)*de(-vsnow(kk)%nsnow+1)) ! &
          !  + qTa(-vsnow(kk)%nsnow)*de(-vsnow(kk)%nsnow))
          qhsig(-vsnow(kk)%nsnow) = qh(-vsnow(kk)%nsnow) + &
               sig(kk)*(qhyb(-vsnow(kk)%nsnow)*dy(-vsnow(kk)%nsnow+1) + &
                                ! qhya(-vsnow(kk)%nsnow)*dy(-vsnow(kk)%nsnow) + &
               qhTb(-vsnow(kk)%nsnow)*de(-vsnow(kk)%nsnow+1)) !&
          !  + qhTa(-vsnow(kk)%nsnow)*de(-vsnow(kk)%nsnow))
          qvsig(-vsnow(kk)%nsnow) = qv(-vsnow(kk)%nsnow) + &
               sig(kk)*qvyb(-vsnow(kk)%nsnow)*dy(-vsnow(kk)%nsnow+1) + &
               sig(kk)*qvTb(-vsnow(kk)%nsnow)*de(-vsnow(kk)%nsnow+1)

          qlsig(-vsnow(kk)%nsnow:-1) = zero
          qlsig(0) = qliq(0)+sig(kk)*qlyb(0)*dy(1)+sig(kk)*qlTb(0)*de(1)

          qsig(-vsnow(kk)%nsnow+1:n-1)   = q(-vsnow(kk)%nsnow+1:n-1) + &
               sig(kk)*(qya(-vsnow(kk)%nsnow+1:n-1)*dy(-vsnow(kk)%nsnow+1:n-1) + &
               qyb(-vsnow(kk)%nsnow+1:n-1)*dy(-vsnow(kk)%nsnow+2:n) &
               + qTa(-vsnow(kk)%nsnow+1:n-1)*de(-vsnow(kk)%nsnow+1:n-1) + &
               qTb(-vsnow(kk)%nsnow+1:n-1)*de(-vsnow(kk)%nsnow+2:n))
          qsig(n)       = q(n) + sig(kk)*(qya(n)*dy(n) + qTa(n)*de(n))
          qhsig(-vsnow(kk)%nsnow+1:n-1)  = qh(-vsnow(kk)%nsnow+1:n-1) + &
               sig(kk)*(qhya(-vsnow(kk)%nsnow+1:n-1)*dy(-vsnow(kk)%nsnow+1:n-1) + &
               qhyb(-vsnow(kk)%nsnow+1:n-1)*dy(-vsnow(kk)%nsnow+2:n) &
               + qhTa(-vsnow(kk)%nsnow+1:n-1)*de(-vsnow(kk)%nsnow+1:n-1) + &
               qhTb(-vsnow(kk)%nsnow+1:n-1)*de(-vsnow(kk)%nsnow+2:n))
          qhsig(n)      = qh(n) + sig(kk)*(qhya(n)*dy(n) + qhTa(n)*de(n))
          qvsig(-vsnow(kk)%nsnow+1:n-1)  = qv(-vsnow(kk)%nsnow+1:n-1) + &
               sig(kk)*(qvya(-vsnow(kk)%nsnow+1:n-1)*dy(-vsnow(kk)%nsnow+1:n-1) + &
               qvyb(-vsnow(kk)%nsnow+1:n-1)*dy(-vsnow(kk)%nsnow+2:n) &
               + qvTa(-vsnow(kk)%nsnow+1:n-1)*de(-vsnow(kk)%nsnow+1:n-1) + &
               qvTb(-vsnow(kk)%nsnow+1:n-1)*de(-vsnow(kk)%nsnow+2:n))
          qvsig(n)      = zero

          qvTsig(0)     = qvT(0) + sig(kk)*qvTb(0)*de(1)
          qvTsig(-vsnow(kk)%nsnow+1:n-1) = qvT(-vsnow(kk)%nsnow+1:n-1) + &
               sig(kk)*(qvTa(-vsnow(kk)%nsnow+1:n-1)*de(-vsnow(kk)%nsnow+1:n-1) + &
               qvTb(-vsnow(kk)%nsnow+1:n-1)*de(-vsnow(kk)%nsnow+2:n))
          qvTsig(n)     = zero
          qlsig(-vsnow(kk)%nsnow+1:n-1)  = qsig(-vsnow(kk)%nsnow+1:n-1) - qvsig(-vsnow(kk)%nsnow+1:n-1)
          qlsig(n)      = qsig(n)
       END SELECT ! surface_case

       IF (botbc=="aquifer") THEN ! update aquifer props
          IF (v_aquifer(kk)%isat==0) THEN
             IF (v_aquifer(kk)%WA+(dwdrainage(kk)-dwdischarge(kk))*dt(kk) > &
                  (v_aquifer(kk)%zzero-v_aquifer(kk)%zsoil)*v_aquifer(kk)%Sy) THEN
                v_aquifer(kk)%isat = 1  ! aquifer saturated
                S(n) = S(n) + (-(v_aquifer(kk)%WA+(dwdrainage(kk)-dwdischarge(kk))*dt(kk)) &
                     +(v_aquifer(kk)%zzero-v_aquifer(kk)%zsoil)*v_aquifer(kk)%Sy)/(dx(n)*par(n)%thre)
             ENDIF
             v_aquifer(kk)%WA        = MIN(v_aquifer(kk)%WA+(dwdrainage(kk)-dwdischarge(kk))*dt(kk), &
                  (v_aquifer(kk)%zzero-v_aquifer(kk)%zsoil)*v_aquifer(kk)%Sy)
             v_aquifer(kk)%zdelta    = v_aquifer(kk)%zzero - v_aquifer(kk)%Wa/v_aquifer(kk)%Sy
             ! new discharge rate
             v_aquifer(kk)%discharge = v_aquifer(kk)%Rsmax*EXP(-v_aquifer(kk)%f*v_aquifer(kk)%zdelta)
          ELSEIF (v_aquifer(kk)%isat==1) THEN
             ! check for desat of aquifer
             IF (dwdrainage(kk) < v_aquifer(kk)%Rsmax*EXP(-v_aquifer(kk)%f*v_aquifer(kk)%zsoil)) THEN
                v_aquifer(kk)%isat      = 0
                v_aquifer(kk)%zdelta    = v_aquifer(kk)%zsoil
                ! new discharge rate
                v_aquifer(kk)%discharge = v_aquifer(kk)%Rsmax*EXP(-v_aquifer(kk)%f*v_aquifer(kk)%zdelta)
             ENDIF
          ENDIF
          zdelta(kk) = v_aquifer(kk)%zdelta
       ENDIF       ! end update aquifer props

       IF (botbc=="constant head") THEN
          drn(kk) = drn(kk)+(q(n)+sig(kk)*qya(n)*dy(n))*dt(kk)
       ELSE
          drn(kk) = drn(kk)+(q(n)+sig(kk)*qya(n)*dy(n))*dt(kk)
       END IF

       IF (PRESENT(wex)) THEN
          wex(kk,1:n) = wex(kk,1:n)+(iqex(1:n)+SPREAD(sig(kk),1,n)*qexd(1:n)*dy(1:n))*SPREAD(dt(kk),1,n)
       END IF

       IF (litter .AND. ns(kk)==1 ) THEN ! adjust litter moisture content if no ponding
          SL(kk)      = SL(kk) + dy(0)
          deltaSL(kk) = dy(0)
       ELSE
          deltaSL(kk) = zero
       ENDIF

       TL(kk) = TL(kk) + de(0)   ! Tlitter assumed the same as pond T
       IF (SL(kk) >= one) vlit(kk)%isat = 1   ! check for litter saturation

       csoil(:) = var(1:n)%csoil
       kth(:) = var(1:n)%kth
       phi(:) = var(1:n)%phi

       ! update snow pack water content and temperature (or liquid water)
       IF (vsnow(kk)%nsnow>0) THEN
          vsnow(kk)%Qadv_snow = vsnow(kk)%Qadv_snow + rhow*(qprec_snow(kk))* &
               (csice*(MIN(vmet(kk)%Ta,zero))-lambdaf)*dt(kk)
          vsnow(kk)%Qadv_rain = vsnow(kk)%Qadv_rain + rhow*(qprec(kk))*cswat*(MAX(vmet(kk)%Ta,zero))*dt(kk)

          ! update heat flux components
          Tqw  = MERGE(vmet(kk)%Ta, vsnow(kk)%tsn(vsnow(kk)%nsnow), -qevap(kk)>zero)

          !vsnow(kk)%Qadv_vap = vsnow(kk)%Qadv_vap + &
          !   rhow*(-qevapsig(kk))*cswat*Tqw*dt(kk) - &
          !    qadvsig(0)*dt(kk)

          vsnow(kk)%Qadv_vap =vsnow(kk)%Qadv_vap + (qadvsig(-vsnow(kk)%nsnow)-qadvsig(0))*dt(kk) - &
               rhow*(qprec_snow(kk))*(csice*(MIN(vmet(kk)%Ta,zero))-lambdaf)*dt(kk) - &
               rhow*(qprec(kk))*cswat*(vmet(kk)%Ta)*dt(kk)

          vsnow(kk)%Qcond_net = vsnow(kk)%Qcond_net + (qhsig(-vsnow(kk)%nsnow) -  qhsig(0))*dt(kk) - &
               (qadvsig(-vsnow(kk)%nsnow) -  qadvsig(0))*dt(kk)

          DO i=1, vsnow(kk)%nsnow
             IF (vsnow(kk)%hliq(i)>zero) THEN

                IF ((vsnow(kk)%hliq(i) + de(i-vsnow(kk)%nsnow))>(dy(i-vsnow(kk)%nsnow) + vsnow(kk)%hsnow(i))) THEN
                   ! account here for new hliq exceeding new hsnow
                   tmp1d1(kk) = vsnow(kk)%hliq(i)*cswat*rhow*zero + &
                        (vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow*(zero*csice-lambdaf)
                   tmp1d2(kk) = ((tmp1d1(kk) + LHS_h(i-vsnow(kk)%nsnow)*dt(kk)))/ &
                        ((dy(i-vsnow(kk)%nsnow) + vsnow(kk)%hsnow(i))*cswat*rhow)
                   vsnow(kk)%tsn(i) = tmp1d2(kk)

                   IF (vsnow(kk)%tsn(i)>zero) THEN
                      WRITE(*,*) 'T>zero ', irec, nsteps(kk), i, vsnow(kk)%tsn(i)
                   ENDIF

                   vsnow(kk)%deltaJlatent(i) = vsnow(kk)%deltaJlatent(i) + &
                        lambdaf*(vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow
                   vsnow(kk)%deltaJsensible(i) = vsnow(kk)%deltaJsensible(i) + LHS_h(i-vsnow(kk)%nsnow)*dt(kk) - &
                        lambdaf*(vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow
                   vsnow(kk)%hliq(i) = vsnow(kk)%hsnow(i) + dy(i-vsnow(kk)%nsnow)
                ELSEIF ((vsnow(kk)%hliq(i)+de(i-vsnow(kk)%nsnow))<zero) THEN
                   ! account here for new hliq less than zero
                   tmp1d1(kk) = (csice*(vsnow(kk)%tsn(i))-lambdaf)*rhow*(vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i)) + &
                        cswat*(vsnow(kk)%tsn(i))*rhow*vsnow(kk)%hliq(i) + LHS_h(i-vsnow(kk)%nsnow)*dt(kk)
                   delta_snowT(i)  = (tmp1d1(kk)/rhow/(dy(i-vsnow(kk)%nsnow) + vsnow(kk)%hsnow(i))+lambdaf)/csice
                   vsnow(kk)%tsn(i) = delta_snowT(i)

                   vsnow(kk)%deltaJlatent(i) = vsnow(kk)%deltaJlatent(i) - lambdaf*dy(i-vsnow(kk)%nsnow)*rhow + &
                        lambdaf*vsnow(kk)%hliq(i)*rhow
                   vsnow(kk)%deltaJsensible(i) = vsnow(kk)%deltaJsensible(i) + LHS_h(i-vsnow(kk)%nsnow)*dt(kk) - &
                        (- lambdaf*dy(i-vsnow(kk)%nsnow)*rhow + lambdaf*vsnow(kk)%hliq(i)*rhow)
                   vsnow(kk)%hliq(i) = zero
                ELSE
                   vsnow(kk)%hliq(i) = vsnow(kk)%hliq(i) + de(i-vsnow(kk)%nsnow)
                   delta_snowliq(i) = de(i-vsnow(kk)%nsnow)
                   delta_snowT(i) = zero
                   vsnow(kk)%deltaJlatent(i) = vsnow(kk)%deltaJlatent(i) - &
                        lambdaf*dy(i-vsnow(kk)%nsnow)*rhow + lambdaf*de(i-vsnow(kk)%nsnow)*rhow
                   vsnow(kk)%deltaJsensible(i) = vsnow(kk)%deltaJsensible(i) + &
                        dy(i-vsnow(kk)%nsnow)*rhow*csice*(vsnow(kk)%tsn(i)) + &
                        de(i-vsnow(kk)%nsnow)*rhow*(cswat-csice)*(vsnow(kk)%tsn(i))
                ENDIF
             ELSE !hliq = zero
                IF ((vsnow(kk)%tsn(i) + de(i-vsnow(kk)%nsnow))<zero) THEN
                   vsnow(kk)%deltaJlatent(i) = vsnow(kk)%deltaJlatent(i) - lambdaf*dy(i-vsnow(kk)%nsnow)*rhow
                   vsnow(kk)%deltaJsensible(i) = vsnow(kk)%deltaJsensible(i) + &
                        dy(i-vsnow(kk)%nsnow)*rhow*csice*(vsnow(kk)%tsn(i)) + &
                        de(i-vsnow(kk)%nsnow)*csice*rhow*hsnow(i)
                   vsnow(kk)%tsn(i) = vsnow(kk)%tsn(i) + de(i-vsnow(kk)%nsnow)
                   delta_snowT(i) = de(i-vsnow(kk)%nsnow)
                   delta_snowliq(i) = zero
                   vsnow(kk)%hliq(i) = zero
                ELSE ! vsnow(kk)%tsn + de(0))>zero
                   delta_snowT(i) = zero - vsnow(kk)%tsn(i)
                   delta_snowliq(i) = (LHS_h(i-vsnow(kk)%nsnow)*dt(kk) - &
                        delta_snowT(i)*csice*hsnow(i) *rhow - &
                        dy(i-vsnow(kk)%nsnow)*rhow*(csice*(vsnow(kk)%tsn(i))-lambdaf))/ &
                        (rhow*(zero*(cswat-csice)+lambdaf))

                   vsnow(kk)%hliq(i) = vsnow(kk)%hliq(i) + delta_snowliq(i)
                   vsnow(kk)%deltaJlatent(i) = vsnow(kk)%deltaJlatent(i) &
                        - lambdaf*dy(i-vsnow(kk)%nsnow)*rhow + &
                        lambdaf*rhow*delta_snowliq(i)
                   vsnow(kk)%deltaJsensible(i) = vsnow(kk)%deltaJsensible(i)  &
                        + dy(i-vsnow(kk)%nsnow)*rhow*csice*(vsnow(kk)%tsn(i)) + &
                        delta_snowT(i)*csice*rhow*hsnow(i)
                   vsnow(kk)%tsn(i) = vsnow(kk)%tsn(i) + delta_snowT(i)
                ENDIF ! vsnow(kk)%tsn + de(0))>zero
             ENDIF ! hliq = zero
             vsnow(kk)%hsnow(i) = dy(i-vsnow(kk)%nsnow) + vsnow(kk)%hsnow(i)
             vsnow(kk)%Jsensible(i) = (vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow*csice*(vsnow(kk)%Tsn(i))
             vsnow(kk)%Jlatent(i) = (vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow*(-lambdaf)

             delta_snowcol(i) = dy(i-vsnow(kk)%nsnow)
          ENDDO ! loop over snow layers
          ! total internal energy and water content of snowpack
          vsnow(kk)%wcol = SUM(vsnow(kk)%hsnow(1:vsnow(kk)%nsnow))
          vsnow(kk)%deltawcol = vsnow(kk)%wcol - wcol0snow(kk)
          vsnow(kk)%Qprec = vsnow(kk)%Qprec + qprec_snow(kk)*dt(kk) + qprec(kk)*dt(kk)
          vsnow(kk)%Qevap = vsnow(kk)%Qevap + qevapsig(kk)*dt(kk)
          vsnow(kk)%Qvap = vsnow(kk)%Qvap + qsig(0)*dt(kk)

          vsnow(kk)%J = SUM(vsnow(kk)%Jsensible(1:vsnow(kk)%nsnow)+vsnow(kk)%Jlatent(1:vsnow(kk)%nsnow))

          vsnow(kk)%deltaJ = vsnow(kk)%J - J0snow(kk)

          IF (vsnow(kk)%nsnow.LT.nsnow_max) THEN
             vsnow(kk)%hsnow(vsnow(kk)%nsnow+1:nsnow_max) = zero
          ENDIF

          ! update densities and depths of snow layers

          ! effect of new snowfall

          ! snowfall density (tmp1d1), LaChapelle 1969
          IF (vmet(kk)%Ta > 2.0_r_2) THEN
             tmp1d1(kk) = 189.0_r_2
          ELSEIF ((vmet(kk)%Ta > -15.0_r_2) .AND. (vmet(kk)%Ta <= 2.0_r_2)) THEN
             tmp1d1(kk) = 50.0_r_2 + 1.7_r_2*(vmet(kk)%Ta+15.0_r_2)**1.5_r_2
          ELSE
             tmp1d1(kk) = 50.0_r_2
          ENDIF

          IF ((vsnow(kk)%hsnow(1)-qprec_snow(kk)*dt(kk)) > 1.e-3_r_2) THEN
             vsnow(kk)%dens(1) = (vsnow(kk)%dens(1)*(vsnow(kk)%hsnow(1)-qprec_snow(kk)*dt(kk)) &
                  + tmp1d1(kk)*qprec_snow(kk)*dt(kk))/vsnow(kk)%hsnow(1)
          ENDIF

          DO i=1, vsnow(kk)%nsnow
             vsnow(kk)%depth(i) = vsnow(kk)%hsnow(i)/(vsnow(kk)%dens(i)/rhow)

             ! adjust depth for compaction
             IF (vsnow(kk)%hliq(i) .GT. zero) THEN
                tmp1d1(kk) = MERGE(one, EXP(-0.06_r_2*(vsnow(kk)%dens(i)-150._r_2)), vsnow(kk)%dens(i)<150._r_2)
                tmp1d2(kk) = 2
             ELSE
                tmp1d1(kk) = MERGE(one, EXP(-0.046_r_2*(vsnow(kk)%dens(i)-150._r_2)), vsnow(kk)%dens(i)<150._r_2)
                tmp1d2(kk) = 1
             ENDIF
             tmp1d3(kk) =  vsnow(kk)%hsnow(i)*rhow/2._r_2    ! overburden kg/m2
             IF (i.GT.1) THEN
                tmp1d3(kk) = tmp1d3(kk) + SUM(vsnow(kk)%hsnow(1:i-1)*rhow)
             ENDIF

             IF (vsnow(kk)%depth(i)*dt(kk)* &
                  (2.8e-6_r_2*tmp1d1(kk)*tmp1d2(kk)*EXP(-vsnow(kk)%tsn(i)/25.0_r_2) + &
                  tmp1d3(kk)/3.6e6_r_2*EXP(-0.08_r_2*vsnow(kk)%tsn(i))*EXP(-0.023_r_2*vsnow(kk)%dens(i))) &
                  .LT.0.5_r_2*vsnow(kk)%depth(i)) THEN
                vsnow(kk)%depth(i) = vsnow(kk)%depth(i) - vsnow(kk)%depth(i)*dt(kk)* &
                     (2.8e-6_r_2*tmp1d1(kk)*tmp1d2(kk)*EXP(-vsnow(kk)%tsn(i)/25.0_r_2) + & ! metamorphism
                     tmp1d3(kk)/3.6e6_r_2*EXP(-0.08_r_2*vsnow(kk)%tsn(i))*EXP(-0.023_r_2*vsnow(kk)%dens(i))) ! overburden
             ENDIF
             vsnow(kk)%dens(i) = vsnow(kk)%hsnow(i)*rhow/vsnow(kk)%depth(i)
          ENDDO

       ENDIF ! end update snowlayers
       vsnow(kk)%MoistureFluxDivergence = vsnow(kk)%Qprec - vsnow(kk)%Qevap - vsnow(kk)%Qvap &
            - vsnow(kk)%Qmelt +  vsnow(kk)%Qtransfer
       vsnow(kk)%FluxDivergence = vsnow(kk)%Qadv_rain + vsnow(kk)%Qadv_snow + vsnow(kk)%Qadv_vap + &
            vsnow(kk)%Qadv_melt + vsnow(kk)%Qcond_net  +  vsnow(kk)%Qadv_transfer

    ENDIF ! .not. again

  END SUBROUTINE update_unknowns

  SUBROUTINE get_and_solve_eqn( &
       irec, mp, qprec,  n, dx, h0, S, thetai, &
       Tsoil,       &
       qh, nsteps,  vlit, vsnow, var,     &
       dxL,    &
       plit, par,        &
       deltaTa, &
       qevap, qL, qhL, qybL, qTbL, qhTbL, qhybL,    &
       again,  again_ice,  iok, itmp, ns,  &
       accel,  dt,   fac,   &
       phip,  rsig, rsigdt, sig, t,      &
       qexd, aa, bb, cc, dd, ee, ff, gg, dy, aah, bbh, cch, ddh, eeh, ffh, ggh, &
       de, q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb, qadv, qadvya, qadvyb, &
       qadvTa, qadvTb,  qsig, qhsig, qadvsig,      &
       dTsoil, tmp2d1,   &
       dthetaldT,   nsteps_ice, imelt,     &
       deltaJ_latent_T, deltaJ_sensible_S,   &
       qrunoff, tmp1d1, tmp1d2, tmp1d3,  tmp1d4,     &
       G0, &
       Tfreezing,   LHS, RHS, LHS_h, RHS_h,  nns, &
       iflux, litter, i,   kk, condition,   &
       advection,  c2, theta,     cp, &
       cpeff, hice,    h0_tmp,   hsnow, &
       delta_snowT, &
       delta_snowliq,    J0,   iqex,  &
       nfac1, nfac2, nfac3, nfac4, nfac5, nfac6, nfac7, nfac8, nfac9, &
       nfac10, nfac11, nfac12, err  &
       )
    IMPLICIT NONE
    INTEGER(i_d)                                           :: irec, mp
    REAL(r_2),      DIMENSION(1:mp)                        :: qprec
    INTEGER(i_d)                                           :: n
    REAL(r_2),      DIMENSION(1:n) :: dx
    REAL(r_2),      DIMENSION(1:mp)                        :: h0
    REAL(r_2),      DIMENSION(1:n) :: S
    REAL(r_2),      DIMENSION(1:n) :: thetai
    REAL(r_2),      DIMENSION(1:n) :: Tsoil
    REAL(r_2),      DIMENSION(-nsnow_max:n) :: qh
    INTEGER(i_d),   DIMENSION(1:mp)                        :: nsteps
    TYPE(vars),     DIMENSION(1:mp)                        :: vlit
    TYPE(vars_snow), DIMENSION(1:mp)                       :: vsnow
    TYPE(vars),     DIMENSION(1:n) :: var
    REAL(r_2),      DIMENSION(1:mp)                        :: dxL
    TYPE(params),   DIMENSION(1:mp)                        :: plit
    TYPE(params),   DIMENSION(1:n) :: par
    REAL(r_2),      DIMENSION(1:mp)                        :: deltaTa
    REAL(r_2),    DIMENSION(1:mp)                          :: qevap
    REAL(r_2),    DIMENSION(1:mp)                          :: qL, qhL, qybL, qTbL, qhTbL, qhybL
    LOGICAL,      DIMENSION(1:mp)                          :: again
    LOGICAL,      DIMENSION(1:mp,1:n)                      :: again_ice
    INTEGER(i_d), DIMENSION(1:mp)                          :: iok, itmp, ns
    REAL(r_2),    DIMENSION(1:mp)                          :: accel, dt, fac, phip
    REAL(r_2),    DIMENSION(1:mp)                          :: rsig, rsigdt, sig, t
    REAL(r_2),    DIMENSION(1:n) :: qexd
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: aa, bb, cc, dd, ee, ff, gg, dy
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: aah, bbh, cch, ddh, eeh, ffh, ggh, de
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qadv, qadvya, qadvyb, qadvTa, qadvTb
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qsig, qhsig, qadvsig
    REAL(r_2),    DIMENSION(1:n) :: dTsoil
    REAL(r_2),    DIMENSION(0:n) :: tmp2d1
    REAL(r_2),    DIMENSION(1:n) :: dthetaldT
    INTEGER(i_d), DIMENSION(1:n) :: nsteps_ice, imelt
    REAL(r_2),          DIMENSION(1:n) :: deltaJ_latent_T, deltaJ_sensible_S
    REAL(r_2),          DIMENSION(1:mp)                    :: qrunoff
    REAL(r_2),          DIMENSION(1:mp)                    :: tmp1d1, tmp1d2, tmp1d3,  tmp1d4
    REAL(r_2),          DIMENSION(1:mp)                    :: G0
    REAL(r_2),          DIMENSION(1:mp)                    :: Tfreezing
    REAL(r_2),          DIMENSION(-nsnow_max+1:n) :: LHS, RHS, LHS_h, RHS_h
    INTEGER(i_d),       DIMENSION(1:mp)                    :: nns, iflux
    LOGICAL                                                :: litter
    INTEGER(i_d)                                           :: i, kk, condition
    INTEGER(i_d)                                           :: advection ! switches
    REAL(r_2)                                              :: c2, theta
    REAL(r_2),          DIMENSION(1:mp)                    :: cp, cpeff, hice, h0_tmp
    REAL(r_2),          DIMENSION(nsnow_max) :: hsnow
    REAL(r_2),          DIMENSION(nsnow_max) :: delta_snowT, delta_snowliq
    REAL(r_2),      DIMENSION(1:n) :: J0
    REAL(r_2),          DIMENSION(1:n) :: iqex
    INTEGER(i_d),       DIMENSION(1:mp)                    :: nfac1, nfac2, nfac3, nfac4, nfac5, &
         nfac6, nfac7, nfac8, nfac9, nfac10, nfac11, nfac12
    ! Error flag if nstep of SLI > nsteps_max: err=0 -> no error; err/=0 -> error
    INTEGER(i_d),       INTENT(INOUT), OPTIONAL            :: err

    iok(kk)         = 0 ! flag for time step test
    itmp(kk)        = 0 ! counter to abort if not getting solution
    again_ice(kk,:) = .FALSE.
    nsteps_ice(1:n) = 0
    h0_tmp(kk) = h0(kk)
    DO WHILE (iok(kk)==0) ! keep reducing time step until all ok
       itmp(kk)  = itmp(kk) + 1
       accel(kk) = one - 0.05_r_2*REAL(MIN(10,MAX(0,itmp(kk)-4)),r_2) ! acceleration [0.5,1], start with 1
       IF (itmp(kk) > 1000) THEN
          WRITE(logn,*) "Solve: too many iterations of equation solution"
          WRITE(logn,*) " irec, kk, S"
          WRITE(logn,*) irec, kk, S(:)
          WRITE(logn,*) " irec, kk, Tsoil"
          WRITE(logn,*) irec, kk, Tsoil(:)
          WRITE(logn,*) " irec, kk, qex"
          WRITE(logn,*) irec, kk, iqex(:)
          WRITE(logn,*) " irec, kk, h0, hsnow, hsnowliq"
          WRITE(logn,*) irec, kk, h0(kk), vsnow(kk)%hsnow, vsnow(kk)%hliq
          WRITE(logn,*) nfac1(kk), nfac2(kk), nfac3(kk), nfac4(kk), nfac5(kk), &
               nfac6(kk), nfac7(kk), nfac8(kk), nfac9(kk), nfac10(kk), nfac11(kk), nfac12(kk)
          err = 1
          RETURN
       END IF

       ! prelim estimate of new top snow layer depth for use in energy cons eq'n             !
       IF ((vsnow(kk)%nsnow>0))  THEN
          hsnow(1:vsnow(kk)%nsnow) = vsnow(kk)%hsnow(1:vsnow(kk)%nsnow) + &
               (-q(1-vsnow(kk)%nsnow:0) + q(-vsnow(kk)%nsnow:-1))*dt(kk)
       ENDIF

       aa(1:n)   =  qya(0:n-1)
       ee(0:n-1) = -qyb(0:n-1)
       bb(1:n)   =  qTa(0:n-1)
       ff(0:n-1) = -qTb(0:n-1)
       gg(1:n) = -(q(0:n-1)-q(1:n)-iqex(1:n))*rsig(kk)
       gg(1) = gg(1)+qrunoff(kk)*rsig(kk)

       aah(1:n)   =  qhya(0:n-1)
       eeh(0:n-1) = -qhyb(0:n-1)
       bbh(1:n)   =  qhTa(0:n-1)
       ffh(0:n-1) = -qhTb(0:n-1)
       ggh(1:n) =  -(qh(0:n-1)-qh(1:n))*rsig(kk)

       IF (advection==1) THEN
          ggh(1:n) = ggh(1:n) + iqex(1:n)*rsig(kk)*(Tsoil(1:n))*cswat*rhow
          ggh(1) = ggh(1) + qrunoff(kk)*rsig(kk)*(Tsoil(1))*cswat*rhow
       ENDIF

       IF (litter) THEN ! full litter model: litter in zeroth layer
          ! only use zeroth layer for litter (pond included in layer 1)
          WRITE(*,*) 'Should not be here - QYBL 01 ', qybl(kk)
          cc(0) = -qya(0) - rsigdt(kk)*plit(kk)%thre*dxL(kk) + qybL(kk)
          gg(0)  = -(qprec(kk)-qevap(kk)-q(0))*rsig(kk)
          ggh(0) = -(G0(kk)-qh(0))*rsig(kk)
          dd(0)  = -qTa(0)
       ENDIF
       aa(0)  = qya(0)
       aah(0) = zero
       bbh(0) = zero

       WHERE (var(1:n)%isat==0) ! unsaturated layers
          cc(1:n) = qyb(0:n-1) - qya(1:n) - par(1:n)%thre*dx(1:n)*rsigdt(kk) - qexd(1:n)
       ELSEWHERE ! saturated layers
          cc(1:n) = qyb(0:n-1) - qya(1:n) - qexd(1:n)
       endwhere

       IF (ns(kk)<1) THEN ! pond included in top soil layer, solving for change in pond height
          cc(1) = -qya(1)-rsigdt(kk) -qexd(1)
       ENDIF

       cch(1:n) = qhyb(0:n-1)-qhya(1:n) +   &
            REAL(var(1:n)%iice,r_2)*REAL(1-var(1:n)%isat,r_2)*rhow*lambdaf*par(1:n)%thre*dx(1:n)*rsigdt(kk)

       IF (ns(kk)==0) THEN ! change in pond height (top layer saturated)
          cch(1) = cch(1) +  &
               REAL(var(1)%iice,r_2)*rhow*lambdaf*rsigdt(kk)*(var(1)%thetai/par(1)%thre)
       ENDIF

       ! modification to cch for advection
       IF (advection==1) THEN
          IF (ns(kk)==0) THEN  ! changing pond included in top soil layer
             cch(1) = cch(1) -rhow*cswat*(Tsoil(1))*rsigdt(kk)*REAL(1-var(1)%iice,r_2) &
                  -rhow*csice*(Tsoil(1))*rsigdt(kk)*REAL(var(1)%iice,r_2) &
                  *(var(1)%thetai/par(1)%thre) &
                  -rhow*cswat*(Tsoil(1))*rsigdt(kk)*REAL(var(1)%iice,r_2)* &
                  (one-(var(1)%thetai/par(1)%thre))
          ELSE ! no pond
             cch(1) = cch(1) -rhow*(Tsoil(1))*par(1)%thre*dx(1)*rsigdt(kk)* &
                  REAL(1-var(1)%isat,r_2)*(cswat*REAL(1-var(1)%iice,r_2) &
                  +csice*REAL(var(1)%iice,r_2))
          ENDIF

          cch(2:n) = cch(2:n) -rhow*(Tsoil(2:n))*par(2:n)%thre*dx(2:n)*rsigdt(kk)* &
               REAL(1-var(2:n)%isat,r_2)*(cswat*REAL(1-var(2:n)%iice,r_2) &
               +csice*REAL(var(2:n)%iice,r_2))
       ENDIF

       dd(1:n)  = qTb(0:n-1)-qTa(1:n)

       ddh(1:n) = qhTb(0:n-1)-qhTa(1:n) - &
                                ! Only apply latent heat component of heat capacity to total deltaT if soil remains frozen
            var(1:n)%csoileff*dx(1:n)*rsigdt(kk)- &
            (cswat-csice)*dx(1:n)*var(1:n)%dthetaldt*rhow*(Tsoil(1:n))* &
            rsigdt(kk)*REAL(var(1:n)%iice,r_2)
       ! modification to ddh(1) for pond
       ddh(1) = ddh(1) - cpeff(kk)*h0_tmp(kk)*rsigdt(kk) - &
            (cswat-csice)*h0(kk)/par(1)%thre*var(1)%dthetaldt*rhow*(Tsoil(1))* &
            rsigdt(kk)*REAL(var(1)%iice,r_2)

       IF (advection==1) THEN
          ddh(1:n) = ddh(1:n) - iqex(1:n)*cswat*rhow
          ddh(1) = ddh(1) - qrunoff(kk)*cswat*rhow
       ENDIF

       ! modification of matrix to incorporate single snow layer
       IF (vsnow(kk)%nsnow==1) THEN
          cc(0) = qyb(-1)-qya(0)-rsigdt(kk)
          dd(0) =  qTb(-1)-qTa(0)
          ee(0) =   -qyb(0)
          ff(0) =   -qTb(0)
          gg(0) = -(q(-1)-q(0))*rsig(kk)
          IF (vsnow(kk)%hliq(1)>zero) THEN ! liquid phase present, solve for change in liq content
             ddh(0) =  - rhow*((vsnow(kk)%tsn(1))*(cswat-csice)+lambdaf)*rsigdt(kk)
          ELSE ! solid phase only; solve for change in snow t
             ddh(0) = qhTb(-1) - qhTa(0) - rhow*csice*hsnow(1)*rsigdt(kk)
          ENDIF
          cch(0) = qhyb(-1)-qhya(0) - rhow*(csice*(vsnow(kk)%tsn(1))-lambdaf)*rsigdt(kk)
          eeh(0) = -qhyb(0)
          ffh(0) = -qhTb(0)
          ggh(0) = -(qh(-1)-qh(0))*rsig(kk)
       ENDIF
       ! modification of matrix to incorporate more than one snow layer
       IF (vsnow(kk)%nsnow>1) THEN
          aa(1-vsnow(kk)%nsnow:0)   =  qya(-vsnow(kk)%nsnow:-1)
          bb(1-vsnow(kk)%nsnow:0)   =  qTa(-vsnow(kk)%nsnow:-1)
          cc(1-vsnow(kk)%nsnow:0) = qyb(-vsnow(kk)%nsnow:-1)-qya(1-vsnow(kk)%nsnow:0)-rsigdt(kk)
          dd(1-vsnow(kk)%nsnow:0) =  qTb(-vsnow(kk)%nsnow:-1)-qTa(1-vsnow(kk)%nsnow:0)
          ee(1-vsnow(kk)%nsnow:0) =   -qyb(1-vsnow(kk)%nsnow:0)
          ff(1-vsnow(kk)%nsnow:0) =   -qTb(1-vsnow(kk)%nsnow:0)
          gg(1-vsnow(kk)%nsnow:0) = -(q(-vsnow(kk)%nsnow:-1)-q(1-vsnow(kk)%nsnow:0))*rsig(kk)
          ddh(1-vsnow(kk)%nsnow:0) = MERGE( & ! liquid phase present, solve for change in liq content
               -rhow*((vsnow(kk)%tsn(1:vsnow(kk)%nsnow))*(cswat-csice)+lambdaf)*rsigdt(kk), &
               qhTb(-vsnow(kk)%nsnow:-1) - qhTa(1-vsnow(kk)%nsnow:0) - &
               rhow*csice*hsnow(1:vsnow(kk)%nsnow)*rsigdt(kk), & ! solid phase only; solve for change in snow t
               vsnow(kk)%hliq(1:vsnow(kk)%nsnow) > zero)
          aah(1-vsnow(kk)%nsnow:0)   =  qhya(-vsnow(kk)%nsnow:-1)
          bbh(1-vsnow(kk)%nsnow:0)   =  qhTa(-vsnow(kk)%nsnow:-1)

          cch(1-vsnow(kk)%nsnow:0) = qhyb(-vsnow(kk)%nsnow:-1)-qhya(1-vsnow(kk)%nsnow:0) - &
               rhow*(csice*(vsnow(kk)%tsn(1:vsnow(kk)%nsnow))-lambdaf)*rsigdt(kk)
          eeh(1-vsnow(kk)%nsnow:0) = -qhyb(1-vsnow(kk)%nsnow:0)
          ffh(1-vsnow(kk)%nsnow:0) = -qhTb(1-vsnow(kk)%nsnow:0)
          ggh(1-vsnow(kk)%nsnow:0) = -(qh(-vsnow(kk)%nsnow:-1)-qh(1-vsnow(kk)%nsnow:0))*rsig(kk)
       ENDIF
       IF (litter .AND. ns(kk)==1) THEN ! litter and no pond
          ! watch for deltaTa
          WRITE(*,*) 'Should not be here - QYBL 02 ', qybl(kk)
          cc(0)  = qybL(kk) -qya(0) -rsigdt(kk)*plit(kk)%thre*dxL(kk)
          dd(0)  = qTbL(kk) - qTa(0)
          ee(0)  = -qyb(0)
          ff(0)  = -qTb(0)
          gg(0)  = (q(0) - qL(kk))*rsig(kk) + deltaTa(kk)*(qTbL(kk)-qTa(0))
          gg(1)  = -(q(0)-q(1)-iqex(1))*rsig(kk) + deltaTa(kk)*qTa(0)
          cch(0) = qhybL(kk) - qhya(0)
          ddh(0) = -qhTa(0)-vlit(kk)%csoil*dxL(kk)*rsigdt(kk)+qhTbL(kk)
          eeh(0) = -qhyb(0)
          ffh(0) = -qhTb(0)
          ggh(0) = (qh(0)-qhL(kk))*rsig(kk) + deltaTa(kk)*(qhTbL(kk) - qhTa(0))
          ggh(1) = -(qh(0)-qh(1))*rsig(kk) + deltaTa(kk)*qhTa(0)
       ENDIF

       ! litter and pond !vh! need to check this now that pond is lumped with top soil layer
       IF (litter .AND. ns(kk)==0) THEN
          ddh(0) = -qhTa(0)-cswat*rhow*h0(kk)*rsigdt(kk) -vlit(kk)%csoil*dxL(kk)*rsigdt(kk)
       ENDIF

       nns(kk) = 1  ! pond included in top soil layer
       IF (vsnow(kk)%nsnow>0) THEN
          nns(kk) = 1-vsnow(kk)%nsnow
       ENDIF

       CALL massman_sparse(aa(nns(kk)+1:n), aah(nns(kk)+1:n), bb(nns(kk)+1:n), bbh(nns(kk)+1:n), &
            cc(nns(kk):n), cch(nns(kk):n), dd(nns(kk):n), ddh(nns(kk):n), ee(nns(kk):n-1), &
            eeh(nns(kk):n-1), &
            ff(nns(kk):n-1), ffh(nns(kk):n-1), gg(nns(kk):n), ggh(nns(kk):n), &
            dy(nns(kk):n), de(nns(kk):n), condition=condition, err=err)
       IF (err /= 0) THEN
          WRITE(logn,*) "Sparse matrix solution failed ", irec, kk
          WRITE(logn,*) Tsoil(1), S(1)
          RETURN
       ENDIF

       dTsoil(1:n) = de(1:n)


       WHERE (vsnow(kk)%hliq(:)>zero)
          delta_snowT(:) = zero
       ELSEWHERE
          delta_snowT(:) = de(LBOUND(de,1):0)
       endwhere

       ! evaluate soil fluxes at sigma of time step
       qsig(0)  = q(0)+sig(kk)*qyb(0)*dy(1) + sig(kk)*qya(0)*dy(0) + &
            sig(kk)*qTb(0)*dTsoil(1) + sig(kk)*qTa(0)*de(0)

       qhsig(0) = qh(0) + sig(kk)*qhyb(0)*dy(1) + sig(kk)*qhya(0)*dy(0) + &
            sig(kk)*qhTb(0)*dTsoil(1) + sig(kk)*qhTa(0)*de(0)

       qadvsig(0) = qadv(0) + sig(kk)*qadvyb(0)*dy(1) &
            + sig(kk)*qadvya(0)*dy(0) + sig(kk)*qadvTb(0)*dTsoil(1) + sig(kk)*qadvTa(0)*de(0)

       qsig(1:n-1) = q(1:n-1) + sig(kk)*(qya(1:n-1)*dy(1:n-1)+qyb(1:n-1)*dy(2:n) &
            +qTa(1:n-1)*dTsoil(1:n-1)+qTb(1:n-1)*dTsoil(2:n))
       qsig(n)     = q(n) + sig(kk)*(qya(n)*dy(n)+qTa(n)*dTsoil(n))

       qhsig(1:n-1) = qh(1:n-1) + sig(kk)*(qhya(1:n-1)*dy(1:n-1)+qhyb(1:n-1)*dy(2:n) &
            +qhTa(1:n-1)*dTsoil(1:n-1)+qhTb(1:n-1)*dTsoil(2:n))
       qhsig(n) = qh(n) + sig(kk)*(qhya(n)*dy(n)+qhTa(n)*dTsoil(n))

       qadvsig(1:n-1) = qadv(1:n-1) + sig(kk)*(qadvya(1:n-1)*dy(1:n-1)+qadvyb(1:n-1)*dy(2:n) &
            +qadvTa(1:n-1)*dTsoil(1:n-1)+qadvTb(1:n-1)*dTsoil(2:n))
       qadvsig(n) = qadv(n) + sig(kk)*(qadvya(n)*dy(n)+qadvTa(n)*dTsoil(n))

       LHS_h(1) = (dx(1)*var(1)%csoileff+h0_tmp(kk)*cpeff(kk))*dTsoil(1)/dt(kk) - &
            dy(1)*par(1)%thre*dx(1)*rhow*lambdaf/dt(kk)*var(1)%iice* &
            REAL(1-var(1)%isat,r_2) - &
            dy(1)*(var(1)%thetai/par(1)%thre)*rhow*lambdaf/dt(kk)*REAL(1-ns(kk),r_2)* &
            var(1)%iice  + &
            var(1)%dthetaldT*(Tsoil(1))*rhow*(cswat-csice)*dx(1)*dTsoil(1)/dt(kk)* &
            var(1)%iice + &
            var(1)%dthetaldT*(Tsoil(1))*rhow*(cswat-csice)*h0(kk)/par(1)%thre* &
            dTsoil(1)/dt(kk)*var(1)%iice

       LHS_h(2:n) = (dx(2:n)*var(2:n)%csoileff)*dTsoil(2:n)/dt(kk)  - &
            dy(2:n)*par(2:n)%thre*dx(2:n)*rhow*lambdaf/dt(kk)*var(2:n)%iice* &
            REAL(1-var(2:n)%isat,r_2) + &
            var(2:n)%dthetaldT*(Tsoil(2:n))*rhow*(cswat-csice)*dx(2:n)* &
            dTsoil(2:n)/dt(kk)*var(2:n)%iice

       RHS_h(1:n) = qhsig(0:n-1) -qhsig(1:n)

       IF (advection==1) THEN
          LHS_h(1:n) = LHS_h(1:n) &
               + REAL(1-var(1:n)%iice,r_2) * REAL(1-var(1:n)%isat,r_2) * &
               dx(1:n) * dy(1:n)/dt(kk) * par(1:n)%thre * (Tsoil(1:n)) * rhow * cswat &
               + REAL(var(1:n)%iice,r_2) * REAL(1-var(1:n)%isat,r_2) * &
               dx(1:n) * dy(1:n)/dt(kk) * par(1:n)%thre * rhow * csice * (Tsoil(1:n))

          LHS_h(1) = LHS_h(1) &
               + REAL(1-ns(kk),r_2) * REAL(1-var(1)%iice,r_2) * &
               dy(1)/dt(kk) * rhow * cswat * (Tsoil(1)) &
               + REAL(1-ns(kk),r_2) * REAL(var(1)%iice,r_2)* &
               dy(1)/dt(kk) * rhow * csice * (Tsoil(1)) * (var(1)%thetai/par(1)%thre) &
               + REAL(1-ns(kk),r_2) * REAL(var(1)%iice,r_2)  * &
               dy(1)/dt(kk) * rhow * cswat * (Tsoil(1)) * (one-(var(1)%thetai/par(1)%thre))

          RHS_h(1:n) = RHS_h(1:n) - iqex(1:n)*cswat*rhow*(Tsoil(1:n)+ sig(kk)*dTsoil(1:n))
          RHS_h(1) = RHS_h(1) - qrunoff(kk)*cswat*rhow*(Tsoil(1) + sig(kk)*dTsoil(1))
       ENDIF

       ! check mass balance on top soil layer
       IF (ns(kk)==0) THEN  ! pond included in top soil layer
          LHS(1) = dy(1)/dt(kk)
       ELSE
          LHS(1) = dy(1)*par(1)%thre*dx(1)*REAL(-var(1)%isat+1)/dt(kk)
       ENDIF
       RHS(1) = qsig(0) - qsig(1)- iqex(1) - qrunoff(kk)
       LHS(2:n) = dy(2:n)*par(2:n)%thre*dx(2:n)*REAL(-var(2:n)%isat+1)/dt(kk)
       RHS(2:n) = qsig(1:n-1) - qsig(2:n)- iqex(2:n)
       ! snow pack
       IF (vsnow(kk)%nsnow>0) THEN

          qsig(-vsnow(kk)%nsnow:-1)  = q(-vsnow(kk)%nsnow:-1)+sig(kk)*qyb(-vsnow(kk)%nsnow:-1)* &
               dy(1-vsnow(kk)%nsnow:0) +  sig(kk)*qTb(-vsnow(kk)%nsnow:-1)*de(1-vsnow(kk)%nsnow:0)

          qhsig(-vsnow(kk)%nsnow:-1) = qh(-vsnow(kk)%nsnow:-1) + sig(kk)*qhyb(-vsnow(kk)%nsnow:-1)* &
               dy(1-vsnow(kk)%nsnow:0) + sig(kk)*qhTb(-vsnow(kk)%nsnow:-1)*de(1-vsnow(kk)%nsnow:0)

          qadvsig(-vsnow(kk)%nsnow:-1) = qadv(-vsnow(kk)%nsnow:-1) + &
               sig(kk)*qadvyb(-vsnow(kk)%nsnow:-1)*dy(1-vsnow(kk)%nsnow:0) + &
               sig(kk)*qadvTb(-vsnow(kk)%nsnow:-1)*de(1-vsnow(kk)%nsnow:0)

          IF (vsnow(kk)%nsnow>1) THEN
             qsig(1-vsnow(kk)%nsnow:-1) = qsig(1-vsnow(kk)%nsnow:-1) + &
                  sig(kk)*qya(1-vsnow(kk)%nsnow:-1)*dy(1-vsnow(kk)%nsnow:-1) + &
                  sig(kk)*qTa(1-vsnow(kk)%nsnow:-1)*de(1-vsnow(kk)%nsnow:-1)

             qhsig(1-vsnow(kk)%nsnow:-1) = qhsig(1-vsnow(kk)%nsnow:-1)  + &
                  sig(kk)*qhya(1-vsnow(kk)%nsnow:-1)*dy(1-vsnow(kk)%nsnow:-1) + &
                  sig(kk)*qhTa(1-vsnow(kk)%nsnow:-1)*de(1-vsnow(kk)%nsnow:-1)

             qadvsig(1-vsnow(kk)%nsnow:-1) = qadvsig(1-vsnow(kk)%nsnow:-1) + &
                  sig(kk)*qadvya(1-vsnow(kk)%nsnow:-1)*dy(1-vsnow(kk)%nsnow:-1) + &
                  sig(kk)*qadvTa(1-vsnow(kk)%nsnow:-1)*de(1-vsnow(kk)%nsnow:-1)

          ENDIF

          ! rate of change of snow water col
          RHS(1-vsnow(kk)%nsnow:0) = qsig(-vsnow(kk)%nsnow:-1) - qsig(1-vsnow(kk)%nsnow:0)
          LHS(1-vsnow(kk)%nsnow:0) = dy(1-vsnow(kk)%nsnow:0)/dt(kk)
          RHS_h(1-vsnow(kk)%nsnow:0) = qhsig(-vsnow(kk)%nsnow:-1) - qhsig(1-vsnow(kk)%nsnow:0)
          LHS_h(1-vsnow(kk)%nsnow:0) = MERGE( &  ! liquid phase present, solve for change in liq content
               (dy(1-vsnow(kk)%nsnow:0)* rhow*(csice*(vsnow(kk)%tsn(1:vsnow(kk)%nsnow))-lambdaf) + &
               de(1-vsnow(kk)%nsnow:0)*rhow*((cswat-csice)*(vsnow(kk)%tsn(1:vsnow(kk)%nsnow))+lambdaf))/dt(kk), &
               (dy(1-vsnow(kk)%nsnow:0)*rhow* (csice*(vsnow(kk)%tsn(1:vsnow(kk)%nsnow))-lambdaf) + &
               de(1-vsnow(kk)%nsnow:0)*csice*rhow*hsnow(1:vsnow(kk)%nsnow))/dt(kk), &
               vsnow(kk)%hliq(1:vsnow(kk)%nsnow)>zero)

       ENDIF ! snow pack

       tmp1d1 = nless
       ! dy contains dS or, for sat layers, dphi values
       iok(kk) = 1
       fac(kk) = one

       IF (.NOT. again(kk)) THEN

          ! check if time step ok, if not then set fac to make it less
          iok(kk) = 1
          IF (vsnow(kk)%nsnow>0) THEN
             DO i=1, vsnow(kk)%nsnow
                IF ((vsnow(kk)%hsnow(i) + dy(i-vsnow(kk)%nsnow))<zero) THEN
                   fac(kk) = 0.99_r_2*vsnow(kk)%hsnow(i)/ABS(dy(i-vsnow(kk)%nsnow))
                   nfac6(kk) = nfac6(kk)+1
                   iok(kk) = 0
                   EXIT
                ENDIF

                IF (vsnow(kk)%hliq(i)>zero) THEN
                   IF ((vsnow(kk)%hliq(i) + de(i-vsnow(kk)%nsnow))>(dy(i-vsnow(kk)%nsnow) + &
                        vsnow(kk)%hsnow(i))) THEN

                      ! adjust fac such that the residual snow layer will be removed at the next call to snow_adjust
                      fac(kk) = 0.99_r_2*(vsnow(kk)%hsnow(i) - vsnow(kk)%hliq(i))/ &
                           (de(i-vsnow(kk)%nsnow)-dy(i-vsnow(kk)%nsnow))
                      nfac7(kk) = nfac7(kk)+1
                      iok(kk) =0

                      EXIT
                   ENDIF

                   IF ((vsnow(kk)%hliq(i) + de(i-vsnow(kk)%nsnow)) < -0.01_r_2*vsnow(kk)%hsnow(i)) THEN
                      fac(kk) = (-0.009_r_2*vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))/de(i-vsnow(kk)%nsnow)
                      nfac8(kk) = nfac8(kk)+1
                      iok(kk) =0
                      EXIT
                   ENDIF
                ELSEIF ((vsnow(kk)%tsn(i) +  de(i-vsnow(kk)%nsnow)).GT.zero) THEN
                   delta_snowT(i) = zero - vsnow(kk)%tsn(i)
                   delta_snowliq(i) = (LHS_h(i-vsnow(kk)%nsnow)*dt(kk) - &
                        delta_snowT(i)*csice*hsnow(i) *rhow - &
                        dy(i-vsnow(kk)%nsnow)*rhow*(csice*(vsnow(kk)%tsn(i))-lambdaf))/ &
                        (rhow*(zero*(cswat-csice)+lambdaf))
                   IF (delta_snowliq(i).GT.(vsnow(kk)%hsnow(i) + dy(i-vsnow(kk)%nsnow))) THEN
                      fac(kk) = 0.9_r_2*vsnow(kk)%hsnow(i)/(delta_snowliq(i)- dy(i-vsnow(kk)%nsnow))
                      nfac12(kk) = nfac12(kk)+1
                      iok(kk) = 0
                   ENDIF
                ENDIF

             ENDDO
          ENDIF

          DO i=1, n
             IF (var(i)%isat==0) THEN ! check change in S in initially unsaturated layers
                IF (ABS(dy(i)) > dSfac*dSmax) THEN
                   fac(kk) = MAX(half,accel(kk)*ABS(dSmax/dy(i)))
                   nfac1(kk) = nfac1(kk)+1
                   iok(kk) = 0
                   EXIT
                END IF
                IF (-dy(i) > dSmaxr*S(i)) THEN ! Check relative moisture change
                   fac(kk) = MAX(half,accel(kk)*dSmaxr*S(i)/(-dSfac*dy(i)))
                   nfac2(kk) = nfac2(kk)+1
                   iok(kk) = 0
                   EXIT
                END IF
                IF (S(i) < one .AND. S(i)+dy(i) > Smax) THEN ! Check for oversaturating,

                   fac(kk) = accel(kk)*(half*(one+Smax)-S(i))/dy(i)
                   nfac3(kk) = nfac3(kk)+1
                   !write(*,*) 'incrementing nfac3 due to layer', i
                   iok(kk) = 0
                   EXIT
                END IF
                IF (S(i) >= one .AND. dy(i) > half*(Smax-one)) THEN ! Check for limit at oversaturation
                   fac(kk) = 0.25_r_2*(Smax-one)/dy(i)
                   nfac4(kk) = nfac4(kk)+1
                   iok(kk) = 0
                   EXIT
                END IF
             END IF
          END DO

          ! Check absolute soil temperature change in frozen soil layers where updated Tsoil exceeds freezing point
          IF (iok(kk)==1) THEN
             DO i=1, n
                IF(var(i)%iice==1) THEN
                   Tfreezing(kk) = Tfrz(S(i)+dy(i)*REAL(1-var(i)%isat), &
                        par(i)%he, one/(par(i)%lambc*freezefac))
                   IF ((Tsoil(i)+dTsoil(i))>Tfreezing(kk)) THEN

                      theta = (S(i)+dy(i)*REAL(1-var(i)%isat))*(par(i)%thre) + &
                           (par(i)%the - par(i)%thre)
                      deltaJ_latent_T(i) = thetai(i)*dx(i)*rhow*lambdaf
                      tmp1d1(kk) = Tsoil(i)
                      deltaJ_sensible_S(i) = (tmp1d1(kk))*(rhow*cswat*(theta*dx(i)) + &
                           par(i)%rho*par(i)%css*dx(i)) - &
                           (tmp1d1(kk))*(rhow*cswat*(var(i)%thetal*dx(i)) + &
                           par(i)%rho*par(i)%css*dx(i)) - &
                           (tmp1d1(kk))*(rhow*csice*(thetai(i)*dx(i)))

                      IF ((i==1).AND.(h0(kk)>zero)) THEN
                         deltaJ_latent_T(i) = deltaJ_latent_T(i) + &
                              thetai(i)*h0(kk)/par(i)%thre*rhow*lambdaf
                         deltaJ_sensible_S(i) = deltaJ_sensible_S(i) + &
                              (tmp1d1(kk))*(rhow*cswat*(h0(kk)+dy(1)*REAL(1-ns(kk)))) - &
                              (tmp1d1(kk))*(rhow*cswat*(h0(kk)* &
                              (one-thetai(1)/par(1)%thre))) - &
                              (tmp1d1(kk))*(rhow*csice*(h0(kk)* &
                              thetai(1)/par(1)%thre))

                         tmp1d1(kk) = (LHS_h(i)*dt(kk) - (deltaJ_latent_T(i) + deltaJ_sensible_S(i)))/ &
                              (rhow*cswat*(theta*dx(1)+(h0(kk)+dy(1) * &
                              REAL(1-ns(kk))))+par(1)%rho*par(1)%css*dx(1))
                      ELSE
                         tmp1d1(kk) = (LHS_h(i)*dt(kk) - (deltaJ_latent_T(i) + deltaJ_sensible_S(i)))/ &
                              (dx(i)*(cswat*theta*rhow + par(i)%css*par(i)%rho))
                      ENDIF
                      IF (tmp1d1(kk) > dTsoilmax) THEN ! Check absolute soil temperature change
                         fac(kk) = MIN(fac(kk),MAX(half,accel(kk)*ABS(dTsoilmax/tmp1d1(kk))))
                         nfac11(kk) = nfac11(kk)+1
                         iok(kk) = 0
                         EXIT
                      END IF
                   ENDIF
                ENDIF
             ENDDO
          ENDIF

          DO i=1, n
             IF (ABS(dTsoil(i)) > dTsoilmax.AND.(var(i)%iice==0)) THEN ! Check absolute soil temperature change
                fac(kk) = MIN(fac(kk),MAX(half,accel(kk)*ABS(dTsoilmax/dTsoil(i))))
                nfac5(kk) = nfac5(kk)+1

                iok(kk) = 0
                EXIT
             END IF
          ENDDO

          IF (litter .AND. ns(kk)==0) THEN ! litter and pond
             IF (ABS(de(0)) > dTLmax) THEN ! Check absolute litter temperature change
                fac(kk) = MIN(fac(kk),MAX(half,accel(kk)*ABS(dTLmax/de(0))))
                iok(kk) = 0
             END IF
          ENDIF

          ! pond decreasing or runoff starts
!          if (iok(kk)==1 .and. ns(kk)<1 .and. h0(kk)+dy(1)<h0min) then ! pond going
!             fac(kk) = -(h0(kk)-half*h0min)/dy(1)
!             nfac9(kk) = nfac9(kk) +1
!             iok(kk) = 0
!          end if

!           ! pond decreasing or runoff starts
!          if (iok(kk)==1 .and. ns(kk)<1 .and.S(1)*par(1)%thre*dx(1) + h0(kk)+dy(1)<0.1*dx(1)) then ! pond going
!             fac(kk) = -(S(1)*par(1)%thre*dx(1)+h0(kk)-half*0.1*dx(1))/dy(1)
!             nfac9(kk) = nfac9(kk) +1
!             iok(kk) = 0
!          end if

          ! J0+deltaJ<J(thetai=theta) i.e. too much energy extracted
          J0(1) = rhow*cswat*(Tsoil(1))*dx(1)*var(1)%thetal + &
               rhow*dx(1)*thetai(1)*(csice*(Tsoil(1))-lambdaf) + &
               par(1)%rho*par(1)%css*dx(1)*(Tsoil(1)) + &
               (h0(kk)-hice(kk))*cswat*rhow*(Tsoil(1)) + &
               hice(kk)*rhow*(csice*(Tsoil(1))-lambdaf)
          tmp1d2(kk) = J0(1) + LHS_h(1)*dt(kk)  ! available energy
          tmp1d3(kk) = Tsoil(1)+dTsoil(1)        ! projected temperature
          tmp1d4(kk) = h0(kk) + dy(1)*REAL(one-ns(kk)) ! projected pond height
          theta      = (S(1)+ dy(1)*REAL(one-var(1)%isat))*(par(1)%thre) + (par(1)%the - par(1)%thre) ! projected moisture
          c2 = rhow*((tmp1d3(kk))*csice-lambdaf)*(dx(1)*theta+tmp1d4(kk)*theta/par(1)%thre) + & ! projected energy content
               rhow*(tmp1d3(kk))*cswat*tmp1d4(kk)*(one-theta/par(1)%thre) + &
               dx(1)*(tmp1d3(kk))*par(1)%rho*par(1)%css
!          if(((tmp1d2(kk))-c2)<zero) then
!             fac(kk) = 0.5_r_2
!             iok(kk) = 0
!             nfac10(kk) = nfac10(kk)+1
!          endif

          IF (fac(kk) < one) THEN
             again_ice(kk,1:n) = .FALSE.  ! reset all again_ice if calc is to be repeated with smaller time-step
             imelt(:) = 0
             var(:)%thetai = thetai(:)
             var(:)%dthetaldT = dthetaldT(:)
             DO i=1,n
                theta         = S(i)*(par(i)%thre) + (par(i)%the - par(i)%thre)
                var(i)%csoil = par(i)%css*par(i)%rho + rhow*cswat*(theta-var(i)%thetai) + &
                     rhow*csice*var(i)%thetai
                IF ((i==1) .AND. (ns(kk)==0)) THEN
                   cp(kk) = REAL(1-var(1)%iice,r_2)*cswat*rhow & ! heat capacity of pond
                        + REAL(var(1)%iice,r_2)*rhow* &
                        ((one-var(1)%thetai/par(1)%thre)*cswat + (var(1)%thetai/par(1)%thre)*csice)
                ENDIF
             ENDDO
             var(:)%csoileff = var(:)%csoil + rhow*lambdaf*var(:)%dthetaldT*REAL(var(:)%iice,r_2)
             cpeff(kk)= cp(kk) + rhow*lambdaf*var(1)%dthetaldT/par(1)%thre*REAL(var(1)%iice,r_2)
             h0_tmp(kk) = h0(kk)

          ENDIF

          ! reduce time step
          IF (iok(kk)==0) THEN
             t(kk)      = t(kk)-dt(kk)
             ! dt(kk)     = max(fac(kk)*dt(kk), dtmin)
             dt(kk)     = fac(kk)*dt(kk)
             t(kk)      = t(kk)+dt(kk)
             rsigdt(kk) = one/(sig(kk)*dt(kk))
             nless(kk)  = nless(kk) + 1 ! count step size reductions
          END IF
          IF (var(1)%isat/=0 .AND. iflux(kk)==1 .AND. var(1)%phi<phip(kk) .AND. &
               var(1)%phi+dy(1)>phip(kk)) THEN
             ! incipient (onset of) ponding - adjust state of saturated regions
             t(kk)      = t(kk)-dt(kk)
             dt(kk)     = dtmin
             rsigdt(kk) = one/(sig(kk)*dt(kk))
             again(kk)  = .TRUE.
             iok(kk)    = 0
          END IF
       END IF  ! (.not. again(kk))
       nsteps(kk) = nsteps(kk) + 1

!                if ((irec.eq.8992).and.(kk.eq.1) ) then
!                   !if ((irec.eq.5).and.(kk.eq.1626)  .and. logn == 1011) then
!                    write(*,*) 'writing diags', again(kk), nsteps(kk)
!
!                    ! if (.not. again(kk)) then
! !write(345,"(13i8,1500e16.6)")
!                    write(346,"(13i8,1500e16.6)") nsteps(kk), nfac1(kk), nfac2(kk), nfac3(kk), &
!                         nfac4(kk), nfac5(kk), nfac6(kk), nfac7(kk), nfac8(kk), nfac9(kk), nfac10(kk), &
!                         nfac11(kk), nfac12(kk) , q(:), qsig(:), qH(:), qhsig(:), &
!                         dy(0:n), de(0:n), dTsoil(:), S(:),thetai(:), Tsoil(:), &
!                         real(var(1)%iice), real(var(1)%isat), &
!                         h0(kk), real(iok(kk)), var(1)%phie, var(1)%phi, phip(kk),var(2)%phi, &
!                         vsnow(kk)%wcol, &
!                         qadv(:), qadvsig(:), qhya(:), qhyb(:), qhTa(:), qhTb(:), &
!                         qya(:), qyb(:), qTa(:), qTb(:), &
!                         var(1:n)%kH, LHS_h(1:n)*dt(kk), &
!                         RHS(1:n)*dt(kk), LHS(1:n)*dt(kk), par(1:n)%thre,dx(1:n), &
!                         real(-var(1:n)%isat), dt(kk), real(ns(kk)), vsnow(kk)%tsn(1), vsnow(kk)%hsnow(1)
!                  !  endif
!                    if (nsteps(kk).gt.1000) STOP
!                 endif

       IF (nsteps(kk) > nsteps_max) THEN
          WRITE(logn,*) "nsteps > nsteps_max ", irec, kk
          WRITE(logn,*) Tsoil(1), S(1)
          WRITE(logn,*) nfac1(kk), nfac2(kk), nfac3(kk), nfac4(kk), nfac5(kk), &
               nfac6(kk), nfac7(kk), nfac8(kk), nfac9(kk), nfac10(kk), nfac11(kk), nfac12(kk)
          err = 1
          RETURN
       ENDIF

    END DO ! while (iok==0) ----- end get and solve eqns

  END SUBROUTINE get_and_solve_eqn

  !=============================================================================

  SUBROUTINE timestep_loop( &
       tfin, irec, mp, qprec, qprec_snow, n, dx, h0, S, thetai, Jsensible, Tsoil, evap, runoff, infil, &
       drainage, discharge, qh, nsteps, vmet, vlit, vsnow, var, T0, Tsurface, Hcum, lEcum, deltaice_cum_T, &
       deltaice_cum_S, Gcum, &
       Qadvcum, Jcol_sensible, Jcol_latent_S, Jcol_latent_T, csoil, kth, phi, dxL, zdelta, SL, Tl, plit, par, wex, ciso, &
       cisoice, ciso_snow, cisoice_snow, cisos, cprec, cprec_snow, qali, qiso_in, qiso_out, qiso_evap_cum, qiso_trans_cum, &
       qiso_liq_adv, qiso_vap_adv, qiso_liq_diff, qiso_vap_diff, qvsig, qlsig, qvTsig, qvh, deltaTa, &
       precip, qevap, qL, qhL, qybL, qTbL, qhTbL, qhybL, rexcol, wcol, ql0, &
       qv0, again, getq0,getqn,init, again_ice, ih0, iok, itmp, ns, nsat, nsatlast, nsteps0, accel, dmax, dt, dwinfil, &
       dwoff, fac, &
       phip, qpme, rsig, rsigdt, sig, t, hint, phimin, qexd, &
       vtmp, deltaS, dTsoil, tmp2d1, &
       tmp2d2, vtop, &
       vbot, v_aquifer, dwcol, dwdrainage, drn,inlit, dwinlit, drexcol, dwdischarge, dJcol_latent_S, dJcol_latent_T, &
       dJcol_sensible, deltaJ_latent_S, deltaJ_latent_T, deltaJ_sensible_S, deltaJ_sensible_T, qevapsig, qrunoff, &
       tmp1d1, tmp1d2, &
       tmp1d3, tmp1d4, deltah0, SL0, deltaSL, cvL0, SLliq0, deltacvL, SLliq, deltaSLliq, qiso_evap, qiso_trans, &
       lE0, G0, Epot, &
       Tfreezing, dtdT, LHS, RHS, LHS_h, RHS_h, surface_case, nns, iflux, litter, i, j, k, kk, condition, littercase, &
       isotopologue, advection, c2, theta, dTqwdTa, dTqwdTb, Tqw, keff, cp, cpeff, hice, deltahice, h0_0, hice_0, &
       h0_tmp, hice_tmp, qtransfer, qmelt_ss , qprec_ss, cprec_ss, delta_snowcol, delta_snowT, delta_snowliq, &
       thetai_0, J0, tmp1, tmp2, iqex, icali, nfac1, nfac2, nfac3, nfac4, nfac5, nfac6, nfac7, nfac8, nfac9, &
       nfac10, nfac11, nfac12, J0snow, wcol0snow, h_ex, wpi, err &
       )
    IMPLICIT NONE
    REAL(r_2)              :: tfin
    INTEGER(i_d)              :: irec, mp
    REAL(r_2),      DIMENSION(1:mp)              :: qprec
    REAL(r_2),      DIMENSION(1:mp)              :: qprec_snow
    INTEGER(i_d)              :: n
    REAL(r_2),      DIMENSION(1:n) :: dx
    REAL(r_2),      DIMENSION(1:mp)           :: h0
    REAL(r_2),      DIMENSION(1:n) :: S
    REAL(r_2),      DIMENSION(1:n) :: thetai
    REAL(r_2),      DIMENSION(1:n) :: Jsensible
    REAL(r_2),      DIMENSION(1:n) :: Tsoil
    REAL(r_2),      DIMENSION(1:mp)           :: evap
    REAL(r_2),      DIMENSION(1:mp)             :: runoff, infil
    REAL(r_2),      DIMENSION(1:mp)             :: drainage, discharge
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max:n)      :: qh
    INTEGER(i_d),   DIMENSION(1:mp)             :: nsteps
    TYPE(vars_met), DIMENSION(1:mp)           :: vmet
    TYPE(vars),     DIMENSION(1:mp)           :: vlit
    TYPE(vars_snow), DIMENSION(1:mp)           :: vsnow
    TYPE(vars),     DIMENSION(1:n) :: var
    REAL(r_2),      DIMENSION(1:mp)           :: T0, Tsurface
    REAL(r_2),      DIMENSION(1:mp)             :: Hcum, lEcum,  deltaice_cum_T, deltaice_cum_S
    REAL(r_2),      DIMENSION(1:mp)             :: Gcum, Qadvcum
    REAL(r_2),      DIMENSION(1:mp)             :: Jcol_sensible, Jcol_latent_S, Jcol_latent_T
    REAL(r_2),      DIMENSION(1:n) :: csoil, kth
    REAL(r_2),      DIMENSION(1:n) :: phi
    REAL(r_2),      DIMENSION(1:mp)              :: dxL
    REAL(r_2),      DIMENSION(1:mp)           :: zdelta, SL, Tl
    TYPE(params),   DIMENSION(1:mp)              :: plit
    TYPE(params),   DIMENSION(1:n) :: par
    REAL(r_2),      DIMENSION(1:mp,1:n), OPTIONAL :: wex
    REAL(r_2),      DIMENSION(1:mp,1:n), OPTIONAL :: ciso
    REAL(r_2),      DIMENSION(1:mp,1:n), OPTIONAL :: cisoice
    REAL(r_2),      DIMENSION(1:mp,1:nsnow_max), OPTIONAL :: ciso_snow
    REAL(r_2),      DIMENSION(1:mp,1:nsnow_max), OPTIONAL :: cisoice_snow
    REAL(r_2),      DIMENSION(1:mp), OPTIONAL :: cisos
    REAL(r_2),      DIMENSION(1:mp),    OPTIONAL :: cprec
    REAL(r_2),      DIMENSION(1:mp),    OPTIONAL :: cprec_snow
    REAL(r_2),      DIMENSION(1:mp),    OPTIONAL :: qali
    REAL(r_2),      DIMENSION(1:mp),   OPTIONAL :: qiso_in, qiso_out
    REAL(r_2),      DIMENSION(1:mp),   OPTIONAL :: qiso_evap_cum, qiso_trans_cum
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max+1:n),   OPTIONAL :: qiso_liq_adv, qiso_vap_adv
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max+1:n-1),   OPTIONAL :: qiso_liq_diff, qiso_vap_diff
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max:n),   OPTIONAL :: qvsig, qlsig, qvTsig, qvh
    REAL(r_2),      DIMENSION(1:mp), OPTIONAL :: deltaTa
    ! Error flag if nstep of SLI > nsteps_max: err=0 -> no error; err/=0 -> error
    INTEGER(i_d),     INTENT(INOUT), OPTIONAL :: err

    ! Solves the RE and, optionally, the ADE from time ts to tfin.
    ! Definitions of arguments:
    ! Required args:
    ! ts   - start time (h).
    ! tfin   - finish time.
    ! qprec   - precipitation (or water input) rate (fluxes are in cm/h).
    ! qevap   - potl evaporation rate from soil surface.
    ! n    - no. of soil layers.
    ! nsol   - no. of solutes.
    ! dx(1:n) - layer thicknesses.
    ! h0   - surface head, equal to depth of surface pond.
    ! S(1:n)  - degree of saturation ("effective satn") of layers.
    ! evap   - cumulative evaporation from soil surface (cm, not initialised).
    ! runoff  - cumulative runoff.
    ! infil   - cumulative net infiltration (time integral of flux across surface).
    ! drn   - cumulative net drainage (time integral of flux across bottom).
    ! nsteps  - cumulative no. of time steps for RE soln.
    ! Optional args:
    ! heads(1:n)   - matric heads h of layers at finish.
    ! qexsub    - subroutine to get layer water extraction rates (cm/h) by
    !     plants. Note that there is no solute extraction and osmotic
    !     effects due to solute are ignored. Arguments:
    !     qex(1:n) - layer extraction rates; qexh(1:n) - partial
    !     derivs of qex wrt h.
    ! wex(1:n)    - cumulative water extraction from layers.
    ! cin(1:nsol)   - solute concns in water input (user's units/cc).
    ! c0(1:nsol)   - solute concns in surface pond.
    ! sm(1:n,1:nsol)  - solute (mass) concns in layers.
    ! soff(1:nsol)   - cumulative solute runoff (user's units).
    ! sinfil(1:nsol)  - cumulative solute infiltration.
    ! sdrn(1:nsol)   - cumulative solute drainage.
    ! nssteps(1:nsol) - cumulative no. of time steps for ADE soln.
    ! isosub    - subroutine to get adsorbed solute (units/g soil) from concn
    !     in soil water according to chosen isotherm code.
    !     Arguments: iso - 2 character code; c - concn in soil water;
    !     p(:) - isotherm parameters; f - adsorbed mass/g soil;
    !     fc - deriv of f wrt c (slope of isotherm curve). Note that
    !     linear adsorption does not require a sub, and other types
    !     are available in sub isosub.

    REAL(r_2),    DIMENSION(1:mp)       :: precip, qevap
    REAL(r_2),    DIMENSION(1:mp)       :: qL, qhL, qybL, qTbL, qhTbL, qhybL, rexcol, wcol, ql0, qv0
    LOGICAL,      DIMENSION(1:mp)       :: again, getq0,getqn,init
    LOGICAL,      DIMENSION(1:mp,1:n)   :: again_ice
    INTEGER(i_d), DIMENSION(1:mp)       :: ih0, iok, itmp, ns, nsat, nsatlast, nsteps0
    REAL(r_2),    DIMENSION(1:mp)       :: accel, dmax, dt, dwinfil, dwoff, fac, phip
    REAL(r_2),    DIMENSION(1:mp)       :: qpme, rsig, rsigdt, sig, t
    REAL(r_2),    DIMENSION(1:n) :: hint, phimin, qexd
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: aa, bb, cc, dd, ee, ff, gg, dy
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: aah, bbh, cch, ddh, eeh, ffh, ggh, de
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qadv, qadvya, qadvyb, qadvTa, qadvTb


    TYPE(vars)                          :: vtmp
    !TYPE(vars),   DIMENSION(1:n) :: var
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qsig, qhsig, qadvsig
    REAL(r_2),    DIMENSION(-nsnow_max:n) :: qliq, qv, qvT, qlya, qlyb, qvya, qvyb, qlTb, qvTa, qvTb
    REAL(r_2),    DIMENSION(1:n) :: deltaS, dTsoil
    REAL(r_2),    DIMENSION(0:n) :: tmp2d1, tmp2d2
    REAL(r_2),    DIMENSION(1:n) :: S0, Sliq0, Sliq, deltaSliq, cv0, deltacv
    REAL(r_2),    DIMENSION(1:n) :: Sliqice0, Sliqice, deltaSliqice
    REAL(r_2),    DIMENSION(1:n) :: Sice0, Sice, deltaSice

    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: Sliq0_ss, Sliq_ss, deltaSliq_ss
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: Sliqice0_ss, Sliqice_ss, deltaSliqice_ss
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: Sice0_ss, Sice_ss, deltaSice_ss
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: S0_ss, S_ss, Tsoil_ss, dTsoil_ss
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: cv0_ss, cv_ss, Dv_ss, deltacv_ss, dx_ss
    REAL(r_2),    DIMENSION(-nsnow_max+1:n-1) :: dz_ss
    REAL(r_2),      DIMENSION(1:nsnow_max) :: cisoliqice_snow
    INTEGER(i_d) :: itop ! integer corresponding to top of soil-snow column
    INTEGER(i_d) :: nsnow ! number of dedicated snow layers
    REAL(r_2),    DIMENSION(1:n) :: tmp_thetasat, tmp_thetar
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: thetasat_ss, thetar_ss
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: tmp_tortuosity
    REAL(r_2),    DIMENSION(-nsnow_max+1:n) :: ciso_ss, cisoice_ss
    REAL(r_2),    DIMENSION(1:n)   :: delthetai, dthetaldT, thetal
    INTEGER(i_d), DIMENSION(1:n) :: isave, nsteps_ice, imelt


    TYPE(vars),         DIMENSION(1:mp) :: vtop, vbot
    TYPE(vars_aquifer), DIMENSION(1:mp) :: v_aquifer
    REAL(r_2),          DIMENSION(1:mp) :: dwcol, dwdrainage, drn,inlit, dwinlit, drexcol, dwdischarge
    REAL(r_2),          DIMENSION(1:mp) :: dJcol_latent_S, dJcol_latent_T, dJcol_sensible
    REAL(r_2),          DIMENSION(1:n) :: deltaJ_latent_S, deltaJ_latent_T, deltaJ_sensible_S, deltaJ_sensible_T
    REAL(r_2),          DIMENSION(1:mp) :: qevapsig
    REAL(r_2),          DIMENSION(1:mp) :: qrunoff
    REAL(r_2),          DIMENSION(1:mp) :: tmp1d1, tmp1d2, tmp1d3,  tmp1d4
    REAL(r_2),          DIMENSION(1:mp) :: deltah0
    REAL(r_2),          DIMENSION(1:mp) :: SL0, deltaSL, cvL0, SLliq0, deltacvL, SLliq, deltaSLliq
    REAL(r_2),          DIMENSION(1:mp) :: qiso_evap, qiso_trans
    REAL(r_2),          DIMENSION(1:mp) :: lE0, G0, Epot
    REAL(r_2),          DIMENSION(1:mp) :: Tfreezing
    REAL(r_2),          DIMENSION(1:mp) :: dtdT
    REAL(r_2),          DIMENSION(-nsnow_max+1:n) :: LHS, RHS, LHS_h, RHS_h
    INTEGER(i_d),       DIMENSION(1:mp) :: surface_case

    INTEGER(i_d),       DIMENSION(1:mp) :: nns, iflux
    LOGICAL      :: litter
    INTEGER(i_d) :: i, j, k, kk, condition
    INTEGER(i_d) :: littercase, isotopologue, advection ! switches
    REAL(r_2)    :: c2, theta
    REAL(r_2)    :: dTqwdTa, dTqwdTb, Tqw, keff
    REAL(r_2),          DIMENSION(1:mp) :: cp, cpeff, hice, deltahice, h0_0, hice_0, h0_tmp, hice_tmp
    REAL(r_2),          DIMENSION(nsnow_max) :: qmelt
    ! tranfer of water  from soil to   snow (+ve) or soil to snow (-ve) at init or termination of snowpack
    REAL(r_2),  DIMENSION(1:mp) :: qtransfer
    REAL(r_2),  DIMENSION(1:mp) :: qmelt_ss ! melt water from bottom snow layer to soil
    REAL(r_2),  DIMENSION(1:mp) :: qprec_ss
    REAL(r_2),  DIMENSION(1:mp) :: cprec_ss
    REAL(r_2),          DIMENSION(nsnow_max) :: delta_snowcol, delta_snowT, delta_snowliq
    REAL(r_2),      DIMENSION(1:n) :: thetai_0, J0
    REAL(r_2) :: tmp1, tmp2
    REAL(r_2),          DIMENSION(1:n) :: iqex
    REAL(r_2),          DIMENSION(1:mp)     :: icali
    INTEGER(i_d),       DIMENSION(1:mp) :: nfac1, nfac2, nfac3, nfac4, nfac5, &
         nfac6, nfac7, nfac8, nfac9, nfac10, nfac11, nfac12
    REAL(r_2),          DIMENSION(1:mp)     :: J0snow, wcol0snow
    REAL(r_2), DIMENSION(1:n) :: h_ex
    REAL(r_2) :: wpi


    aa(:)     = zero
    aah(:)    = zero
    bb(:)     = zero
    bbh(:)    = zero
    cc(:)     = zero
    cch(:)    = zero
    dd(:)     = zero
    ddh(:)    = zero
    ee(:)     = zero
    eeh(:)    = zero
    ff(:)     = zero
    ffh(:)    = zero
    gg(:)     = zero
    ggh(:)    = zero
    dy(:)     = zero
    q(:)      = zero
    qya(:)    = zero
    qyb(:)    = zero
    qTa(:)    = zero
    qTb(:)    = zero
    qhya(:)   = zero
    qhyb(:)   = zero
    qhTa(:)   = zero
    qhTb(:)   = zero
    qadvyb(:) = zero
    qadvya(:) = zero
    de(:)            = zero
    ! initialise diagnostic vars for input to isotope_vap
    Sliq0_ss  = zero
    Sliq_ss= zero
    deltaSliq_ss= zero
    Sliqice0_ss= zero
    Sliqice_ss= zero
    deltaSliqice_ss= zero
    Sice0_ss= zero
    Sice_ss= zero
    deltaSice_ss= zero
    S0_ss= zero
    S_ss= zero
    cv0_ss= zero
    cv_ss= zero
    Dv_ss = zero
    deltacv_ss= zero

    DO WHILE (t(kk) < tfin)
       !----- take next time step
       iflux(kk)=1
       again(kk)  = .TRUE. ! flag for recalcn of fluxes (default=false)
       imelt = 0 ! initialise imelt (==1 at onset of melting)
       qmelt(:) = zero
       vsnow(kk)%nsnow_last = vsnow(kk)%nsnow ! for detecting onset and disappearance of dedicated snow layer
       S0(1:n) = S(1:n)
       Sice0(1:n)    = var(1:n)%thetai/par(1:n)%thre
       Sliqice0(1:n) = (S(1:n) - var(1:n)%cv)/(one-var(1:n)%cv)
       Sliq0(1:n)    = Sliqice0(1:n) - Sice0(1:n)
       Sice0(1) = Sice0(1)  + hice_0(kk)/(dx(1)*par(1)%thre)
       Sliq0(1) = Sliq0(1) + (h0_0(kk)-hice_0(kk))/(dx(1)*par(1)%thre) ! add pond component to Sliq(1)

       IF (nsnow_max.GT.0) S0_ss(-nsnow_max+1:0) = vsnow(kk)%hsnow      ! divide by zero after changes to layer depth
       IF (nsnow_max.GT.0) Sliq0_ss(-nsnow_max+1:0) = vsnow(kk)%hliq ! divide by zero after changes to layer depth
       ! divide by zero after changes to layer depth
       IF (nsnow_max.GT.0) Sice0_ss(-nsnow_max+1:0) = vsnow(kk)%hsnow - vsnow(kk)%hliq
       IF (nsnow_max.GT.0) cv0_ss(-nsnow_max+1:0) = vsnow(kk)%cv
       IF (nsnow_max.GT.0) dx_ss(-nsnow_max+1:0) = vsnow(kk)%depth

       S0_ss(1:n) = S(1:n)
       Sliqice0_ss(1:n) = Sliqice0(1:n)
       Sliq0_ss(1:n) = Sliq0(1:n)
       cv0_ss(1:n) =  var(1:n)%cv
       dx_ss(1:n) = dx(1:n)

       CALL iflux_loop(&
            tfin, irec, mp, qprec, qprec_snow, n, dx(:), h0, S(:), thetai(:), &
            Jsensible(:), Tsoil(:), evap, infil, drainage, discharge, &
            qh, nsteps, vmet, vlit, vsnow, var(:), T0, Tsurface, Hcum, lEcum, &
            Gcum, Qadvcum, Jcol_sensible, &
            Jcol_latent_S, Jcol_latent_T, csoil(:), kth(:), phi(:), dxL, zdelta, SL, Tl, &
            plit, par(:), wex, ciso_snow, cisoice_snow, &
            qali, &
            qvsig, qlsig, qvTsig, qvh, deltaTa, &
            precip, qevap, qL, qhL, qybL, qTbL, qhTbL, qhybL, rexcol, wcol, &
            again, getq0,getqn,init, again_ice, ih0, iok, itmp, ns, nsat, &
            nsatlast, nsteps0, accel, dmax, dt, dwinfil, dwoff, fac, &
            phip, qpme, rsig, rsigdt, sig, t, hint(:), phimin(:), &
            qexd(:), aa(:), bb(:), cc(:), dd(:), ee(:), ff(:), gg(:), dy(:), &
            aah(:), bbh(:), cch(:), ddh(:), eeh(:), ffh(:), ggh(:), &
            de(:), q(:), qya(:), qyb(:), qTa(:), qTb(:),qhya(:), qhyb(:), qhTa(:), qhTb(:), qadv(:), qadvya(:), qadvyb(:), &
            qadvTa(:), qadvTb(:), vtmp, qsig(:), qhsig(:), qadvsig(:), qliq(:), qv(:), qvT(:), qlya(:), qlyb(:), &
            qvya(:), qvyb(:), qlTb(:), qvTa(:), qvTb(:), deltaS(:), dTsoil(:), tmp2d1(:), tmp2d2(:), &
            cv0(:), &
            cisoliqice_snow, &
            dthetaldT(:), thetal(:), isave, nsteps_ice, imelt, vtop, vbot, v_aquifer, &
            dwcol, dwdrainage, drn,inlit, dwinlit, drexcol, dwdischarge, &
            dJcol_latent_S, dJcol_latent_T, dJcol_sensible, deltaJ_latent_S(:), &
            deltaJ_latent_T(:), deltaJ_sensible_S(:), deltaJ_sensible_T(:), qevapsig, &
            qrunoff, tmp1d1, tmp1d2, tmp1d3,  tmp1d4, deltah0, deltaSL, &
            lE0, G0, &
            Epot, Tfreezing, dtdT, LHS, RHS, LHS_h, RHS_h, surface_case, nns, &
            iflux, litter, i, j, k, kk, condition, littercase, isotopologue, &
            advection, c2, theta, dTqwdTa, dTqwdTb, Tqw, keff, cp, &
            cpeff, hice, h0_0, hice_0, h0_tmp, hice_tmp, qmelt, &
            qtransfer, delta_snowcol, delta_snowT, &
            delta_snowliq, thetai_0(:), J0(:), tmp1, tmp2, iqex(:), &
            nfac1, nfac2, nfac3, nfac4, nfac5, nfac6, nfac7, nfac8, nfac9, &
            nfac10, nfac11, nfac12, J0snow, wcol0snow, h_ex, wpi, err &
            )
       IF (err /= 0) RETURN

       runoff(kk) = runoff(kk) + qrunoff(kk)*dt(kk)

       WHERE ((S0(:).GE.one).OR.(S(:).GE.one))
          var(1:n)%cv = zero
          cv0(1:n) = zero
       endwhere
       IF (h0(kk).GT.zero.OR.h0_0(kk).GT.zero) THEN
          var(1)%cv = zero
          cv0(1) = zero
       ENDIF

       Sliqice0(1:n) = (S0(1:n) - cv0(1:n))/(one-cv0(1:n))
       deltacv(1:n)   = var(1:n)%cv - cv0(1:n)
       deltah0(kk) = h0(kk) - h0_0(kk)
       Sliqice(1:n)      = (S(1:n) - var(1:n)%cv)/(one-var(1:n)%cv)
       deltaSliqice(1:n) = Sliqice(1:n) - Sliqice0(1:n)
       ! add pond component to Sliqice(1) and deltaSliqice(1)
       Sliqice(1) = Sliqice(1) + h0(kk)/(dx(1)*par(1)%thre) ! add pond component to Sliq(1)
       deltaSliqice(1) =  deltaSliqice(1) + deltah0(kk)/(dx(1)*par(1)%thre)

       delthetai(1:n) = (var(1:n)%thetai-thetai_0(1:n))

       hice(kk) = h0(kk)*var(1)%thetai/par(1)%thre
       deltahice(kk) =  hice(kk) - hice_0(kk)
       deltahice(kk) =  hice(kk) - h0_0(kk)*thetai_0(1)/par(1)%thre

       ! change in snow pack (lumped with top layer)
       IF (vsnow(kk)%nsnow==0.) THEN
          IF (var(1)%iice==1) THEN
             vsnow(kk)%wcol = vsnow(kk)%wcol + &
                  MIN(qprec_snow(kk)*dt(kk), MAX(zero,(deltahice(kk)+dx(1)*delthetai(1)))) + & ! accumulation
                  MAX(-vsnow(kk)%wcol,MIN(zero,(deltahice(kk)+dx(1)*delthetai(1)))) ! melting

             IF (h0(kk)>zero) THEN
                vsnow(kk)%wcol = MIN(vsnow(kk)%wcol, hice(kk))
             ELSE
                vsnow(kk)%wcol = MIN(vsnow(kk)%wcol, dx(1)*var(1)%thetai)
             ENDIF
          ELSE
             vsnow(kk)%wcol = zero
          ENDIF

          vsnow(kk)%tsn = MERGE(Tsoil(1),zero,vsnow(kk)%wcol>zero)
          IF (vsnow(kk)%wcol>zero) THEN
             vsnow(kk)%depth(1) = vsnow(kk)%wcol/(vsnow(kk)%dens(1)/rhow)
          ELSE
             vsnow(kk)%depth(1) = zero
          ENDIF
       ENDIF

       Sice(1:n) = var(1:n)%thetai/par(1:n)%thre
       deltaSice(1:n) = delthetai(1:n)/par(1:n)%thre
       deltahice(kk) = hice(kk)-hice_0(kk)
       Sice(1) = Sice(1)  + hice(kk)/(dx(1)*par(1)%thre)
       deltaSice(1) = deltaSice(1) + deltahice(kk)/(dx(1)*par(1)%thre)

       Sliq(1:n) = Sliqice(1:n) - Sice(1:n)
       deltaSliq(1:n) = deltaSliqice(1:n) - deltaSice(1:n)


       thetai_0(1:n)    = var(1:n)%thetai
       thetai(1:n) = var(1:n)%thetai
       dthetaldt(1:n) = var(1:n)%dthetaldT
       ! h0_0(kk) = h0(kk)
       ! hice_0(kk) = hice(kk)
       ! Sliq0(1:n) = Sliq(1:n)
       ! Sice0(1:n)  = Sice(1:n)
       ! Sliqice0(1:n) = Sliqice(1:n)


       ! extension of diagnostics for isotope_vap to snow

       S_ss(1:n) = S(1:n)
       S_ss(1) = S_ss(1) + h0(kk)/(dx(1)*par(1)%thre)
       S0_ss(1) = S0_ss(1) + (h0(kk)-deltah0(kk))/(dx(1)*par(1)%thre)
       Sliqice_ss(1:n) = Sliqice(1:n)
       Sliq_ss(1:n) = Sliq(1:n)
       cv_ss(1:n) =  var(1:n)%cv
       Dv_ss(1:n) =  var(1:n)%Dv
       Sice_ss(1:n) =  Sice(1:n)

       deltaSice_ss(1:n) = deltaSice(1:n)
       deltaSliq_ss(1:n) =  deltaSliq(1:n)
       deltaSliqice_ss(1:n) = deltaSliqice(1:n)
       deltacv_ss(1:n) =  deltacv(1:n)

       Tsoil_ss(1:n) = Tsoil(1:n)
       dTsoil_ss(1:n) = dTsoil(1:n)
       IF (isotopologue /= 0) THEN
          ciso_ss(1:n) = ciso(kk,1:n)
          cisoice_ss(1:n) = cisoice(kk,1:n)
       ENDIF


       IF (nsnow_max.GT.0) THEN

          dx_ss(-nsnow_max+1:0) = vsnow(kk)%depth       ! fixed snow layer depth for isotope calc
          tmp1d1(kk) = S0_ss(0) ! initial SWE
          WHERE ( dx_ss(-nsnow_max+1:0).GT.zero)


             cv_ss(-nsnow_max+1:0)   = vsnow(kk)%cv
             !   vsnow(kk)%cv = zero  ! test vh
             !   cv_ss(-nsnow_max+1:0)   = zero
             !   cv0_ss(-nsnow_max+1:0)   = zero
             deltacv_ss(-nsnow_max+1:0)   = cv_ss(-nsnow_max+1:0) - cv0_ss(-nsnow_max+1:0)
             ! deltaSliqice_ss(-nsnow_max+1:0) =   (vsnow(kk)%hsnow - S0_ss(-nsnow_max+1:0)- &
             !      dx_ss(-nsnow_max+1:0)*deltacv_ss(-nsnow_max+1:0))/ dx_ss(-nsnow_max+1:0)

             Sliqice0_ss(-nsnow_max+1:0) = (S0_ss(-nsnow_max+1:0)/dx_ss(-nsnow_max+1:0) - &
                  cv0_ss(-nsnow_max+1:0))/(one-cv0_ss(-nsnow_max+1:0))
             Sliqice_ss(-nsnow_max+1:0) = (vsnow(kk)%hsnow(1:nsnow_max)/dx_ss(-nsnow_max+1:0) - &
                  cv_ss(-nsnow_max+1:0))/(one-cv_ss(-nsnow_max+1:0))
             deltaSliqice_ss(-nsnow_max+1:0) = Sliqice_ss(-nsnow_max+1:0) - Sliqice0_ss(-nsnow_max+1:0)


             S0_ss(-nsnow_max+1:0)    = S0_ss(-nsnow_max+1:0)/dx_ss(-nsnow_max+1:0)
             S_ss(-nsnow_max+1:0) =  vsnow(kk)%hsnow/dx_ss(-nsnow_max+1:0)


             Sliq0_ss(-nsnow_max+1:0)    = Sliq0_ss(-nsnow_max+1:0)/dx_ss(-nsnow_max+1:0)
             Sliq_ss(-nsnow_max+1:0) =  vsnow(kk)%hliq/dx_ss(-nsnow_max+1:0)


             Sice0_ss(-nsnow_max+1:0) = Sliqice0_ss(-nsnow_max+1:0) - Sliq0_ss(-nsnow_max+1:0)
             Sice_ss(-nsnow_max+1:0) = Sliqice_ss(-nsnow_max+1:0) - Sliq_ss(-nsnow_max+1:0)


             deltaSliq_ss(-nsnow_max+1:0) = Sliq_ss(-nsnow_max+1:0) - Sliq0_ss(-nsnow_max+1:0)
             deltaSice_ss(-nsnow_max+1:0) = Sice_ss(-nsnow_max+1:0) - Sice0_ss(-nsnow_max+1:0)

             cv_ss(-nsnow_max+1:0)   = vsnow(kk)%cv
             Dv_ss(-nsnow_max+1:0)   = vsnow(kk)%Dv

             Tsoil_ss(-nsnow_max+1:0) =  vsnow(kk)%tsn(1:nsnow_max)
             dTsoil_ss(-nsnow_max+1:0) = delta_snowT(1:nsnow_max)
          ELSEWHERE
             S_ss(-nsnow_max+1:0) = zero
             Sliq_ss(-nsnow_max+1:0) = zero
             Sliqice_ss(-nsnow_max+1:0) = zero
             Sice_ss(-nsnow_max+1:0) = zero
             deltaSliq_ss(-nsnow_max+1:0) = zero
             deltaSliqice_ss(-nsnow_max+1:0) =  zero
             deltaSice_ss(-nsnow_max+1:0) =zero
             deltacv_ss(-nsnow_max+1:0) = zero
             cv_ss(-nsnow_max+1:0)   = zero
             Dv_ss(-nsnow_max+1:0)   = zero
             Tsoil_ss(-nsnow_max+1:0) = zero
             dTsoil_ss(-nsnow_max+1:0) = zero
          endwhere

          IF (isotopologue /= 0) THEN
             WHERE ( dx_ss(-nsnow_max+1:0) .GT. zero)
                WHERE (vsnow(kk)%hliq(1:nsnow_max).GT.zero)
                   ciso_ss(-nsnow_max+1:0) = ciso_snow(kk,1:nsnow_max)
                ELSEWHERE
                   ciso_ss(-nsnow_max+1:0) = cisoice_snow(kk,1:nsnow_max)
                endwhere
                cisoice_ss(-nsnow_max+1:0) =  cisoice_snow(kk,1:nsnow_max)

             ELSEWHERE
                ciso_ss(-nsnow_max+1:0) = zero
                cisoice_ss(-nsnow_max+1:0) = zero
             endwhere
             IF (vsnow(kk)%hsnow(1).GT.zero) THEN

                cisoliqice_snow(1:nsnow_max) = (ciso_snow(kk,1:nsnow_max)*vsnow(kk)%hliq(1:nsnow_max) + &
                     cisoice_snow(kk,1:nsnow_max)*(vsnow(kk)%hsnow(1:nsnow_max)-vsnow(kk)%hliq(1:nsnow_max))) / &
                     vsnow(kk)%hsnow(1:nsnow_max)

                cisos(kk) =  cisoliqice_snow(1)

             ENDIF
          ENDIF

       ENDIF

       IF (littercase==1) THEN  ! vh needs attention !
          SL0(kk)    = SL(kk) - deltaSL(kk)
          cvL0(kk)   = vlit(kk)%cv
          SLliq0(kk) = (SL0(kk) - cvL0(kk))/(one-cvL0(kk))
          CALL litter_props(Sl(kk), Tl(kk), vlit(kk), plit(kk), h0(kk))
          deltacvL(kk)   = vlit(kk)%cv - cvL0(kk)
          SLliq(kk)      = (SL(kk) - vlit(kk)%cv)/(one-vlit(kk)%cv)
          deltaSLliq(kk) = SLliq(kk) - SLliq0(kk)
       ENDIF

       Jsensible(1) = (var(1)%csoil* dx(1)+h0(kk)*cswat)*(Tsoil(1))
       Jsensible(2:n) = var(2:n)%csoil*(Tsoil(2:n))* dx(2:n)

       ! change in heat stored in soil column
       dJcol_latent_S(kk) = SUM(deltaJ_latent_S(1:n))
       Jcol_latent_S(kk) = Jcol_latent_S(kk) + dJcol_latent_S(kk)
       dJcol_latent_T(kk) = SUM(deltaJ_latent_T(1:n))
       Jcol_latent_T(kk) = Jcol_latent_T(kk) + dJcol_latent_T(kk)
       dJcol_sensible(kk) = SUM(deltaJ_sensible_T(1:n)) + SUM(deltaJ_sensible_S(1:n))
       Jcol_sensible(kk) = Jcol_sensible(kk) + dJcol_sensible(kk)

       deltaice_cum_S(kk) = -Jcol_latent_S(kk)/rhow/lambdaf
       deltaice_cum_T(kk) = -Jcol_latent_T(kk)/rhow/lambdaf

       deltaTa(kk)       = zero
       init(kk)          = .FALSE.

       IF (isotopologue /= 0) THEN

          tmp_thetasat(1:n)   = par(1:n)%thre
          tmp_tortuosity(1:n) = par(1:n)%tortuosity
          tmp_thetar(1:n)     = par(1:n)%the - par(1:n)%thre

          nns(kk) = 1  ! pond included in top soil layer
          IF (vsnow(kk)%nsnow>0) THEN
             nns(kk) = 1-vsnow(kk)%nsnow
          ENDIF

          itop = -nsnow_max+1
          ql0(kk) = qlsig(kk,-vsnow(kk)%nsnow)
          qv0(kk) = qvsig(kk,-vsnow(kk)%nsnow)
          nsnow = vsnow(kk)%nsnow

          dz_ss(itop:n-1) =   half*(dx_ss(itop:n-1)+dx_ss(itop+1:n)) ! flow paths
          thetasat_ss(itop:0) = 1.0_r_2
          thetar_ss(itop:0) = 1.0_r_2
          thetasat_ss(1:n) = tmp_thetasat(1:n)
          thetar_ss(1:n) = tmp_thetar(1:n)
          qprec_ss(kk) = qprec(kk)
          cprec_ss(kk) = cprec(kk)
          qmelt_ss(kk) = zero
          IF (vsnow(kk)%nsnow.GT.0) THEN
             qmelt_ss(kk) = qmelt(vsnow(kk)%nsnow)/dt(kk)
             tmp_tortuosity(itop:0) = 0.8_r_2
             thetasat_ss(itop:0) = 1.0_r_2
             thetar_ss(itop:0) = 0.0_r_2
          ELSEIF (vsnow(kk)%nsnow_last.GT.0.AND.vsnow(kk)%nsnow.EQ.0) THEN
             !qmelt_ss(kk) = -qtransfer(kk)/dt(kk)   ! transfer from terminated snowpack to soil column
             IF (ABS(qprec(kk)-qtransfer(kk)/dt(kk)).GT.zero) THEN
                cprec_ss(kk) = (cprec(kk)*qprec(kk)-cisoliqice_snow(1)*qtransfer(kk)/dt(kk))/(qprec(kk)-qtransfer(kk)/dt(kk))
                qprec_ss(kk) = qprec(kk)  -qtransfer(kk)/dt(kk)
             ENDIF
             qtransfer(kk) = zero ! otherwise qtransfer retains value for transfer from soil to new snowpack
          ENDIF

          CALL isotope_vap(irec,isotopologue, n, nsnow, vsnow(kk)%nsnow_last, &
               itop, dx_ss(itop:n), dz_ss(itop:n-1), sig(kk), dt(kk), &
               Tsoil_ss(itop:n), dTsoil_ss(itop:n), Sliqice_ss(itop:n), deltaSliqice_ss(itop:n), &
               Sliq_ss(itop:n), deltaSliq_ss(itop:n),Sice_ss(itop:n), deltaSice_ss(itop:n), &
               Tsurface(kk), vmet(kk)%Ta, &
               qsig(itop-1:n), qlsig(kk,itop-1:n), qvsig(kk,itop-1:n), &
               qmelt_ss(kk),qtransfer(kk)/dt(kk), &  ! melt water to soil and water transfer from soil to snow (+ve)
               qprec_ss(kk),qprec_snow(kk), qevapsig(kk), qrunoff(kk), iqex(1:n), &
               cv_ss(itop:n),Dv_ss(itop:n), thetasat_ss(itop:n), thetar_ss(itop:n), tmp_tortuosity(itop:n), &
               deltacv_ss(itop:n), vmet(kk)%rbw, vmet(kk)%cva, vmet(kk)%civa, &
               cprec_ss(kk),cprec_snow(kk), icali(kk), &
               ql0(kk), qv0(kk), &
               ciso_ss(itop:n), cisoice_ss(itop:n), cisos(kk), &
               qiso_in(kk), qiso_out(kk), qiso_evap(kk), qiso_trans(kk), &
               qiso_liq_adv(kk,itop:n), qiso_vap_adv(kk,itop:n), qiso_liq_diff(kk,itop:n-1), qiso_vap_diff(kk,itop:n-1))



          qiso_evap_cum(kk)  = qiso_evap_cum(kk)  + qiso_evap(kk)*dt(kk)
          qiso_trans_cum(kk) = qiso_trans_cum(kk) + qiso_trans(kk)*dt(kk)
          ciso(kk,1:n) = ciso_ss(1:n)
          cisoice(kk,1:n) = cisoice_ss(1:n)
          ciso_snow(kk,1:nsnow_max) = ciso_ss(itop:0)
          cisoice_snow(kk,1:nsnow_max) = cisoice_ss(itop:0)
          IF (vsnow(kk)%nsnow.GT.1) THEN
             cisoliqice_snow(1:nsnow_max) = (ciso_snow(kk,1:nsnow_max)*vsnow(kk)%hliq(1:nsnow_max) + &
                  cisoice_snow(kk,1:nsnow_max)*(vsnow(kk)%hsnow(1:nsnow_max)-vsnow(kk)%hliq(1:nsnow_max))) / &
                  vsnow(kk)%hsnow(1:nsnow_max)
          ENDIF

       ENDIF ! isotopologue/=0

    END DO ! while (t<tfin)
  END SUBROUTINE timestep_loop

  SUBROUTINE solve(ts, tfin, irec, mp, qprec, qprec_snow, n, dx, h0, S, thetai, Jsensible, Tsoil, evap, evap_pot, runoff, &
       infil, drainage, discharge, qh, nsteps, vmet, vlit, vsnow, var, csoil, kth, phi, T0, Tsurface, Hcum, lEcum, &
       Gcum, Qadvcum, Jcol_sensible, Jcol_latent_S, Jcol_latent_T, deltaice_cum_T, deltaice_cum_S, dxL, zdelta, &
       SL, TL, plit, par, qex, wex, heads,  &
       ciso, cisoice, ciso_snow, cisoice_snow, cisos, cprec, cprec_snow, cali, &
       qali, qiso_in, qiso_out, qiso_evap_cum, qiso_trans_cum, qiso_liq_adv, &
       qiso_vap_adv, qiso_liq_diff, qiso_vap_diff, qvsig, qlsig, qvTsig, qvh, deltaTa, lE_old, &
       dolitter, doisotopologue, docondition, doadvection, err)

    IMPLICIT NONE

    REAL(r_2),                             INTENT(IN)              :: ts, tfin
    INTEGER(i_d),                          INTENT(IN)              :: irec, mp
    REAL(r_2),      DIMENSION(1:mp),       INTENT(IN)              :: qprec
    REAL(r_2),      DIMENSION(1:mp),       INTENT(INOUT)           :: qprec_snow
    INTEGER(i_d),                          INTENT(IN)              :: n
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(IN)              :: dx
    REAL(r_2),      DIMENSION(1:mp),       INTENT(INOUT)           :: h0
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(INOUT)           :: S
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(OUT)             :: thetai
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(OUT)             :: Jsensible
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(INOUT)           :: Tsoil
    REAL(r_2),      DIMENSION(1:mp),       INTENT(INOUT)           :: evap
    REAL(r_2),      DIMENSION(1:mp),       INTENT(OUT)             :: evap_pot, runoff, infil
    REAL(r_2),      DIMENSION(1:mp),       INTENT(OUT)             :: drainage, discharge
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max:n), INTENT(OUT)      :: qh
    INTEGER(i_d),   DIMENSION(1:mp),       INTENT(OUT)             :: nsteps
    TYPE(vars_met), DIMENSION(1:mp),       INTENT(INOUT)           :: vmet
    TYPE(vars),     DIMENSION(1:mp),       INTENT(INOUT)           :: vlit
    TYPE(vars_snow), DIMENSION(1:mp),      INTENT(INOUT)           :: vsnow
    TYPE(vars),     DIMENSION(1:mp,1:n),   INTENT(INOUT)           :: var
    REAL(r_2),      DIMENSION(1:mp),       INTENT(INOUT)           :: T0, Tsurface
    REAL(r_2),      DIMENSION(1:mp),       INTENT(OUT)             :: Hcum, lEcum,  deltaice_cum_T, deltaice_cum_S
    REAL(r_2),      DIMENSION(1:mp),       INTENT(OUT)             :: Gcum, Qadvcum
    REAL(r_2),      DIMENSION(1:mp),       INTENT(OUT)             :: Jcol_sensible, Jcol_latent_S, Jcol_latent_T
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(OUT)             :: csoil, kth
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(INOUT)           :: phi
    REAL(r_2),      DIMENSION(1:mp),       INTENT(IN)              :: dxL
    REAL(r_2),      DIMENSION(1:mp),       INTENT(INOUT)           :: zdelta, SL, Tl
    TYPE(params),   DIMENSION(1:mp),       INTENT(IN)              :: plit
    TYPE(params),   DIMENSION(1:mp,1:n),   INTENT(INOUT)           :: par
    REAL(r_2),       DIMENSION(1:mp,1:n),  INTENT(IN), OPTIONAL    :: qex
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(INOUT), OPTIONAL :: wex
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(OUT),   OPTIONAL :: heads
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(INOUT), OPTIONAL :: ciso
    REAL(r_2),      DIMENSION(1:mp,1:n),   INTENT(INOUT), OPTIONAL :: cisoice
    REAL(r_2),      DIMENSION(1:mp,1:nsnow_max),   INTENT(INOUT), OPTIONAL :: ciso_snow
    REAL(r_2),      DIMENSION(1:mp,1:nsnow_max),   INTENT(INOUT), OPTIONAL :: cisoice_snow
    REAL(r_2),      DIMENSION(1:mp),       INTENT(INOUT), OPTIONAL :: cisos
    REAL(r_2),      DIMENSION(1:mp),       INTENT(IN),    OPTIONAL :: cprec
    REAL(r_2),      DIMENSION(1:mp),       INTENT(IN),    OPTIONAL :: cprec_snow
    REAL(r_2),      DIMENSION(1:mp),       INTENT(IN),    OPTIONAL :: cali
    REAL(r_2),      DIMENSION(1:mp),       INTENT(IN),    OPTIONAL :: qali
    REAL(r_2),      DIMENSION(1:mp),       INTENT(OUT),   OPTIONAL :: qiso_in, qiso_out
    REAL(r_2),      DIMENSION(1:mp),       INTENT(OUT),   OPTIONAL :: qiso_evap_cum, qiso_trans_cum
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max+1:n),   INTENT(OUT),   OPTIONAL :: qiso_liq_adv, qiso_vap_adv
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max+1:n-1), INTENT(OUT),   OPTIONAL :: qiso_liq_diff, qiso_vap_diff
    REAL(r_2),      DIMENSION(1:mp,-nsnow_max:n),   INTENT(OUT),   OPTIONAL :: qvsig, qlsig, qvTsig, qvh
    REAL(r_2),      DIMENSION(1:mp),       INTENT(INOUT), OPTIONAL :: deltaTa
    REAL(r_2),      DIMENSION(1:mp),       INTENT(IN),    OPTIONAL :: lE_old
    INTEGER(i_d),                          INTENT(IN),    OPTIONAL :: dolitter       ! 0: no; 1: normal; 2: resistance
    INTEGER(i_d),                          INTENT(IN),    OPTIONAL :: doisotopologue ! 0: no isotope; 1: HDO; 2: H218O
    INTEGER(i_d),                          INTENT(IN),    OPTIONAL :: docondition    ! 0: no cond., 1: columns, 2: lines, 3: both
    INTEGER(i_d),                          INTENT(IN),    OPTIONAL :: doadvection    ! 0: off; 1: onn
    ! Error flag if nstep of SLI > nsteps_max: err=0 -> no error; err/=0 -> error
    INTEGER(i_d),  DIMENSION(1:mp),        INTENT(INOUT), OPTIONAL :: err

    ! Solves the RE and, optionally, the ADE from time ts to tfin.
    ! Definitions of arguments:
    ! Required args:
    ! ts   - start time (h).
    ! tfin   - finish time.
    ! qprec   - precipitation (or water input) rate (fluxes are in cm/h).
    ! qevap   - potl evaporation rate from soil surface.
    ! n    - no. of soil layers.
    ! nsol   - no. of solutes.
    ! dx(1:n) - layer thicknesses.
    ! h0   - surface head, equal to depth of surface pond.
    ! S(1:n)  - degree of saturation ("effective satn") of layers.
    ! evap   - cumulative evaporation from soil surface (cm, not initialised).
    ! runoff  - cumulative runoff.
    ! infil   - cumulative net infiltration (time integral of flux across surface).
    ! drn   - cumulative net drainage (time integral of flux across bottom).
    ! nsteps  - cumulative no. of time steps for RE soln.
    ! Optional args:
    ! heads(1:n)   - matric heads h of layers at finish.
    ! qexsub    - subroutine to get layer water extraction rates (cm/h) by
    !     plants. Note that there is no solute extraction and osmotic
    !     effects due to solute are ignored. Arguments:
    !     qex(1:n) - layer extraction rates; qexh(1:n) - partial
    !     derivs of qex wrt h.
    ! wex(1:n)    - cumulative water extraction from layers.
    ! cin(1:nsol)   - solute concns in water input (user's units/cc).
    ! c0(1:nsol)   - solute concns in surface pond.
    ! sm(1:n,1:nsol)  - solute (mass) concns in layers.
    ! soff(1:nsol)   - cumulative solute runoff (user's units).
    ! sinfil(1:nsol)  - cumulative solute infiltration.
    ! sdrn(1:nsol)   - cumulative solute drainage.
    ! nssteps(1:nsol) - cumulative no. of time steps for ADE soln.
    ! isosub    - subroutine to get adsorbed solute (units/g soil) from concn
    !     in soil water according to chosen isotherm code.
    !     Arguments: iso - 2 character code; c - concn in soil water;
    !     p(:) - isotherm parameters; f - adsorbed mass/g soil;
    !     fc - deriv of f wrt c (slope of isotherm curve). Note that
    !     linear adsorption does not require a sub, and other types
    !     are available in sub isosub.

    REAL(r_2),    DIMENSION(1:mp)       :: precip, qevap
    REAL(r_2),    DIMENSION(1:mp)       :: qL, qhL, qybL, qTbL, qhTbL, qhybL, rexcol, wcol, ql0, qv0
    LOGICAL,      DIMENSION(1:mp)       :: again, getq0,getqn,init
    LOGICAL,      DIMENSION(1:mp,1:n)   :: again_ice
    INTEGER(i_d), DIMENSION(1:mp)       :: ih0, iok, itmp, ns, nsat, nsatlast, nsteps0
    REAL(r_2),    DIMENSION(1:mp)       :: accel, dmax, dt, dwinfil, dwoff, fac, Khmin1, Kmin1, phimin1, phip
    REAL(r_2),    DIMENSION(1:mp)       :: qpme, rsig, rsigdt, sig, t
    REAL(r_2),    DIMENSION(1:mp,1:n)   :: Sbot, Tbot
    REAL(r_2),    DIMENSION(1:mp,1:n-1) :: dz
    REAL(r_2),    DIMENSION(1:mp,1:n)   :: hint, phimin, qexd
    !   REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   :: aa, bb, cc, dd, ee, ff, gg, dy
    !   REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   :: aah, bbh, cch, ddh, eeh, ffh, ggh, de
    !   REAL(r_2),    DIMENSION(1:mp,-nsnow_max:n)   :: q, qya, qyb, qTa, qTb,qhya, qhyb, qhTa, qhTb
    !   REAL(r_2),    DIMENSION(1:mp,-nsnow_max:n)   :: qadv, qadvya, qadvyb, qadvTa, qadvTb

    TYPE(vars)                          :: vtmp
    !TYPE(vars),   DIMENSION(1:mp,1:n)   :: var
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max:n)   :: qsig, qhsig, qadvsig
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max:n)   :: qliq, qv, qvT, qlya, qlyb, qvya, qvyb, qlTb, qvTa, qvTb
    TYPE(vars),   DIMENSION(1:mp,1:n)   :: vcall
    REAL(r_2),    DIMENSION(1:mp,1:n)   :: deltaS, dTsoil
    REAL(r_2),    DIMENSION(1:mp,0:n)   :: tmp2d1, tmp2d2
    !    REAL(r_2),    DIMENSION(1:mp,1:n)   :: S0, Sliq0, Sliq, deltaSliq, cv0, deltacv
    !    REAL(r_2),    DIMENSION(1:mp,1:n)   :: Sliqice0, Sliqice, deltaSliqice
    !    REAL(r_2),    DIMENSION(1:mp,1:n)   :: Sice0, Sice, deltaSice
    !
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   :: Sliq0_ss, Sliq_ss, deltaSliq_ss
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   :: Sliqice0_ss, Sliqice_ss, deltaSliqice_ss
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   :: Sice0_ss, Sice_ss, deltaSice_ss
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   :: S0_ss, S_ss, deltaS_ss, Tsoil_ss, dTsoil_ss
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   :: cv0_ss, cv_ss, Dv_ss, deltacv_ss, dx_ss
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n-1)   :: dz_ss
    !    REAL(r_2),      DIMENSION(1:mp,1:nsnow_max) :: cisoliqice_snow
    !    INTEGER(i_d) :: itop ! integer corresponding to top of soil-snow column
    !    INTEGER(i_d) :: nsnow ! number of dedicated snow layers
    !    REAL(r_2),    DIMENSION(1:mp,1:n)   :: tmp_thetasat, tmp_thetar
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   :: thetasat_ss, thetar_ss
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   ::  tmp_tortuosity
    !    REAL(r_2),    DIMENSION(1:mp,-nsnow_max+1:n)   ::  ciso_ss, cisoice_ss
    !    REAL(r_2),    DIMENSION(1:mp,1:n)   :: delthetai, dthetaldT, thetal
    INTEGER(i_d), DIMENSION(1:mp,1:n)   :: isave !, nsteps_ice, imelt

    TYPE(vars),         DIMENSION(1:mp) :: vtop, vbot
    TYPE(vars_aquifer), DIMENSION(1:mp) :: v_aquifer
    REAL(r_2),          DIMENSION(1:mp) :: qd, dwcol, dwdrainage, drn,inlit, dwinlit, drexcol, dwdischarge
    REAL(r_2),          DIMENSION(1:mp) :: dJcol_latent_S, dJcol_latent_T, dJcol_sensible
    REAL(r_2),          DIMENSION(1:mp,1:n):: deltaJ_latent_S, deltaJ_latent_T, deltaJ_sensible_S, deltaJ_sensible_T
    REAL(r_2),          DIMENSION(1:mp) :: qevapsig
    REAL(r_2),          DIMENSION(1:mp) :: qrunoff
    REAL(r_2),          DIMENSION(1:mp) :: tmp1d1, tmp1d2, tmp1d3,  tmp1d4
    REAL(r_2),          DIMENSION(1:mp) :: deltah0
    REAL(r_2),          DIMENSION(1:mp) :: SL0, deltaSL, cvL0, SLliq0, deltacvL, SLliq, deltaSLliq
    REAL(r_2),          DIMENSION(1:mp) :: qiso_evap, qiso_trans
    REAL(r_2),          DIMENSION(1:mp) :: lE0, G0, Epot
    REAL(r_2),          DIMENSION(1:mp) :: Tfreezing, dT0
    REAL(r_2),          DIMENSION(1:mp) :: dtdT
    REAL(r_2),          DIMENSION(1:mp,-nsnow_max+1:n) :: LHS, RHS, LHS_h, RHS_h
    INTEGER(i_d),       DIMENSION(1:mp) :: surface_case

    INTEGER(i_d),       DIMENSION(1:mp) :: nns, iflux
    LOGICAL      :: litter
    INTEGER(i_d) :: i, j, k, kk, condition
    INTEGER(i_d) :: littercase, isotopologue, advection ! switches
    REAL(r_2)    :: ztmp, c2, theta
    REAL(r_2)    :: dTqwdTa, dTqwdTb, Tqw, keff
    REAL(r_2),          DIMENSION(1:mp) :: cp, cpeff, hice, deltahice, h0_0, hice_0, h0_tmp, hice_tmp
    !REAL(r_2),          DIMENSION(1:mp,nsnow_max) :: qmelt, hsnow
    ! tranfer of water  from soil to   snow (+ve) or soil to snow (-ve) at init or termination of snowpack
    REAL(r_2),  DIMENSION(1:mp) :: qtransfer
    REAL(r_2),  DIMENSION(1:mp) :: qmelt_ss ! melt water from bottom snow layer to soil
    REAL(r_2),  DIMENSION(1:mp) :: qprec_ss
    REAL(r_2),  DIMENSION(1:mp) :: cprec_ss
    REAL(r_2),          DIMENSION(1:mp,nsnow_max) :: delta_snowcol, delta_snowT, delta_snowliq, dTsnow
    REAL(r_2),          DIMENSION(1:mp) :: melt ! cumulative loss of snow pack as melt water
    REAL(r_2),      DIMENSION(1:mp,1:n)       :: thetai_0, J0
    REAL(r_2) :: tmp1, tmp2
    REAL(r_2),          DIMENSION(1:mp,1:n) :: iqex, thetal_max
    REAL(r_2),          DIMENSION(1:mp)     :: icali
    INTEGER(i_d),       DIMENSION(1:mp) :: nfac1, nfac2, nfac3, nfac4, nfac5, &
         nfac6, nfac7, nfac8, nfac9, nfac10, nfac11, nfac12
    REAL(r_2),          DIMENSION(1:mp)     :: J0snow, wcol0snow
    REAL(r_2), DIMENSION(1:n) :: h_ex
    REAL(r_2) :: wpi

    !open (unit=7, file="Test.out", status="replace", position="rewind")
    ! The derived types params and vars hold soil water parameters and variables.
    ! Parameter names often end in e, which loosely denotes "air entry", i.e.,
    ! values at h=he. While values of water content th and hydraulic conductivity K
    ! at h=he are equal to those at saturation, the derivs wrt S are nonzero. The
    ! MFP phi for h>he is given by phi=phie+Ke*(h-he). The saturation status of a
    ! layer is stored as 0 or 1 in isat since S may be >1 (because of previous
    ! overshoot) when a layer desaturates. Fluxes at the beginning of a time step
    ! and their partial derivs wrt S or phi of upper and lower layers or boundaries
    ! are stored in q, qya and qyb.


    ! set switches
    IF (PRESENT(dolitter)) THEN
       littercase = dolitter
    ELSE
       littercase = 0
    ENDIF
    IF (PRESENT(doadvection)) THEN
       advection = doadvection
    ELSE
       advection = 0
    ENDIF
    IF (littercase > 2) THEN
       WRITE(*,*) 'dolitter not in [0-2]: ', littercase
       STOP 2
    ENDIF

    IF (PRESENT(doisotopologue)) THEN
       isotopologue = doisotopologue
    ELSE
       isotopologue = 0
    ENDIF
    IF (isotopologue > 2) THEN
       WRITE(*,*) 'doisotopologue not in [0-2]: ', isotopologue
       STOP 2
    ENDIF
    IF (isotopologue /= 0 .AND. (.NOT. PRESENT(ciso))) THEN
       WRITE(*,*) 'doisotopologue /= 0 but no ciso present.'
       STOP 2
    ENDIF

    IF (PRESENT(docondition)) THEN
       condition = docondition
    ELSE
       condition = 0
    ENDIF
    IF (condition < 0 .OR. condition > 3) THEN
       WRITE(*,*) 'docondition not in [0-3]: ', condition
       STOP 2
    ENDIF

    IF (PRESENT(qex)) THEN
       iqex = qex
    ELSE
       iqex = zero
    ENDIF

    IF (PRESENT(qali) .AND. PRESENT(cali)) THEN
       WHERE (qali>zero)
          icali = cali
       ELSEWHERE
          icali = zero
       endwhere
    ELSE
       icali = zero
    ENDIF

    ! global counters
    IF (.NOT. ALLOCATED(nless)) ALLOCATE(nless(mp))
    nless(:) = 0
    IF (.NOT. ALLOCATED(n_noconverge)) ALLOCATE(n_noconverge(mp))
    n_noconverge(:) = 0

    ! set solve_type for numerical derivatives
    IF (.NOT. ALLOCATED(sol)) CALL setsol(mp)

    ! initialise cumulative variables
    wcol(:)      = zero
    Jcol_sensible(:) = zero
    Jcol_latent_S(:) = zero
    Jcol_latent_T(:) = zero
    deltaice_cum_T(:) = zero
    deltaice_cum_S(:) = zero
    deltaJ_sensible_S(:,:) = zero
    deltaJ_sensible_T(:,:) = zero
    deltaJ_latent_S(:,:) = zero
    deltaJ_latent_T(:,:) = zero
    drainage(:)  = zero
    discharge(:) = zero
    infil(:)     = zero
    inlit(:)     = zero
    dwinlit(:)   = zero
    evap(:)      = zero
    evap_pot(:)  = zero
    runoff(:)    = zero
    melt(:) = zero
    rexcol(:)    = zero
    Hcum(:)      = zero
    Gcum(:)      = zero
    lEcum(:)     = zero
    Qadvcum(:)  = zero
    wex(:,:)          = zero
    precip(:)         = zero
    drn(:)            = zero
    IF (isotopologue /= 0) THEN
       qiso_evap_cum(:)  = zero
       qiso_trans_cum(:) = zero
    ENDIF
    deltah0(:) = zero
    ! zero var-structure that contains all the hydrological variables
    vtmp = zerovars()
    vtmp%h       = one
    vtmp%lambdav = rlambda
    vtmp%lambdaf = lambdaf
    ! zero vars at the bottom and top of the soil column
    vtop = SPREAD(vtmp,1,mp)
    vbot = SPREAD(vtmp,1,mp)
    vlit = SPREAD(vtmp,1,mp)
    ! Vanessa: try this with limited stacksize, otherwise the double-loop
    !var = spread(vtop,2,n)
    ! do i=1, mp
    !    do k=1, n
    !       var(i,k) = vtmp
    !    end do
    ! end do
    hint(:,:)   = zero
    phimin(:,:) = zero
    dTsoil(:,:) = zero
    keff               = zero
    dTqwdTa            = zero
    dTqwdTb            = zero
    Tqw                = zero
    ztmp               = zero
    c2                 = zero
    theta              = zero
    cp                 = zero
    cpeff              = zero
    hice               = zero
    deltahice          = zero
    h0_0               = zero
    hice_0             = zero
    h0_tmp             = zero
    hice_tmp           = zero
    !qmelt(:,:)         = zero
    qmelt_ss(:)        = zero
    cprec_ss(:) = zero
    qprec_ss(:) = zero
    qtransfer(:)       = zero
    !hsnow(:,:)         = zero
    delta_snowcol(:,:) = zero
    delta_snowT(:,:)   = zero
    delta_snowliq(:,:) = zero
    dTsnow(:,:)        = zero
    melt(:)            = zero
    thetai_0(:,:)      = zero
    J0(:,:)            = zero
    dT0(:)             = zero
    thetal_max         = zero
    nsteps             = 0
    qvsig(:,:)         = zero
    qlsig(:,:)         = zero

    ! initialise snow Ebal diagnostics
    vsnow(:)%Qadv_rain = zero
    vsnow(:)%Qadv_snow = zero
    vsnow(:)%Qadv_vap  = zero
    vsnow(:)%Qcond_net = zero

    DO k=1, nsnow_max
       vsnow(:)%deltaJlatent(k)   = zero
       vsnow(:)%deltaJsensible(k) = zero
    ENDDO
    vsnow(:)%Qadv_transfer  = zero
    vsnow(:)%Qadv_melt      = zero
    vsnow(:)%FluxDivergence = zero

    vsnow(:)%MoistureFluxDivergence = zero
    vsnow(:)%Qprec = zero
    vsnow(:)%Qvap = zero
    vsnow(:)%Qevap = zero
    vsnow(:)%Qtransfer = zero
    vsnow(:)%Qmelt = zero

    litter = .FALSE.
    IF (littercase == 1) litter=.TRUE. ! full litter model

    qexd(:,:) = zero
    phip(:)   = zero !max(par(:,1)%phie-par(:,1)%he*par(:,1)%Ke, 1.00001_r_2*par(:,1)%phie) ! phi at h=0

    ! get K, Kh and phi at hmin (hmin is smallest h, stored in hy-props)
    DO k=1, mp
       CALL hyofh(hmin, par(k,1)%lam, par(k,1)%eta, par(k,1)%Ke, par(k,1)%he, Kmin1(k), Khmin1(k), phimin1(k))
    END DO

    dz(:,:) = half*(dx(:,1:n-1)+dx(:,2:n)) ! flow paths

    !----- set up for boundary conditions
    getq0(:) = .FALSE.
    getqn(:) = .FALSE.
    IF (botbc == "constant head") THEN ! h at bottom bdry specified
       getqn(:)  = .TRUE.
       tmp1d1(:)  = hbot
       ! for hbot < he
       Sbot(:,:) = SPREAD(Sofh(tmp1d1,par(:,n)),1,n)

       Tbot(:,:) = SPREAD(Tsoil(:,n),1,n)
       ! Debug for mp=1: remove elemental from hyofS and do loop instead of next line
       CALL hyofS(Sbot, Tbot, par, vcall)
       !do i=1, n
       !   call hyofS(Sbot(1,i), Tbot(1,i), par(1,i), vcall(1,i))
       !end do
       ! End debug hyofS
       ! for hbot >= he
       vtmp = zerovars()
       vtmp%isat    = 1
       vtmp%h       = hbot
       vtmp%rh      = one
       vtmp%lambdav = rlambda
       vtmp%lambdaf = lambdaf
       vbot = SPREAD(vtmp,1,mp)
       vbot(:)%phi = (hbot-par(:,n)%he)*par(:,n)%Ke+var(:,n)%phie
       vbot(:)%K   = par(:,n)%Ke
       WHERE (par(:,n)%he > hbot)
          vbot(:)      = vcall(:,n)
          vbot(:)%isat = 0
       endwhere
    END IF
    !----- end set up for boundary conditions

    !----- initialise
    nfac1  = 0
    nfac2  = 0
    nfac3  = 0
    nfac4  = 0
    nfac5  = 0
    nfac6  = 0
    nfac7  = 0
    nfac8  = 0
    nfac9  = 0
    nfac10 = 0
    nfac11 = 0
    nfac12=0
    t(:)       = ts
    nsteps0(:) = nsteps
    nsat(:)    = 0
    qd(:)      = zero
    ! initialise saturated regions
    var(:,:)%isat  = 0
    WHERE (S(:,:) >= one)
       var(:,:)%K    = par(:,:)%Ke
       var(:,:)%isat = 1
       var(:,:)%phi = phi
    endwhere

    vlit(:)%isat = 0
    WHERE (SL(:) >= one) vlit(:)%isat = 1

    ! initialise litter
    IF (littercase == 1 .OR. littercase == 2) THEN
       CALL litter_props(Sl(:), Tl(:), vlit(:), plit(:), h0(:))
    ENDIF
    ! Add resistance through litter for simple litter model
    IF (littercase == 2) THEN
       ztmp        = one/rhocp
       WHERE (vsnow(:)%nsnow == 0)
          vmet(:)%rbw = vmet(:)%rbw + dxL(:)/vlit(:)%Dv
          vmet(:)%rbh = vmet(:)%rbh + dxL(:)/(vlit(:)%kH*ztmp)
          vmet(:)%rrc = vmet(:)%rrc + dxL(:)/(vlit(:)%kH*ztmp)
       endwhere
    ENDIF

    lE0(:) = lE_old(:) ! used for initial guess of litter temperature
    !----- end initialise

    !----- solve until tfin
    init(:) = .TRUE. ! flag to initialise h at soil interfaces
    DO kk=1, mp
       !  rewind(3337)
       !  write(3337,*) irec, kk, Tsoil(kk,1)

       !  CALL snow_augment(irec, mp, n, kk, ns, qprec_snow, vmet%Ta, tfin, h0, hice, thetai, dx, vsnow, var, par, S, Tsoil, &
       !                 Jcol_latent_S, Jcol_latent_T, Jcol_sensible, deltaJ_sensible_S, qmelt, qtransfer, j0snow)
       J0snow(kk) = vsnow(kk)%J ! for tracking change in internal energy of snowpack


       wcol0snow(kk) = SUM(vsnow(kk)%hsnow(1:nsnow_max)) ! for tracking change in water content of snowpack

       CALL timestep_loop( &
            tfin, irec, mp, qprec, qprec_snow, n, dx(kk,:), h0, S(kk,:), thetai(kk,:), Jsensible(kk,:), &
            Tsoil(kk,:), evap, runoff, &
            infil, drainage, discharge, qh, nsteps, vmet, vlit, vsnow, var(kk,:), T0, Tsurface, Hcum, lEcum, deltaice_cum_T, &
            deltaice_cum_S, Gcum, Qadvcum, Jcol_sensible, Jcol_latent_S, Jcol_latent_T, csoil(kk,:), kth(kk,:), &
            phi(kk,:), dxL, zdelta, &
            SL, Tl, plit, par(kk,:), wex, ciso, cisoice, ciso_snow, cisoice_snow, cisos, cprec, cprec_snow, qali, &
            qiso_in, qiso_out, &
            qiso_evap_cum, qiso_trans_cum, qiso_liq_adv, qiso_vap_adv, qiso_liq_diff, qiso_vap_diff, qvsig, qlsig, &
            qvTsig, qvh, deltaTa, &
            precip, qevap, qL, qhL, qybL, qTbL, qhTbL, qhybL, rexcol, wcol, ql0, qv0, again, getq0,getqn,init, &
            again_ice, ih0, iok, itmp, &
            ns, nsat, nsatlast, nsteps0, accel, dmax, dt, dwinfil, dwoff, fac, phip, qpme, rsig, rsigdt, sig, t, hint(kk,:), &
            phimin(kk,:), qexd(kk,:), &
            vtmp, deltaS(kk,:), dTsoil(kk,:), tmp2d1(kk,:), tmp2d2(kk,:), vtop, vbot, v_aquifer, dwcol, &
            dwdrainage, drn,inlit, &
            dwinlit, drexcol, dwdischarge, dJcol_latent_S, dJcol_latent_T, dJcol_sensible, deltaJ_latent_S(kk,:), &
            deltaJ_latent_T(kk,:), &
            deltaJ_sensible_S(kk,:), deltaJ_sensible_T(kk,:), qevapsig, qrunoff, tmp1d1, tmp1d2, tmp1d3, tmp1d4, &
            deltah0, SL0, deltaSL, &
            cvL0, SLliq0, deltacvL, SLliq, deltaSLliq, qiso_evap, qiso_trans, lE0, G0, Epot, Tfreezing, dtdT, &
            LHS(kk,:), RHS(kk,:), LHS_h(kk,:), RHS_h(kk,:), &
            surface_case, nns, iflux, litter, i, j, k, kk, condition, littercase, isotopologue, advection, &
            c2, theta, dTqwdTa, &
            dTqwdTb, Tqw, keff, cp, cpeff, hice, deltahice, h0_0, hice_0, h0_tmp, hice_tmp, qtransfer, qmelt_ss, qprec_ss, &
            cprec_ss, delta_snowcol(kk,:), delta_snowT(kk,:), delta_snowliq(kk,:), thetai_0(kk,:), J0(kk,:), &
            tmp1, tmp2, iqex(kk,:), icali, nfac1, nfac2, &
            nfac3, nfac4, nfac5, nfac6, nfac7, nfac8, nfac9, nfac10, nfac11, nfac12, J0snow, wcol0snow, h_ex, wpi,  &
            err=err(kk))
       ! only if melt_transfer=.false.: runoff(kk) = runoff(kk) + vsnow(kk)%Qmelt
       runoff(kk) = runoff(kk) + vsnow(kk)%Qmelt
    END DO ! kk=1, mp

    ! get heads if required
    IF (PRESENT(heads)) THEN
       isave    = var%isat
       var%isat = isave
       heads    = var%h
       WHERE (S(:,:) >= one) heads(:,:) = par(:,:)%he + (var(:,:)%phi-par(:,:)%phie)/par(:,:)%Ke
    END IF

  END SUBROUTINE solve

  !=============================================================================

  ! SUBROUTINE solute(ti,tf,thi,thf,win,cin,n,ns,dx,jt,dsmmax,sm,sdrn,nssteps,c, &
  !      isosub)

  !   USE sli_utils, ONLY: dis, isotype, bd, isopar

  !   IMPLICIT NONE

  !   INTEGER(i_d),INTENT(IN)::n,ns,jt(n)
  !   REAL(r_2),INTENT(IN)::ti,tf,thi(n),thf(n),win,cin(ns),dx(n),dsmmax
  !   INTEGER(i_d),INTENT(INOUT)::nssteps(ns)
  !   REAL(r_2),INTENT(INOUT)::sm(n,ns),sdrn(ns),c(n,ns)
  !   OPTIONAL::isosub
  !   INTERFACE
  !      SUBROUTINE isosub(iso,c,p,f,fc)
  !        USE sli_numbers, ONLY: r_2
  !        CHARACTER(LEN=2),INTENT(IN)::iso
  !        REAL(r_2),INTENT(IN)::c
  !        REAL(r_2),DIMENSION(:),INTENT(INOUT)::p
  !        REAL(r_2),INTENT(OUT)::f, fc
  !      END SUBROUTINE isosub
  !   END INTERFACE
  !   ! Solves the ADE from time ti to tf. Diffusion of solute ignored - dispersion
  !   ! coeff = dispersivity * abs(pore water velocity).
  !   ! Definitions of arguments:
  !   ! Required args:
  !   ! ti   - start time (h).
  !   ! tf   - finish time.
  !   ! thi(1:n)  - initial layer water contents.
  !   ! thf(1:n)  - final layer water contents.
  !   ! win   - water in at top of profile.
  !   ! cin(1:ns)  - solute concn in win.
  !   ! n    - no. of soil layers.
  !   ! ns   - no. of solutes.
  !   ! dx(1:n)  - layer thicknesses.
  !   ! jt(1:n)  - layer soil type nos.
  !   ! dsmmax(1:ns) - max change in sm of any layer to aim for each time step;
  !   !      controls time step size.
  !   ! sm(1:n,1:ns) - layer masses of solute per cc.
  !   ! sdrn(1:ns) - cumulative solute drainage.
  !   ! nssteps(1:ns) - cumulative no. of time steps for ADE soln.
  !   ! Optional args:
  !   ! isosub  - subroutine to get adsorbed solute (units/g soil) from concn
  !   !      in soil water according to chosen isotherm code.
  !   !      Arguments: iso - 2 character code; c - concn in soil water;
  !   !      p(:) - isotherm parameters; f - adsorbed mass/g soil;
  !   !      fc - deriv of f wrt c (slope of isotherm curve).
  !   INTEGER(i_d),PARAMETER::itmax=20 ! max iterations for finding c from sm
  !   REAL(r_2),PARAMETER::eps=0.00001 ! for stopping
  !   INTEGER(i_d)::i,it,j,k
  !   REAL(r_2)::dc,dm,dmax,dt,dz(n-1),f,fc,r,rsig,rsigdt,sig,sigdt,t,tfin,th,v1,v2
  !   REAL(r_2),DIMENSION(n-1)::coef1,coef2
  !   REAL(r_2),DIMENSION(n)::csm,tht
  !   REAL(r_2),DIMENSION(0:n)::aa,bb,cc,dd,dy,q,qw,qya,qyb
  !   INTEGER(i_d) :: info

  !   sig=half
  !   rsig=one/sig
  !   tfin=tf
  !   dz=half*(dx(1:n-1)+dx(2:n))
  !   !get average water fluxes
  !   r=one/(tf-ti)
  !   qw(0)=r*win
  !   tht=r*(thf-thi)
  !   do i=1,n
  !      qw(i)=qw(i-1)-dx(i)*tht(i)
  !   end do
  !   !get constant coefficients
  !   do i=1,n-1
  !      v1=half*qw(i)
  !      v2=half*(dis(jt(i))+dis(jt(i+1)))*abs(qw(i))/dz(i)
  !      coef1(i)=v1+v2
  !      coef2(i)=v1-v2
  !   end do
  !   do j=1,ns
  !      t=ti
  !      if (qw(0)>zero) then
  !         q(0)=qw(0)*cin(j)
  !      else
  !         q(0)=zero
  !      end if
  !      qyb(0)=zero
  !      do while (t<tfin)
  !         ! get fluxes
  !         do i=1,n
  !            ! get c and csm=dc/dsm (with theta constant)
  !            k=jt(i)
  !            th=thi(i)+(t-ti)*tht(i)
  !            if (isotype(k,j)=="no" .or. sm(i,j)<zero) then ! handle sm<0 here
  !               csm(i)=one/th
  !               c(i,j)=csm(i)*sm(i,j)
  !            else if (isotype(k,j)=="li") then
  !               csm(i)=one/(th+bd(k)*isopar(k,j)%p(1))
  !               c(i,j)=csm(i)*sm(i,j)
  !            else
  !               do it=1,itmax ! get c from sm using Newton's method and bisection
  !                  if (c(i,j)<zero) c(i,j)=zero ! c and sm are >=0
  !                  call isosub(isotype(k,j), c(i,j), isopar(k,j)%p(:), f, fc)
  !                  csm(i)=one/(th+bd(k)*fc)
  !                  dm=sm(i,j)-(bd(k)*f+th*c(i,j))
  !                  dc=dm*csm(i)
  !                  if (sm(i,j)>=zero .and. c(i,j)+dc<zero) then
  !                     c(i,j)=half*c(i,j)
  !                  else
  !                     c(i,j)=c(i,j)+dc
  !                  end if
  !                  if (abs(dm)<eps*(sm(i,j)+10.0_r_2*dsmmax)) exit
  !                  if (it==itmax) then
  !                     write(*,*) "solute: too many iterations getting c"
  !                     stop
  !                  end if
  !               end do
  !            end if
  !         end do
  !         q(1:n-1)=coef1*c(1:n-1,j)+coef2*c(2:n,j)
  !         qya(1:n-1)=coef1*csm(1:n-1)
  !         qyb(1:n-1)=coef2*csm(2:n)
  !         q(n)=qw(n)*c(n,j)
  !         qya(n)=qw(n)*csm(n)
  !         ! get time step
  !         dmax=maxval(abs(q(1:n)-q(0:n-1))/dx)
  !         if (dmax==zero) then
  !            dt=tfin-t
  !         elseif (dmax<zero) then
  !            write(*,*) "solute: errors in fluxes prevent continuation"
  !            stop
  !         else
  !            dt=dsmmax/dmax
  !         end if
  !         if (t+1.1_r_2*dt>tfin) then
  !            dt=tfin-t
  !            t=tfin
  !         else
  !            t=t+dt
  !         end if
  !         sigdt=sig*dt
  !         rsigdt=one/sigdt
  !         ! adjust q for change in theta
  !         q(1:n-1)=q(1:n-1)-sigdt*(qya(1:n-1)*tht(1:n-1)*c(1:n-1,j)+ &
  !              qyb(1:n-1)*tht(2:n)*c(2:n,j))
  !         q(n)=q(n)-sigdt*qya(n)*tht(n)*c(n,j)
  !         ! get and solve eqns
  !         aa(2:n)=qya(1:n-1)
  !         cc(1:n-1)=-qyb(1:n-1)
  !         bb(1:n)=qyb(0:n-1)-qya(1:n)-dx*rsigdt
  !         dd(1:n)=-(q(0:n-1)-q(1:n))*rsig
  !         call dgtsv(n, 1, aa(2:n), bb(1:n), cc(1:n-1), dd(1:n), n, info)
  !         if (info > 0) then
  !            write(*,*) 'solute: singular matrix (01).'
  !            stop
  !         endif
  !         dy(1:n) = dd(1:n)

  !         ! update unknowns
  !         sdrn(j)=sdrn(j)+(q(n)+sig*qya(n)*dy(n))*dt
  !         sm(:,j)=sm(:,j)+dy(1:n)
  !         nssteps(j)=nssteps(j)+1
  !      end do
  !   end do
  ! END SUBROUTINE solute
  !=============================================================================
  SUBROUTINE snow_augment( mp, kk,  qprec_snow, Ta, tfin,     vsnow     &
       )

    INTEGER(i_d),                               INTENT(IN)    :: mp    ! # of grid-cells
    INTEGER(i_d),                               INTENT(IN)    :: kk    ! grid-cell reference
    REAL(r_2),    DIMENSION(mp),             INTENT(INOUT) :: qprec_snow    ! snowfall ms-1
    REAL(r_2),    DIMENSION(mp),             INTENT(IN) :: Ta    ! air temp
    REAL(r_2),                 INTENT(IN) :: tfin    ! time
    TYPE(vars_snow), DIMENSION(1:mp),           INTENT(INOUT) :: vsnow
    REAL(r_2),       DIMENSION(1:mp) :: tmp1d1, tmp1d2

    IF (qprec_snow(kk).GT.0) THEN
       ! total energy of augmented snow pack
       tmp1d1(kk) = rhow*(vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*(csice*vsnow(kk)%tsn(1) - lambdaf) + &
            rhow*(qprec_snow(kk)*tfin)* &
            (csice*MIN(Ta(kk),zero) - lambdaf)
       ! total water content of augmented snow pack
       vsnow(kk)%hsnow(1) = vsnow(kk)%hsnow(1) + qprec_snow(kk)*tfin
       vsnow(kk)%wcol = vsnow(kk)%wcol+qprec_snow(kk)*tfin

       !  write(*,*) 'augment_snow', tfin,kk, qprec_snow(kk), vsnow(kk)%hsnow(1)
       ! temperature and liquid moisture content of augmented snow pack
       IF (tmp1d1(kk).LT. -vsnow(kk)%hsnow(1)*rhow*lambdaf) THEN
          vsnow(kk)%hliq(1)= zero
          vsnow(kk)%tsn(1)= (tmp1d1(kk)/(rhow*vsnow(kk)%hsnow(1))+lambdaf)/csice
       ELSE
          vsnow(kk)%tsn(1)= zero
          vsnow(kk)%hliq(1)= vsnow(kk)%hsnow(1)+ tmp1d1(kk)/(rhow*lambdaf)
       ENDIF

       ! density of augmented snow pack
       ! snowfall density (tmp1d1), LaChapelle 1969
       IF (Ta(kk) > 2.0_r_2) THEN
          tmp1d2(kk) = 189.0_r_2
       ELSEIF ((Ta(kk) > -15.0_r_2) .AND. (Ta(kk) <= 2.0_r_2)) THEN
          tmp1d2(kk) = 50.0_r_2 + 1.7_r_2*(Ta(kk)+15.0_r_2)**1.5_r_2
       ELSE
          tmp1d2(kk) = 50.0_r_2
       ENDIF

       vsnow(kk)%dens(1) = (vsnow(kk)%dens(1)*(vsnow(kk)%hsnow(1)-qprec_snow(kk)*tfin) &
            + tmp1d2(kk)*qprec_snow(kk)*tfin)/vsnow(kk)%hsnow(1)

       vsnow(kk)%depth(1) = vsnow(kk)%hsnow(1)/(vsnow(kk)%dens(1)/rhow)

       vsnow(kk)%Qprec = qprec_snow(kk)*tfin
       vsnow(kk)%Qadv_snow=rhow*(qprec_snow(kk))* &
            (csice*(MIN(Ta(kk),zero))-lambdaf)*tfin
       qprec_snow(kk)=0
       IF (vsnow(kk)%nsnow==0) THEN
          vsnow(kk)%nsnow=1
       ENDIF
    ENDIF

  END SUBROUTINE snow_augment

  !=============================================================================

  SUBROUTINE snow_adjust(irec, mp, n, kk, ns, h0, hice, thetai, dx, vsnow, var, par, S, Tsoil, &
       Jcol_latent_S, Jcol_latent_T, Jcol_sensible, deltaJ_sensible_S, qmelt, qtransfer, j0snow)

    INTEGER(i_d),                               INTENT(IN)    :: irec  ! # of grid-cells
    INTEGER(i_d),                               INTENT(IN)    :: mp    ! # of grid-cells
    INTEGER(i_d),                               INTENT(IN)    :: n     ! # of soil layers
    INTEGER(i_d),                               INTENT(IN)    :: kk    ! grid-cell reference
    INTEGER(i_d),    DIMENSION(mp),             INTENT(INOUT) :: ns    ! pond (0), np ond (1)
    REAL(r_2),       DIMENSION(1:n),         INTENT(IN)    :: dx    ! soil depths
    REAL(r_2),       DIMENSION(1:n),         INTENT(INOUT) :: Tsoil ! soil temperatures soil
    REAL(r_2),       DIMENSION(1:n),         INTENT(INOUT) :: S     ! soil temperatures soil
    REAL(r_2),       DIMENSION(mp),             INTENT(INOUT) :: h0, hice, j0snow ! pond
    REAL(r_2),       DIMENSION(1:n),       INTENT(INOUT) :: thetai
    REAL(r_2),       DIMENSION(1:mp),           INTENT(INOUT) :: Jcol_latent_S, Jcol_latent_T, Jcol_sensible
    REAL(r_2),       DIMENSION(1:n),       INTENT(INOUT) :: deltaJ_sensible_S
    REAL(r_2),       DIMENSION(nsnow_max), INTENT(INOUT) :: qmelt
    REAL(r_2),       DIMENSION(1:mp), INTENT(OUT) :: qtransfer
    TYPE(vars),      DIMENSION(1:n),       INTENT(INOUT) :: var
    TYPE(params),    DIMENSION(1:n),       INTENT(IN) :: par
    TYPE(vars_snow), DIMENSION(1:mp),           INTENT(INOUT) :: vsnow
    REAL(r_2),       DIMENSION(1:mp) :: tmp1d1, tmp1d2, tmp1d3,  tmp1d4
    REAL(r_2),       DIMENSION(1:mp) :: h0_tmp, hice_tmp
    REAL(r_2) :: theta, tmp1, tmp2 ,Tfreezing(1:mp), Jsoil, theta_tmp
    INTEGER(i_d) :: i,j ! counters
    LOGICAL :: melt_transfer=.FALSE.

    tmp1d1(kk) = h0(kk)+dx(1)*(var(1)%thetai+var(1)%thetal) ! total moisture content of top soil layer + pond
    ! tmp1d1(kk) = hice(kk)+dx(1)*(var(1)%thetai) ! total ice  moisture content of top soil layer + pond
    vsnow(kk)%melt = zero
    qmelt = zero
    qtransfer = zero
    ! no dedicated snow pack if solid part of cumulated snow is less than min thresshold
    ! also, don't initialise dedicated snowpack if this would deplete water in top soil layer to less than 1 mm
    IF (((vsnow(kk)%wcol-SUM(vsnow(kk)%hliq(:)))<snmin*(vsnow(kk)%dens(1)/rhow)).OR. &
         ((vsnow(kk)%nsnow==0).AND.(tmp1d1(kk)-vsnow(kk)%wcol)<0.001_r_2)) THEN
       vsnow(kk)%nsnow = 0
       theta         = S(1)*(par(1)%thre) + (par(1)%the - par(1)%thre)
       IF (vsnow(kk)%hsnow(1)>zero)  THEN ! termination of dedicated snow layer
          ! total energy in old snow layer
          tmp1d1(kk) = (vsnow(kk)%tsn(1))*rhow*vsnow(kk)%hliq(1)*cswat + &
               (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*((vsnow(kk)%tsn(1))*csice-lambdaf)
          vsnow(kk)%Qadv_transfer = vsnow(kk)%Qadv_transfer - tmp1d1(kk) ! transfer of energy from soil to snow
          vsnow(kk)%Qtransfer = vsnow(kk)%Qtransfer -vsnow(kk)%hsnow(1) ! transfer of water from soil to snow
          qtransfer(kk) = -vsnow(kk)%hsnow(1) ! transfer of water from soil to snow
          vsnow(kk)%deltaJlatent(1) = vsnow(kk)%deltaJlatent(1) +lambdaf*(vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow
          vsnow(kk)%deltaJsensible(1) = vsnow(kk)%deltaJsensible(1) -(vsnow(kk)%tsn(1))*rhow*vsnow(kk)%hliq(1)*cswat- &
               (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*(vsnow(kk)%tsn(1))*csice

          ! total energy in old top soil layer
          tmp1d2(kk) = JSoilLayer(Tsoil(1), &
               dx(1), theta,par(1)%css, par(1)%rho, &
               h0(kk), par(1)%thre, par(1)%the, &
               par(1)%he, one/(par(1)%lambc*freezefac))

          tmp1d3(kk) = Tsoil(1)
          !calculate new thetal, consistent with total energy and new pond height
          h0_tmp(kk) = h0(kk)
          IF (h0(kk)>zero) THEN
             h0(kk) = h0(kk) + vsnow(kk)%hsnow(1)
          ELSEIF ((theta+vsnow(kk)%hsnow(1)/dx(1))<par(1)%the) THEN
             h0(kk)=zero
             theta = theta+vsnow(kk)%hsnow(1)/dx(1)
             S(1) = (theta - (par(1)%the - par(1)%thre) )/(par(1)%thre)
          ELSEIF ((theta+vsnow(kk)%hsnow(1)/dx(1))>par(1)%the) THEN
             h0(kk) = ((theta+vsnow(kk)%hsnow(1)/dx(1))-par(1)%the)*dx(1)
             theta = par(1)%the
             S(1) = one
             var(1)%isat = 1
             ns(kk) = 0
          ENDIF

          Tfreezing(kk) = Tfrz(S(1), par(1)%he, one/(par(1)%lambc*freezefac))

          ! check if total energy in old snow layer and top soil (+pond) is enough for complete melting
          tmp1d3(kk) = var(1)%thetai*dx(1)*rhow*lambdaf + &
               var(1)%thetai*h0_tmp(kk)/par(1)%thre*rhow*lambdaf
          tmp1d4(kk) = (Tfreezing(kk))*(rhow*cswat*(theta*dx(1)+h0(kk))+par(1)%rho*par(1)%css*dx(1))

          IF ((tmp1d1(kk)+tmp1d2(kk)-tmp1d4(kk))>zero) THEN !  complete melting

             IF (Tsoil(1).GT.var(1)%Tfrz) THEN
                Jcol_latent_T(kk) =     Jcol_latent_T(kk) + tmp1d3(kk)
                deltaJ_sensible_S(1) = zero
                Tsoil(1) = Tsoil(1) + tmp1d1(kk)/(rhow*cswat*(theta*dx(1)+h0(kk))+par(1)%rho*par(1)%css*dx(1))
             ELSE

                Jcol_latent_T(kk) =     Jcol_latent_T(kk) + tmp1d3(kk)
                deltaJ_sensible_S(1) = zero
                Tsoil(1) = var(1)%Tfrz + (tmp1d1(kk)+tmp1d2(kk) -tmp1d4(kk))/ &
                     (rhow*cswat*(theta*dx(1)+h0(kk))+par(1)%rho*par(1)%css*dx(1))
             ENDIF
             var(1)%iice = 0
             var(1)%thetai = zero
             var(1)%thetal = theta
             hice(kk) = zero
             vsnow(kk)%hsnow(1) = zero
             vsnow(kk)%hliq(1)= zero
          ELSE  ! soil remains frozen

             Jsoil = tmp1d1(kk)+tmp1d2(kk)! total energy in  soil layer
             !check there is a zero
             tmp1 = GTfrozen(Tsoil(1)-50._r_2, Jsoil, dx(1), theta,par(1)%css, par(1)%rho, &
                  h0(kk), par(1)%thre, par(1)%the, par(1)%he, one/(par(1)%lambc*freezefac))

             tmp2 = GTFrozen(Tfreezing(kk), Jsoil, dx(1), theta,par(1)%css, par(1)%rho, &
                  h0(kk), par(1)%thre, par(1)%the, par(1)%he, one/(par(1)%lambc*freezefac))

             ! there is a zero in between
             IF ((tmp1*tmp2) < zero) THEN
                tmp1d3(kk) = rtbis_Tfrozen(tmp1d2(kk), dx(1), theta,par(1)%css, par(1)%rho, &
                     h0(kk), par(1)%thre, par(1)%the, par(1)%he, one/(par(1)%lambc*freezefac), &
                     Tsoil(1)-50._r_2, Tfreezing(kk), 0.0001_r_2)

                tmp1d4(kk) = thetalmax(tmp1d3(kk), S(1), par(1)%he, one/(par(1)%lambc*freezefac), &
                     par(1)%thre, par(1)%the) ! liquid content at new Tsoil
             ELSE
                WRITE(logn,*) "Found no solution for Tfrozen 2. ", kk, i
                WRITE(logn,*) "Assume soil is totally frozen"
                tmp1d3(kk) = (tmp1d2(kk) + rhow*lambdaf*(theta*dx(1) +  h0(kk))) / &
                     (dx(1)*par(1)%css*par(1)%rho + rhow*csice*(theta*dx(1) + h0(kk)))
                tmp1d4(kk) = 0.0_r_2
                WRITE(logn,*) "frozen soil temperature: ", tmp1d3(kk)
             ENDIF

             hice_tmp(kk) = hice(kk)
             hice(kk) = h0(kk)*var(1)%thetai/par(1)%thre
             vsnow(kk)%hsnow(1) = zero
             vsnow(kk)%hliq(1) = zero
             var(1)%thetal = MAX(tmp1d4(kk),zero)
             var(1)%thetai = theta - tmp1d4(kk)

             ! correct total energy stored in pond + soil
             Jcol_latent_S(kk) = Jcol_latent_S(kk)  - rhow*lambdaf*((hice(kk)-hice_tmp(kk)) + &
                  dx(1)*(var(1)%thetai-thetai(1)))


             Jcol_sensible(kk) = Jcol_sensible(kk) + &
                  JSoilLayer(tmp1d3(kk), &
                  dx(1), theta,par(1)%css, par(1)%rho, &
                  h0(kk), par(1)%thre, par(1)%the, &
                  par(1)%he, one/(par(1)%lambc*freezefac)) - &
                  tmp1d2(kk) - &
                  (-rhow*lambdaf*((hice(kk)-hice_tmp(kk)) + &
                  dx(1)*(var(1)%thetai-thetai(1))))
             Tsoil(1) = tmp1d3(kk)

             IF (var(1)%thetai>zero) THEN
                var(1)%iice = 1
             ENDIF
          ENDIF

          vsnow(kk)%Jsensible(1) = (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*csice*(vsnow(kk)%Tsn(1))
          vsnow(kk)%Jlatent(1) = (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*(-lambdaf)
          vsnow(kk)%J = SUM(vsnow(kk)%Jsensible(1:vsnow(kk)%nsnow)+vsnow(kk)%Jlatent(1:vsnow(kk)%nsnow))
          vsnow(kk)%deltaJ = vsnow(kk)%J - J0snow(kk)
          vsnow(kk)%FluxDivergence = vsnow(kk)%Qadv_rain + vsnow(kk)%Qadv_snow + vsnow(kk)%Qadv_vap + &
               vsnow(kk)%Qadv_melt + vsnow(kk)%Qcond_net  +  vsnow(kk)%Qadv_transfer

          vsnow(kk)%hsnow(1) = zero
          vsnow(kk)%hliq(1) = zero
          vsnow(kk)%depth(1) = zero


       ENDIF ! termination of dedicated snow layer
    ELSE

       IF  (vsnow(kk)%nsnow_last==0) THEN ! snow layer initialisation (transfer pond/soil water to dedicated snow layer)
          vsnow(kk)%nsnow = 1
          vsnow(kk)%hsnow(1) = vsnow(kk)%wcol
          vsnow(kk)%depth(1) = vsnow(kk)%hsnow(1)*rhow/vsnow(kk)%dens(1)

          IF (h0(kk)>vsnow(kk)%wcol) THEN ! extract new snow layer from pond
             ! total energy in new snow layer
             tmp1d1(kk) = (Tsoil(1))*rhow*vsnow(kk)%hsnow(1)*(cswat*(h0(kk)-hice(kk))/h0(kk) + &
                  csice*hice(kk)/h0(kk)) - rhow*lambdaf*vsnow(kk)%hsnow(1)*hice(kk)/h0(kk)
             ! correct total energy stored in pond + soil
             Jcol_latent_S(kk) = Jcol_latent_S(kk) + rhow*lambdaf*vsnow(kk)%hsnow(1)*hice(kk)/h0(kk)
             Jcol_sensible(kk) = Jcol_sensible(kk) - (Tsoil(1))*rhow*vsnow(kk)%hsnow(1) &
                  *(cswat*(h0(kk)-hice(kk))/h0(kk) +  csice*hice(kk)/h0(kk))

             ! total energy in snowpack totally frozen at 0degC
             tmp1d2(kk) = rhow*vsnow(kk)%hsnow(1)*(csice*zero - lambdaf)
             IF (tmp1d1(kk)<=tmp1d2(kk)) THEN
                ! alll snow water frozen
                vsnow(kk)%hliq(1)=zero
                vsnow(kk)%tsn(1) = (tmp1d1(kk)+rhow*lambdaf*vsnow(kk)%hsnow(1))/(csice*rhow*vsnow(kk)%hsnow(1))
             ELSE
                ! liquid snow water
                vsnow(kk)%hliq(1)=(tmp1d1(kk)-vsnow(kk)%hsnow(1)*rhow*(zero*csice-lambdaf))/ &
                     (rhow*(zero*cswat-zero*csice+lambdaf))
                vsnow(kk)%tsn(1) = zero
             ENDIF

             h0(kk) = h0(kk) - vsnow(kk)%wcol
             hice(kk) = h0(kk)*var(1)%thetai/par(1)%thre

          ELSE  ! extract new snow layer from soil ice + pond
             ! total energy in new snow layer (component extracted from soil ice)
             tmp1d1(kk) = (Tsoil(1))*rhow*(vsnow(kk)%hsnow(1)-h0(kk))*csice - &
                  rhow*lambdaf*(vsnow(kk)%hsnow(1)-h0(kk))
             h0_tmp(kk) = h0(kk)
             hice_tmp(kk) = hice(kk)
             IF (h0(kk)>zero) THEN
                tmp1d1(kk) = tmp1d1(kk) + (Tsoil(1))*rhow*(cswat*(h0(kk)-hice(kk)) + &
                     csice*hice(kk)) - rhow*lambdaf*hice(kk)
             ENDIF
             ! total energy in snowpack totally frozen at 0degC
             tmp1d2(kk) = rhow*vsnow(kk)%hsnow(1)*(csice*zero - lambdaf)
             IF (tmp1d1(kk)<=tmp1d2(kk)) THEN
                ! all snow water frozen
                vsnow(kk)%hliq(1)=zero
                vsnow(kk)%tsn(1) = (tmp1d1(kk)+rhow*lambdaf*vsnow(kk)%hsnow(1))/(csice*rhow*vsnow(kk)%hsnow(1))
             ELSE
                ! liquid snow water
                vsnow(kk)%hliq(1)=(tmp1d1(kk)-vsnow(kk)%hsnow(1)*rhow*(zero*csice-lambdaf))/ &
                     (rhow*(zero*cswat-zero*csice+lambdaf))
                vsnow(kk)%tsn(1) = zero
             ENDIF

             ! correct soil moisture
             S(1) = S(1) - (vsnow(kk)%hsnow(1)-h0(kk))/dx(1)/par(1)%thre
             IF (S(1).LT.one) THEN
                var(1)%isat= 0
             ENDIF
             Tfreezing(kk) = Tfrz(S(1), par(1)%he, one/(par(1)%lambc*freezefac))
             IF (S(1)<zero) THEN
                WRITE(*,*) "error: over-extraction of soil water during snow pack init"
                WRITE(*,*) "S(1), snow-col, deltaS"
                WRITE(*,*) S(1) , vsnow(kk)%hsnow(1), - (vsnow(kk)%hsnow(1)-h0(kk))/dx(1)/par(1)%thre
             ENDIF
             h0(kk) = zero
             hice(kk) = zero
             ! correct total energy stored in pond + soil
             ! correct soil temperature
             theta         = S(1)*(par(1)%thre) + (par(1)%the - par(1)%thre)
             ! total energy added to top soil layer
             tmp1d1(kk) = - tmp1d1(kk)
             ! total energy in old top soil layer
             tmp1d2(kk) = var(1)%csoil*dx(1)*(Tsoil(1)) -lambdaf*dx(1)*var(1)%thetai + &
                  (h0_tmp(kk)-hice_tmp(kk))*cswat*rhow*(Tsoil(1)) + &
                  hice_tmp(kk)*rhow*(csice*(Tsoil(1))-lambdaf)
             ! calculate energy in new top soil layer
             IF (var(1)%iice==0) THEN
                var(1)%csoil = theta*rhow*cswat+par(1)%rho*par(1)%css
                tmp1d3(kk) = (tmp1d1(kk)+tmp1d2(kk))/((theta*rhow*cswat+par(1)%rho*par(1)%css)*dx(1)+ &
                     h0(kk)*rhow*cswat)
                Jcol_sensible(kk) = Jcol_sensible(kk) - &
                     var(1)%csoil*dx(1)*(Tsoil(1)) - &
                     (h0_tmp(kk))*cswat*rhow*(Tsoil(1)) + &
                     (theta*rhow*cswat+par(1)%rho*par(1)%css)*dx(1)*(tmp1d3(kk)) + &
                     (h0_tmp(kk))*cswat*rhow*(tmp1d3(kk))
                var(1)%csoil = theta*rhow*cswat+par(1)%rho*par(1)%css
                Tsoil(1) = tmp1d3(kk)
             ELSE
                ! check if total energy in melt water and top soil (+pond) is enough for complete melting
                tmp1d3(kk) = var(1)%thetai*dx(1)*rhow*lambdaf + &
                     var(1)%thetai*h0_tmp(kk)/par(1)%thre*rhow*lambdaf

                tmp1d4(kk) = (Tfreezing(kk))*(rhow*cswat*(theta*dx(1)+h0(kk))+par(1)%rho*par(1)%css*dx(1))
                IF ((tmp1d1(kk)+tmp1d2(kk)-tmp1d4(kk))>zero) THEN
                   !  complete melting
                   Jcol_latent_T(kk)    = Jcol_latent_T(kk) + tmp1d3(kk)
                   deltaJ_sensible_S(1) = zero
                   Tsoil(1) = var(1)%Tfrz + (tmp1d1(kk)+tmp1d2(kk)-tmp1d4(kk)) / &
                        (rhow*cswat*(theta*dx(1)+h0(kk))+par(1)%rho*par(1)%css*dx(1))
                   var(1)%iice   = 0
                   var(1)%thetai = zero
                   thetai(1)     = var(1)%thetai
                   var(1)%thetal = theta
                ELSE

                   Jsoil = tmp1d1(kk)+tmp1d2(kk)! total energy in  soil layer
                   !check there is a zero
                   tmp1 = GTfrozen(Tsoil(1)-50._r_2, Jsoil, dx(1), theta,par(1)%css, par(1)%rho, &
                        h0(kk), par(1)%thre, par(1)%the, par(1)%he, one/(par(1)%lambc*freezefac))

                   tmp2 = GTFrozen(Tfreezing(kk), Jsoil, dx(1), theta,par(1)%css, par(1)%rho, &
                        h0(kk), par(1)%thre, par(1)%the, par(1)%he, one/(par(1)%lambc*freezefac))

                   ! there is a zero in between
                   IF ((tmp1*tmp2) < zero) THEN
                      tmp1d3(kk) = rtbis_Tfrozen(tmp1d2(kk), dx(1), theta,par(1)%css, par(1)%rho, &
                           h0(kk), par(1)%thre, par(1)%the, par(1)%he, one/(par(1)%lambc*freezefac), &
                           Tsoil(1)-50._r_2, Tfreezing(kk), 0.0001_r_2)

                      tmp1d4(kk) = thetalmax(tmp1d3(kk), S(1), par(1)%he, one/(par(1)%lambc*freezefac), &
                           par(1)%thre, par(1)%the) ! liquid content at new Tsoil
                   ELSE
                      WRITE(logn,*) "Found no solution for Tfrozen 3. ", kk, i
                      WRITE(logn,*) "Assume soil is totally frozen"
                      tmp1d3(kk) = (Jsoil + rhow*lambdaf*(theta*dx(1) +  h0(kk))) / &
                           (dx(1)*par(1)%css*par(1)%rho + rhow*csice*(theta*dx(1) + h0(kk)))
                      tmp1d4(kk) = 0.0_r_2
                      WRITE(logn,*) "frozen soil temperature: ", tmp1d3(kk)
                   ENDIF

                   var(1)%thetal = MAX(tmp1d4(kk), zero)
                   var(1)%thetai = theta - tmp1d4(kk)
                   ! correct total energy stored in pond + soil
                   Jcol_latent_S(kk) = Jcol_latent_S(kk)- rhow*lambdaf*((hice(kk)-hice_tmp(kk)) + &
                        dx(1)*(var(1)%thetai-thetai(1)))

                   Jcol_sensible(kk) = Jcol_sensible(kk) - &
                        var(1)%csoil*dx(1)*(Tsoil(1)) - &
                        (h0_tmp(kk)-hice_tmp(kk))*cswat*rhow*(Tsoil(1)) - &
                        hice_tmp(kk)*rhow*(csice*(Tsoil(1))) + &
                        dx(1)*(tmp1d3(kk))*par(1)%rho*par(1)%css + &
                        (h0(kk)-hice(kk)+var(1)%thetal*dx(1))*cswat*rhow*(tmp1d3(kk)) + &
                        (hice_tmp(kk)+var(1)%thetai)*rhow*(csice*(tmp1d3(kk)))

                   thetai(1) = var(1)%thetai
                   Tsoil(1) = tmp1d3(kk)

                ENDIF ! incomplete melting

             ENDIF ! iice=1

          ENDIF ! extract new snow layer from soil ice

          vsnow(kk)%deltaJsensible(1) = vsnow(kk)%deltaJsensible(1) + &
               (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*csice*(vsnow(kk)%tsn(1)) + &
               vsnow(kk)%hliq(1)*rhow*cswat*(vsnow(kk)%tsn(1))

          vsnow(kk)%deltaJlatent(1) = vsnow(kk)%deltaJlatent(1) + &
               (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*(-lambdaf)

          vsnow(kk)%Qadv_transfer = vsnow(kk)%Qadv_transfer + & ! soil to snow
               (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*csice*(vsnow(kk)%tsn(1)) + &
               vsnow(kk)%hliq(1)*rhow*cswat*(vsnow(kk)%tsn(1)) + &
               (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*(-lambdaf)

          vsnow(kk)%Qtransfer = vsnow(kk)%Qtransfer + vsnow(kk)%hsnow(1)
          qtransfer(kk) = vsnow(kk)%hsnow(1) ! transfer of water from snow to soil
          vsnow(kk)%Jsensible(1) = (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*csice*(vsnow(kk)%Tsn(1))
          vsnow(kk)%Jlatent(1) = (vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*rhow*(-lambdaf)
          vsnow(kk)%J = SUM(vsnow(kk)%Jsensible(1:vsnow(kk)%nsnow)+vsnow(kk)%Jlatent(1:vsnow(kk)%nsnow))
          vsnow(kk)%deltaJ = vsnow(kk)%J - J0snow(kk)
          vsnow(kk)%FluxDivergence = vsnow(kk)%Qadv_rain + vsnow(kk)%Qadv_snow + vsnow(kk)%Qadv_vap + &
               vsnow(kk)%Qadv_melt + vsnow(kk)%Qcond_net  +  vsnow(kk)%Qadv_transfer

       ENDIF        ! snow layer initialisation

       DO i=1, vsnow(kk)%nsnow
          vsnow(kk)%Jsensible(i) = (vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow*csice*(vsnow(kk)%Tsn(i))
          vsnow(kk)%Jlatent(i) = (vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow*(-lambdaf)
       ENDDO
       vsnow(kk)%J = SUM(vsnow(kk)%Jsensible(1:vsnow(kk)%nsnow)+vsnow(kk)%Jlatent(1:vsnow(kk)%nsnow))
       vsnow(kk)%deltaJ = vsnow(kk)%J - J0snow(kk)
       vsnow(kk)%FluxDivergence = vsnow(kk)%Qadv_rain + vsnow(kk)%Qadv_snow + vsnow(kk)%Qadv_vap + &
            vsnow(kk)%Qadv_melt + vsnow(kk)%Qcond_net  +  vsnow(kk)%Qadv_transfer

       ! get snow melt from top layer
       IF ((vsnow(kk)%hliq(1) - vsnow(kk)%hsnow(1)*vsnow(kk)%fsnowliq_max(1))>zero) THEN ! remove melt water
          qmelt(1) = MAX((vsnow(kk)%hliq(1) - vsnow(kk)%hsnow(1)*vsnow(kk)%fsnowliq_max(1)),zero)
          qmelt(1) = MIN(qmelt(1), MAX(0.9_r_2*(vsnow(kk)%hsnow(1)-snmin*(vsnow(kk)%dens(1)/rhow)),zero))
          vsnow(kk)%melt(1) = vsnow(kk)%melt(1) + qmelt(1)
          vsnow(kk)%hliq(1) = vsnow(kk)%hliq(1) - qmelt(1)
          vsnow(kk)%hsnow(1) = vsnow(kk)%hsnow(1) - qmelt(1)
          ! adjust depth and density for snow melt removal
          !tmp1d3(kk) = vsnow(kk)%dens(1)*(one-vsnow(kk)%hliq(1)/vsnow(kk)%hsnow(1))
          !vsnow(kk)%depth(1) = vsnow(kk)%depth(1) - qmelt(1)*rhow/tmp1d3(kk)
          ! vsnow(kk)%dens(1) = vsnow(kk)%hsnow(1)*rhow/vsnow(kk)%depth(1)
          !vsnow(kk)%dens(1) = max(vsnow(kk)%dens(1) - rhow*qmelt(1)/vsnow(kk)%depth(1), 50.0_r_2)
          DO i=1, vsnow(kk)%nsnow
             vsnow(kk)%Jsensible(i) = (vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow*csice*(vsnow(kk)%Tsn(i))
             vsnow(kk)%Jlatent(i) = (vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow*(-lambdaf)
          ENDDO
       ENDIF ! end remove snow melt from top layer

       ! add snow melt from above to layer below
       IF (vsnow(kk)%nsnow>1) THEN

          ! simply add melt water from above if melt water already exists and total new amount doesn't exceed capacity
          IF ((vsnow(kk)%hliq(vsnow(kk)%nsnow).GT.zero).AND. &
               (vsnow(kk)%hliq(vsnow(kk)%nsnow) + qmelt(1)).LE.(vsnow(kk)%hsnow(vsnow(kk)%nsnow) + &
               qmelt(1))*vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow)) THEN

             vsnow(kk)%hliq(vsnow(kk)%nsnow) = vsnow(kk)%hliq(vsnow(kk)%nsnow) + qmelt(1)
             vsnow(kk)%hsnow(vsnow(kk)%nsnow) = vsnow(kk)%hsnow(vsnow(kk)%nsnow) + qmelt(1)
             qmelt(vsnow(kk)%nsnow) = zero
             ! or convert excess to melt water
          ELSEIF ((vsnow(kk)%hliq(vsnow(kk)%nsnow).GT.zero).AND. &
               (vsnow(kk)%hliq(vsnow(kk)%nsnow) + qmelt(1)).GT.(vsnow(kk)%hsnow(vsnow(kk)%nsnow) + &
               qmelt(1))*vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow)) THEN

             tmp1d1(kk) = vsnow(kk)%hliq(vsnow(kk)%nsnow)
             tmp1d2(kk) = vsnow(kk)%hsnow(vsnow(kk)%nsnow)


             qmelt(vsnow(kk)%nsnow) =  tmp1d1(kk) + vsnow(kk)%melt(1) - &
                  vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow)*(tmp1d2(kk) - tmp1d1(kk))/ &
                  (1._r_2-vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow))

             vsnow(kk)%hliq(vsnow(kk)%nsnow) = vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow)*(tmp1d2(kk)  - tmp1d1(kk) )/ &
                  (1._r_2-vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow))


             vsnow(kk)%hsnow(vsnow(kk)%nsnow) = (tmp1d2(kk) - tmp1d1(kk)) + vsnow(kk)%hliq(vsnow(kk)%nsnow)

             ! or add melt water to completely frozen snowpack below
          ELSE
             tmp1d1(kk) = (vsnow(kk)%hsnow(vsnow(kk)%nsnow)*(vsnow(kk)%tsn(vsnow(kk)%nsnow)*csice-lambdaf) &
                  /(vsnow(kk)%hsnow(vsnow(kk)%nsnow) + qmelt(1)) + lambdaf)/csice

             IF (tmp1d1(kk).LT.zero) THEN ! snow pack remains completely frozen
                vsnow(kk)%tsn(vsnow(kk)%nsnow) = tmp1d1(kk)
                vsnow(kk)%hliq(vsnow(kk)%nsnow) = zero
                vsnow(kk)%hsnow(vsnow(kk)%nsnow) = vsnow(kk)%hsnow(vsnow(kk)%nsnow) + qmelt(1)
                qmelt(vsnow(kk)%nsnow) = zero

             ELSE ! snowpack partially melted
                vsnow(kk)%hliq(vsnow(kk)%nsnow) = vsnow(kk)%hsnow(vsnow(kk)%nsnow)/ &
                     lambdaf*(csice*vsnow(kk)%tsn(vsnow(kk)%nsnow)-lambdaf) + &
                     (vsnow(kk)%hsnow(vsnow(kk)%nsnow) + qmelt(1))
                vsnow(kk)%tsn(vsnow(kk)%nsnow) = zero
                vsnow(kk)%hsnow(vsnow(kk)%nsnow) = vsnow(kk)%hsnow(vsnow(kk)%nsnow) + qmelt(1)
                qmelt(vsnow(kk)%nsnow) = zero


                IF (vsnow(kk)%hliq(vsnow(kk)%nsnow).GT. &
                     vsnow(kk)%hsnow(vsnow(kk)%nsnow)*vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow)) THEN

                   tmp1d1(kk) = vsnow(kk)%hliq(vsnow(kk)%nsnow)
                   tmp1d2(kk) = vsnow(kk)%hsnow(vsnow(kk)%nsnow)

                   qmelt(vsnow(kk)%nsnow) =  vsnow(kk)%hliq(vsnow(kk)%nsnow) - &
                        vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow)*(vsnow(kk)%hsnow(vsnow(kk)%nsnow) - &
                        vsnow(kk)%hliq(vsnow(kk)%nsnow))/(1._r_2-vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow))

                   vsnow(kk)%hliq(vsnow(kk)%nsnow) = vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow)*(vsnow(kk)%hsnow(vsnow(kk)%nsnow) &
                        - vsnow(kk)%hliq(vsnow(kk)%nsnow))/ &
                        (1._r_2-vsnow(kk)%fsnowliq_max(vsnow(kk)%nsnow))

                   vsnow(kk)%hsnow(vsnow(kk)%nsnow) = vsnow(kk)%hsnow(vsnow(kk)%nsnow) -  &
                        tmp1d1(kk) + vsnow(kk)%hliq(vsnow(kk)%nsnow)
                   tmp1d3(kk) = vsnow(kk)%dens(vsnow(kk)%nsnow)*(one-vsnow(kk)%hliq(vsnow(kk)%nsnow)) &
                        /vsnow(kk)%hsnow(vsnow(kk)%nsnow)


                ENDIF ! (vsnow(kk)%hliq(2).gt.vsnow(kk)%hsnow(2)*vsnow(kk)%fsnowliq_max(2))

             ENDIF ! snowpack partially melted
             vsnow(kk)%melt(vsnow(kk)%nsnow) = vsnow(kk)%melt(vsnow(kk)%nsnow) + qmelt(vsnow(kk)%nsnow)
          ENDIF ! (vsnow(kk)%hliq(2).gt.zero).and. &
          !(vsnow(kk)%hliq(2) + qmelt(1)).le.(vsnow(kk)%hsnow(2) + qmelt(1))*vsnow(kk)%fsnowliq_max(2))

       ENDIF ! if (vsnow(kk)%nsnow>1)

       theta = S(1)*(par(1)%thre) + (par(1)%the - par(1)%thre)
       ! move snow melt from bottom snow layer to top soil + pond
       IF (qmelt(vsnow(kk)%nsnow)>zero) THEN
          vsnow(kk)%Qmelt = vsnow(kk)%Qmelt + qmelt(vsnow(kk)%nsnow)
          IF (melt_transfer) THEN
             h0_tmp(kk) = h0(kk)
             hice_tmp(kk) = hice(kk)

             ! total energy in melt-water is zero

             ! total energy in old top soil layer
             tmp1d2(kk) = JSoilLayer(Tsoil(1), &
                  dx(1), theta,par(1)%css, par(1)%rho, &
                  h0_tmp(kk), par(1)%thre, par(1)%the, &
                  par(1)%he, one/(par(1)%lambc*freezefac))

             !calculate new thetal, consistent with total energy and new pond height
             theta = S(1)*(par(1)%thre) + (par(1)%the - par(1)%thre)
             theta_tmp = theta

             IF (h0(kk)>zero) THEN
                h0(kk) = h0(kk) +  qmelt(vsnow(kk)%nsnow)
             ELSEIF ((theta+qmelt(vsnow(kk)%nsnow)/dx(1))<par(1)%the) THEN
                h0(kk)=zero
                theta = theta+qmelt(vsnow(kk)%nsnow)/dx(1)
                S(1) = (theta - (par(1)%the - par(1)%thre) )/(par(1)%thre)
                IF (S(1).LT.one) THEN
                   var(1)%isat= 0
                ENDIF
             ELSEIF ((theta+qmelt(vsnow(kk)%nsnow)/dx(1))>par(1)%the) THEN
                h0(kk) = ((theta+qmelt(vsnow(kk)%nsnow)/dx(1))-par(1)%the)*dx(1)

                S(1) = one
                var(1)%isat = 1
                ns(kk) = 0
                theta = par(1)%the
             ENDIF
             Tfreezing(kk) = Tfrz(S(1), par(1)%he, one/(par(1)%lambc*freezefac))
             ! calculate energy in new top soil layer
             IF (var(1)%iice==0) THEN
                var(1)%csoil = theta*rhow*cswat+par(1)%rho*par(1)%css
                tmp1d3(kk) = (tmp1d2(kk))/((theta*rhow*cswat+par(1)%rho*par(1)%css)*dx(1)+ &
                     h0(kk)*rhow*cswat)
                Jcol_sensible(kk) = Jcol_sensible(kk) - &
                     var(1)%csoil*dx(1)*(Tsoil(1)) - &
                     (h0_tmp(kk))*cswat*rhow*(Tsoil(1)) + &
                     (theta*rhow*cswat+par(1)%rho*par(1)%css)*dx(1)*(tmp1d3(kk)) + &
                     (h0_tmp(kk))*cswat*rhow*(tmp1d3(kk))

                var(1)%csoil = theta*rhow*cswat+par(1)%rho*par(1)%css
                Tsoil(1) = tmp1d3(kk)

             ELSE
                ! check if total energy in melt water and top soil (+pond) is enough for complete melting
                tmp1d3(kk) = var(1)%thetai*dx(1)*rhow*lambdaf + &
                     var(1)%thetai*h0_tmp(kk)/par(1)%thre*rhow*lambdaf
                tmp1d4(kk) = (Tfreezing(kk))*(rhow*cswat*(theta*dx(1)+h0(kk))+par(1)%rho*par(1)%css*dx(1))
                IF ((tmp1d2(kk)-tmp1d4(kk))>zero) THEN
                   !  complete melting
                   Jcol_latent_T(kk) = Jcol_latent_T(kk) + tmp1d3(kk)
                   deltaJ_sensible_S(1) = zero
                   ! Tsoil(1) = var(1)%Tfrz + (tmp1d1(kk)+tmp1d2(kk) -tmp1d4(kk))/ &
                   !      (rhow*cswat*(theta*dx(1)+h0(kk))+par(1)%rho*par(1)%css*dx(1))

                   Tsoil(1) = var(1)%Tfrz + (tmp1d2(kk) - tmp1d4(kk)) / &
                        (rhow*cswat*(theta*dx(1)+h0(kk))+par(1)%rho*par(1)%css*dx(1))

                   var(1)%iice = 0
                   var(1)%thetai = zero
                   var(1)%thetal = theta
                ELSE

                   ! frozen remaining frozen
                   Jsoil = tmp1d2(kk) ! total energy in  soil layer
                   !check there is a zero
                   tmp1 = GTfrozen(Tsoil(1)-50._r_2, Jsoil, dx(1), theta,par(1)%css, par(1)%rho, &
                        h0(kk), par(1)%thre, par(1)%the, par(1)%he, one/(par(1)%lambc*freezefac))

                   tmp2 = GTFrozen(Tfreezing(kk), Jsoil, dx(1), theta,par(1)%css, par(1)%rho, &
                        h0(kk), par(1)%thre, par(1)%the, par(1)%he, one/(par(1)%lambc*freezefac))

                   ! there is a zero in between
                   IF ((tmp1*tmp2) < zero) THEN
                      tmp1d3(kk) = rtbis_Tfrozen(tmp1d2(kk), dx(1), theta,par(1)%css, par(1)%rho, &
                           h0(kk), par(1)%thre, par(1)%the, par(1)%he, one/(par(1)%lambc*freezefac), &
                           Tsoil(1)-50._r_2, Tfreezing(kk), 0.0001_r_2)

                      tmp1d4(kk) = thetalmax(tmp1d3(kk), S(1), par(1)%he, one/(par(1)%lambc*freezefac), &
                           par(1)%thre, par(1)%the) ! liquid content at new Tsoil
                   ELSE
                      WRITE(*,*) "Found no solution for Tfrozen 4.", irec, qmelt(1), h0(kk)
                      WRITE(logn,*) "Assume soil is totally frozen"
                      tmp1d3(kk) = (Jsoil + rhow*lambdaf*(theta*dx(1) +  h0(kk))) / &
                           (dx(1)*par(1)%css*par(1)%rho + rhow*csice*(theta*dx(1) + h0(kk)))
                      tmp1d4(kk) = 0.0_r_2
                      WRITE(logn,*) "frozen soil temperature: ", tmp1d3(kk)
                   ENDIF

                   var(1)%thetal = MAX(tmp1d4(kk), zero)
                   var(1)%thetai = theta - tmp1d4(kk)
                   hice_tmp(kk) = hice(kk)
                   hice = h0(kk)*var(1)%thetai/par(1)%thre

                   ! correct total energy stored in pond + soil
                   Jcol_latent_S(kk) = Jcol_latent_S(kk)- rhow*lambdaf*((hice(kk)-hice_tmp(kk)) + &
                        dx(1)*(var(1)%thetai-thetai(1)))

                   Jcol_sensible(kk) = Jcol_sensible(kk) - &
                        var(1)%csoil*dx(1)*(Tsoil(1)) - &
                        (h0_tmp(kk)-hice_tmp(kk))*cswat*rhow*(Tsoil(1)) - &
                        hice_tmp(kk)*rhow*(csice*(Tsoil(1))) + &
                        dx(1)*(tmp1d3(kk))*par(1)%rho*par(1)%css + &
                        (h0(kk)-hice(kk)+var(1)%thetal*dx(1))*cswat*rhow*(tmp1d3(kk)) + &
                        (hice_tmp(kk)+var(1)%thetai)*rhow*(csice*(tmp1d3(kk)))

                   thetai(1) = var(1)%thetai
                   Tsoil(1) = tmp1d3(kk)
                ENDIF ! incomplete melting
             ENDIF ! iice=1

             DO i=1, vsnow(kk)%nsnow
                vsnow(kk)%Jsensible(i) = (vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow*csice*(vsnow(kk)%Tsn(i))
                vsnow(kk)%Jlatent(i) = (vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*rhow*(-lambdaf)
             ENDDO
             vsnow(kk)%J = SUM(vsnow(kk)%Jsensible(1:vsnow(kk)%nsnow)+vsnow(kk)%Jlatent(1:vsnow(kk)%nsnow))
             vsnow(kk)%deltaJ = vsnow(kk)%J - J0snow(kk)
             vsnow(kk)%FluxDivergence = vsnow(kk)%Qadv_rain + vsnow(kk)%Qadv_snow + vsnow(kk)%Qadv_vap + &
                  vsnow(kk)%Qadv_melt + vsnow(kk)%Qcond_net  +  vsnow(kk)%Qadv_transfer
          ENDIF ! (melt_transfer==.true.)
       ENDIF ! remove  melt water

       DO i=1, vsnow(kk)%nsnow
          vsnow(kk)%dens(i) = vsnow(kk)%hsnow(i)/vsnow(kk)%depth(i)*rhow
          IF (vsnow(kk)%dens(i).LT.50._r_2) THEN
             vsnow(kk)%dens(i) = 50.0_r_2
             vsnow(kk)%depth(i) = vsnow(kk)%hsnow(i)*rhow/vsnow(kk)%dens(i)
          ENDIF
          tmp1d3(kk) = (500._r_2*(vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i)) + rhow*vsnow(kk)%hliq(i))/vsnow(kk)%hsnow(i)
          IF (vsnow(kk)%dens(i).GT.tmp1d3(kk)) THEN
             vsnow(kk)%dens(i) = tmp1d3(kk)
             vsnow(kk)%depth(i) = vsnow(kk)%hsnow(i)*rhow/vsnow(kk)%dens(i)
          ENDIF

       ENDDO

       vsnow(kk)%totdepth = SUM(vsnow(kk)%depth(1:vsnow(kk)%nsnow))

       ! adjust number of snow layers if required
       IF (nsnow_max>1.AND.vsnow(kk)%totdepth > 0.03_r_2) THEN
          tmp1d3(kk) = vsnow(kk)%depth(1)

          IF (vsnow(kk)%totdepth.LT.0.06_r_2) THEN
             vsnow(kk)%depth(1) = vsnow(kk)%totdepth/2._r_2
          ELSE
             vsnow(kk)%depth(1) = 0.03_r_2
          ENDIF
          vsnow(kk)%depth(nsnow_max) = vsnow(kk)%totdepth -  vsnow(kk)%depth(1)

          IF (vsnow(kk)%nsnow == 1) THEN
             !put excess into new layer below (initialise 2nd snow layer if necessary)
             vsnow(kk)%tsn(vsnow(kk)%nsnow+1) = vsnow(kk)%tsn(1)
             vsnow(kk)%dens(vsnow(kk)%nsnow+1) = vsnow(kk)%dens(1)
             vsnow(kk)%hsnow(1) = vsnow(kk)%depth(1)*(vsnow(kk)%dens(1)/rhow)
             vsnow(kk)%hsnow(vsnow(kk)%nsnow+1) = vsnow(kk)%depth(vsnow(kk)%nsnow+1)*(vsnow(kk)%dens(vsnow(kk)%nsnow+1)/rhow)
             vsnow(kk)%hliq(vsnow(kk)%nsnow+1)  = vsnow(kk)%hliq(1)*vsnow(kk)%hsnow(vsnow(kk)%nsnow+1)/(vsnow(kk)%hsnow(1)+ &
                  vsnow(kk)%hsnow(vsnow(kk)%nsnow+1))
             vsnow(kk)%hliq(1) = vsnow(kk)%hliq(1) - vsnow(kk)%hliq(vsnow(kk)%nsnow+1)
             vsnow(kk)%nsnow = 2
          ELSE
             ! recalculate tsn, dens, hsnow, hliq according to new layer depths
             ! total energy of combined snow pack
             tmp1d1(kk) = rhow*(vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*(csice*vsnow(kk)%tsn(1) - lambdaf) + &
                  rhow*(vsnow(kk)%hsnow(vsnow(kk)%nsnow)-vsnow(kk)%hliq(vsnow(kk)%nsnow))* &
                  (csice*vsnow(kk)%tsn(vsnow(kk)%nsnow) - lambdaf)


             IF (vsnow(kk)%depth(1).LE.tmp1d3(kk)) THEN
                i= 1 ! if top layer decreases in depth, it retains old density
                j=2
             ELSE
                i = 2 ! if bottom layer decreases in depth, it retains old density
                j=1
             ENDIF
             vsnow(kk)%hliq(i)= vsnow(kk)%hliq(i)*vsnow(kk)%depth(i)*(vsnow(kk)%dens(i)/rhow)/vsnow(kk)%hsnow(i)
             vsnow(kk)%hsnow(j)= (vsnow(kk)%hsnow(i)+vsnow(kk)%hsnow(j)) - vsnow(kk)%depth(i)*(vsnow(kk)%dens(i)/rhow)
             vsnow(kk)%hsnow(i)= vsnow(kk)%depth(i)*(vsnow(kk)%dens(i)/rhow)

             ! energy content of augmented layer
             tmp1d2(kk) = tmp1d1(kk) - &
                  rhow*(vsnow(kk)%hsnow(i)-vsnow(kk)%hliq(i))*(csice*vsnow(kk)%tsn(i)- lambdaf)
             IF (tmp1d2(kk).LT. -vsnow(kk)%hsnow(j)*rhow*lambdaf) THEN
                vsnow(kk)%hliq(j)= zero
                vsnow(kk)%tsn(j)= (tmp1d2(kk)/(rhow*vsnow(kk)%hsnow(j))+lambdaf)/csice
             ELSE
                vsnow(kk)%tsn(j)= zero
                vsnow(kk)%hliq(j)= vsnow(kk)%hsnow(j)+ tmp1d2(kk)/(rhow*lambdaf)
             ENDIF

             ! density of augmented layer
             vsnow(kk)%dens(j)= rhow * vsnow(kk)%hsnow(j)/vsnow(kk)%depth(j)

          ENDIF

       ELSEIF (nsnow_max>1.AND.vsnow(kk)%nsnow == 2.AND.(vsnow(kk)%totdepth).LE.0.03_r_2) THEN
          ! combine top two snow layers into 1

          ! total energy of combined snow layer
          tmp1d1(kk) = rhow*(vsnow(kk)%hsnow(1)-vsnow(kk)%hliq(1))*(csice*vsnow(kk)%tsn(1) - lambdaf) + &
               rhow*(vsnow(kk)%hsnow(vsnow(kk)%nsnow)-vsnow(kk)%hliq(vsnow(kk)%nsnow))* &
               (csice*vsnow(kk)%tsn(vsnow(kk)%nsnow) - lambdaf)
          IF (tmp1d1(kk).LT. -(vsnow(kk)%hsnow(1)+vsnow(kk)%hsnow(vsnow(kk)%nsnow))*rhow*lambdaf) THEN
             vsnow(kk)%hliq(1) = zero
             vsnow(kk)%tsn(1) = (tmp1d1(kk)/(rhow*(vsnow(kk)%hsnow(1)+vsnow(kk)%hsnow(vsnow(kk)%nsnow)))+lambdaf)/csice
          ELSE
             vsnow(kk)%tsn(1) = zero
             vsnow(kk)%hliq(1) = (vsnow(kk)%hsnow(1)+vsnow(kk)%hsnow(vsnow(kk)%nsnow)) + tmp1d1(kk)/(rhow*lambdaf)
          ENDIF

          vsnow(kk)%tsn(vsnow(kk)%nsnow) = zero
          vsnow(kk)%hliq(vsnow(kk)%nsnow) = zero
          vsnow(kk)%hsnow(1) = vsnow(kk)%hsnow(1) + vsnow(kk)%hsnow(vsnow(kk)%nsnow)
          vsnow(kk)%hsnow(vsnow(kk)%nsnow) = 0
          vsnow(kk)%depth(1) = vsnow(kk)%depth(1) + vsnow(kk)%depth(vsnow(kk)%nsnow)
          vsnow(kk)%depth(vsnow(kk)%nsnow) = 0
          vsnow(kk)%dens(1) = vsnow(kk)%hsnow(1)/vsnow(kk)%depth(1)*rhow
          vsnow(kk)%nsnow = 1
       ENDIF

       IF (vsnow(kk)%hsnow(1).LT.zero.OR.vsnow(kk)%hsnow(nsnow_max).LT.zero) THEN
          WRITE(logn,*) "hsnow<0. Set it to 0 (irec, kk, hsnow):", irec, kk, vsnow(kk)%hsnow(1)
          vsnow(kk)%hsnow(1) = zero
       ENDIF

       DO i=1, vsnow(kk)%nsnow
          vsnow(kk)%Dv(i) = Dva*((vsnow(kk)%tsn(i)+Tzero)/Tzero)**1.88_r_2 ! m2 s-1
          vsnow(kk)%sl(i) = slope_esat_ice(vsnow(kk)%tsn(i)) * Mw/thousand/Rgas/(vsnow(kk)%tsn(i)+Tzero)
          vsnow(kk)%kE(i)     = vsnow(kk)%Dv(i)*vsnow(kk)%sl(i)*thousand*lambdaf
          vsnow(kk)%kH(i) = 3.2217e-6_r_2 * vsnow(kk)%dens(i)**2
          vsnow(kk)%kth(i) = vsnow(kk)%kE(i) + vsnow(kk)%kH(i)
          vsnow(kk)%cv(i) = esat_ice(vsnow(kk)%tsn(i))*Mw/thousand/Rgas/(vsnow(kk)%tsn(i)+Tzero) ! m3 m-3
          vsnow(kk)%depth(i) = vsnow(kk)%hsnow(i)/(vsnow(kk)%dens(i)/rhow)
       ENDDO

    ENDIF ! dedicated snow layer

  END SUBROUTINE snow_adjust

  !=============================================================================

  SUBROUTINE isotope_vap(irec,isotopologue, n, nsnow, nsnow_last,  & ! scalar in
       ns, dx, deltaz, sig, dt, &     ! in soil
       Tsoil0, dTsoil, Sliqice, deltaSliqice, & ! in variables
       Sliq, deltaSliq,Sice, deltaSice, &
       Ts, Ta, &
       qsig, qlsig, qvsig,  & ! in fluxes
       qmelt, qtransfer, & ! melt water to soil and water transfer from soil to snow (+ve) or snow to soil (-ve)
       qprec, qprec_snow, qevap, qrunoff, qex, & ! in fluxes
       var_cv, var_Dv, &   ! in variables
       thetasat, thetar, tortuosity, deltacv, rbw, cva, civa, & ! in parameter
       cprec,cprec_snow, cali, & ! in iso
       ql0, qv0, & ! inout water
       ciso, cisoice, cisos, & ! inout iso
       qiso_in, qiso_out, qiso_evap, qiso_trans, qiso_liq_adv, qiso_vap_adv, qiso_liq_diff, qiso_vap_diff) ! out iso


    IMPLICIT NONE
    INTEGER(i_d),                    INTENT(IN)    :: irec
    INTEGER(i_d),                    INTENT(IN)    :: isotopologue ! which isotope
    INTEGER(i_d),                    INTENT(IN)    :: n            ! # of soil layers
    INTEGER(i_d),                    INTENT(IN)    :: nsnow        ! # of snow layers
    INTEGER(i_d),                    INTENT(IN)    :: nsnow_last   ! # of snow layers
    INTEGER(i_d),                    INTENT(IN)    :: ns           ! index of top of soil/snow column (-nsnow_max+1)
    REAL(r_2),    DIMENSION(ns:n),   INTENT(IN)    :: dx           ! soil/snow depths
    REAL(r_2),    DIMENSION(ns:n-1), INTENT(IN)    :: deltaz       ! soil/snow layer thickness
    REAL(r_2),                       INTENT(IN)    :: sig          ! implicit/explicit time steping constant
    REAL(r_2),                       INTENT(IN)    :: dt           ! time step
    REAL(r_2),    DIMENSION(ns:n),   INTENT(IN)    :: Tsoil0       ! soil/snow temperatures
    REAL(r_2),    DIMENSION(ns:n),   INTENT(IN)    :: dTsoil       ! soil/snow temperatures change
    REAL(r_2),    DIMENSION(ns:n),   INTENT(IN)    :: Sliqice      ! soil saturation
    REAL(r_2),    DIMENSION(ns:n),   INTENT(IN)    :: deltaSliqice ! soil sturation change
    REAL(r_2),    DIMENSION(ns:n),   INTENT(IN)    :: Sliq         ! soil saturation
    REAL(r_2),    DIMENSION(ns:n),   INTENT(IN)    :: deltaSliq    ! soil sturation change
    REAL(r_2),    DIMENSION(ns:n),   INTENT(IN)    :: Sice         ! soil saturation
    REAL(r_2),    DIMENSION(ns:n),   INTENT(IN)    :: deltaSice    ! soil sturation change
    REAL(r_2),                       INTENT(IN)    :: Ts           ! surface temperature
    REAL(r_2),                       INTENT(IN)    :: Ta           ! air temperature [degC]
    REAL(r_2),    DIMENSION(ns-1:n), INTENT(IN)    :: qsig         ! water flux
    REAL(r_2),    DIMENSION(ns-1:n), INTENT(INOUT) :: qlsig        ! liquid water flux
    REAL(r_2),    DIMENSION(ns-1:n), INTENT(INOUT) :: qvsig        ! vapour flux
    REAL(r_2),                       INTENT(IN)    :: qprec        ! liquid  precip
    REAL(r_2),                       INTENT(IN)    :: qprec_snow   ! solid precip
    REAL(r_2),                       INTENT(IN)    :: qevap        ! evaporation
    REAL(r_2),                       INTENT(IN)    :: qrunoff      ! runoff
    REAL(r_2),    DIMENSION(1:n),    INTENT(IN)    :: qex          ! root extraction
    REAL(r_2),                       INTENT(IN)    :: qmelt        !  melt water ! should eventually be dimensioned nsnow_max
    REAL(r_2),                       INTENT(IN)    :: qtransfer    ! water transfer from soil to snow (+ve) or snow to soil (-ve)
    ! TYPE(vars), DIMENSION(1:n),   INTENT(IN)    :: var           ! soil variables
    REAL(r_2), DIMENSION(ns:n),   INTENT(IN)    :: var_cv        ! soil/snow variables cv
    REAL(r_2), DIMENSION(ns:n),   INTENT(IN)    :: var_Dv        ! soil/snow variables Dv
    REAL(r_2), DIMENSION(ns:n),   INTENT(IN)    :: thetasat      ! saturation moisture
    REAL(r_2), DIMENSION(ns:n),   INTENT(IN)    :: thetar        ! residual moisture
    REAL(r_2), DIMENSION(ns:n),   INTENT(IN)    :: tortuosity    ! soil tortuosity
    REAL(r_2), DIMENSION(ns:n),   INTENT(INOUT) :: deltacv       !
    REAL(r_2),                    INTENT(IN)    :: rbw           ! boundary layer resistance
    REAL(r_2),                    INTENT(IN)    :: cva           !
    REAL(r_2),                    INTENT(IN)    :: civa          ! iso conc in air
    REAL(r_2),                    INTENT(IN)    :: cprec         ! iso conc in liquid precip
    REAL(r_2),                    INTENT(IN)    :: cprec_snow    ! iso conc in snow
    REAL(r_2),                    INTENT(IN)    :: cali          ! iso conc in alimenation water (from below)
    REAL(r_2),                    INTENT(INOUT) :: ql0           ! liquid flux into soil or snow surface
    REAL(r_2),                    INTENT(INOUT) :: qv0           ! vapour flux into soil or snow surface
    REAL(r_2), DIMENSION(ns:n),   INTENT(INOUT) :: ciso          ! iso conc in soil
    REAL(r_2), DIMENSION(ns:n),   INTENT(INOUT) :: cisoice       ! iso conc in soil
    REAL(r_2),                    INTENT(INOUT) :: cisos         ! iso conc on surface
    REAL(r_2),                    INTENT(OUT)   :: qiso_in       ! iso flux into soil
    REAL(r_2),                    INTENT(OUT)   :: qiso_out      ! iso flux out of soil
    REAL(r_2),                    INTENT(OUT)   :: qiso_evap     ! iso flux of evaporation
    REAL(r_2),                    INTENT(OUT)   :: qiso_trans    ! iso flux of transpiration
    REAL(r_2), DIMENSION(ns:n),   INTENT(OUT)   :: qiso_liq_adv  ! liquid iso flux in soil due to advection
    REAL(r_2), DIMENSION(ns:n),   INTENT(OUT)   :: qiso_vap_adv  ! vapour iso flux in soil due to advection
    REAL(r_2), DIMENSION(ns:n-1), INTENT(OUT)   :: qiso_liq_diff ! liquid iso flux in soil due to diffusion
    REAL(r_2), DIMENSION(ns:n-1), INTENT(OUT)   :: qiso_vap_diff ! vapour iso flux in soil due to diffusion

    ! Local variables

    REAL(r_2), DIMENSION(ns:n)   :: aa, bb, cc, dd, dc,  LHS, RHS
    REAL(r_2), DIMENSION(ns:n)   :: alphaplus, dalphaplusdT, deltaT, beta, deltabeta
    REAL(r_2), DIMENSION(ns:n)   :: alphaplus_liqice, dalphaplusdT_liqice
    ! diffusivities (liquid, liq-vap, coefft for D, surface H2O vapour, surface minor isotopologue vapour)
    REAL(r_2), DIMENSION(ns-1:n) :: Dl, Dv
    ! REAL(r_2)                    :: Dvs, Divs
    REAL(r_2)                    :: patm, nk, alphak, alphak_vdiff, alphak_ldiff
    REAL(r_2)                    :: cevapin, cevapout, qevapin, qevapout, dcevapoutdciso
    ! concentrations of advective fluxes and corresponding partial derivs wrt ciso
    REAL(r_2), DIMENSION(ns-1:n) :: cql, dcqldca, dcqldcb, cqv, dcqvdca, dcqvdcb
    REAL(r_2), DIMENSION(ns:n-1) :: wcql, wcqv
    REAL(r_2), DIMENSION(ns-1:n) :: betaqv, dbetaqv
    REAL(r_2), DIMENSION(ns-1:n) :: Dlmean, Dvmean, Dvbetamean, wl, wv
    REAL(r_2)                    :: coefA, coefB, coefC
    REAL(r_2)                    :: coefA_liqice, coefB_liqice, coefC_liqice
    REAL(r_2), DIMENSION(ns:n)   :: Seff, deltaSeff, S, Tsoil, cvsig, Sliqsig, Sicesig,qex_ss
    REAL(r_2), DIMENSION(ns:n)   :: thetaice, deltathetaice, dcice
    INTEGER(i_d)                 :: ns_ciso
    REAL(r_2)                    :: num, den, cv1
    REAL(r_2)                    :: alphaplus_s, alphaplus_a
    ! REAL(r_2)                    :: alphaplus_liqice
    REAL(r_2)                    :: cvs !, qevapL, qevapoutL, qevapinL
    ! REAL(r_2)                    :: cevapinL, cevapoutL, dcevapoutdcisoL, dcevapindcisoL
    REAL(r_2)                    :: w1, w2
    INTEGER(i_d), PARAMETER      :: formulation = 2  ! 1: betaql, betaqv of flux; 2: betaql, betaqv 0.5 of upper and lower
    REAL(r_2), DIMENSION(ns:n)   :: kfreeze, kfreeze2         ! combination of freezing variables
    REAL(r_2),   DIMENSION(ns:n) :: deltaS     !
    INTEGER(i_d), DIMENSION(1)   :: ii
    REAL(r_2)                    :: tmp
    REAL(r_2), DIMENSION(ns:n)   :: tmp1d1

    dcice = zero
    aa = zero
    bb = zero
    cc = zero
    dd = zero
    alphaplus = zero
    dalphaplusdT = zero
    alphaplus_liqice = zero
    dalphaplusdT_liqice = zero
    deltaT = zero
    Dl = zero
    Dv = zero
    cql = zero
    dcqldca = zero
    dcqldcb = zero
    cqv = zero
    dcqvdca = zero
    dcqvdcb = zero
    wcql = zero
    wcqv = zero
    beta = zero
    deltabeta = zero
    betaqv = zero
    dbetaqv = zero
    Dlmean = zero
    Dvmean = zero
    wl = zero
    wv = zero
    Seff = zero
    deltaSeff = zero
    S = zero
    Tsoil = zero
    cvsig = zero
    Sliqsig = zero
    Sicesig = zero
    thetaice = zero
    deltathetaice = zero
    dcice = zero
    kfreeze = zero
    kfreeze2 = zero
    qiso_liq_adv = zero
    qiso_vap_adv = zero
    qiso_liq_diff = zero
    qiso_vap_diff = zero
    dc = zero
    dcice = zero

    IF (nsnow_last == 0) THEN
       ciso(0) = ciso(1)
       cisoice(0) = cisoice(1)
    ENDIF

    ns_ciso = -nsnow+1 ! index of top layer (<=0 = snow)

    IF ((nsnow_last.EQ.0) .AND. (ns_ciso.LE.0)) THEN
       ciso(ns_ciso:0) = ciso(1)
       cisoice(ns_ciso:0) = cisoice(1)
    ENDIF
    patm = one
    deltaT(ns_ciso:n) = dTsoil(ns_ciso:n)
    qex_ss(1:n) = qex(1:n)
    IF (ns_ciso<1) THEN
       qex_ss(ns_ciso:0) = zero
    ENDIF

    ! Tsoil to Tsoilsig
    Tsoil(ns_ciso:n) = Tsoil0(ns_ciso:n) + (sig-one)*deltaT(ns_ciso:n)

    ! equilibrium fractionation factors at the surface and in the soil
    coefA = zero
    coefB = zero
    coefC = zero
    IF (isotopologue==1) THEN
       coefA = 24844.0_r_2
       coefB = -76.248_r_2
       coefC = 0.052612_r_2
       ! alphaplus_liqice = 1.0212_r_2
       coefA_liqice = 48888_r_2
       coefB_liqice = -203.10_r_2
       coefC_liqice = 0.2133_r_2
    ENDIF
    IF (isotopologue==2) THEN
       coefA = 1137.0_r_2
       coefB = -0.4156_r_2
       coefC = -0.0020667_r_2
       ! alphaplus_liqice = 1.00291_r_2
       coefA_liqice = 8312.5_r_2
       coefB_liqice = -49.192_r_2
       coefC_liqice = 0.0831_r_2
    ENDIF
    !MC
    ! alphaplus_a                    = one/exp(coefA/((Ta+Tzero)**2)+coefB/(Ta+Tzero)+coefC) ! at soil or litter surface
    ! alphaplus_s                    = one/exp(coefA/((Ts+Tzero)**2)+coefB/(Ts+Tzero)+coefC) ! at soil or litter surface
    ! alphaplus(ns_ciso:n)           = one/exp(coefA/((Tsoil(ns_ciso:n)+Tzero)**2)+coefB/(Tsoil(ns_ciso:n)+Tzero)+coefC)
    ! dalphaplusdT(ns_ciso:n)        = (two*coefA/(Tsoil(ns_ciso:n)+Tzero)**3 + coefB/(Tsoil(ns_ciso:n)+Tzero)**2) &
    !      / exp(coefA/((Tsoil(ns_ciso:n)+Tzero)**2)+coefB/(Tsoil(ns_ciso:n)+Tzero)+coefC)
    ! alphaplus_liqice(ns_ciso:n)    = one/exp(coefA_liqice/((Tsoil(ns_ciso:n)+Tzero)**2)+ &
    !      coefB_liqice/(Tsoil(ns_ciso:n)+Tzero)+coefC_liqice)
    ! dalphaplusdT_liqice(ns_ciso:n) = (two*coefA_liqice/(Tsoil(ns_ciso:n)+Tzero)**3 + &
    !      coefB_liqice/(Tsoil(ns_ciso:n)+Tzero)**2) &
    !      / exp(coefA_liqice/((Tsoil(ns_ciso:n)+Tzero)**2)+coefB_liqice/(Tsoil(ns_ciso:n)+Tzero)+coefC_liqice)
    ! alphaplus_liqice(ns_ciso:n) = one/alphaplus_liqice(ns_ciso:n)  ! needs to be > 1
    tmp = MAX(Ta, zero)
    alphaplus_a                    = one/EXP(coefA/((tmp+Tzero)**2)+coefB/(tmp+Tzero)+coefC)
    tmp = MAX(Ts, zero)
    alphaplus_s                    = one/EXP(coefA/((tmp+Tzero)**2)+coefB/(tmp+Tzero)+coefC)
    tmp1d1(ns_ciso:n) = MAX(Tsoil(ns_ciso:n), zero)
    alphaplus(ns_ciso:n)           = one/EXP(coefA/((tmp1d1(ns_ciso:n)+Tzero)**2)+coefB/(tmp1d1(ns_ciso:n)+Tzero)+coefC)
    dalphaplusdT(ns_ciso:n)        = (two*coefA/(tmp1d1(ns_ciso:n)+Tzero)**3 + coefB/(tmp1d1(ns_ciso:n)+Tzero)**2) &
         / EXP(coefA/((tmp1d1(ns_ciso:n)+Tzero)**2)+coefB/(tmp1d1(ns_ciso:n)+Tzero)+coefC)
    tmp1d1(ns_ciso:n) = MIN(Tsoil(ns_ciso:n), zero)
    alphaplus_liqice(ns_ciso:n)    = one/EXP(coefA_liqice/((tmp1d1(ns_ciso:n)+Tzero)**2)+ &
         coefB_liqice/(tmp1d1(ns_ciso:n)+Tzero)+coefC_liqice)
    dalphaplusdT_liqice(ns_ciso:n) = (two*coefA_liqice/(tmp1d1(ns_ciso:n)+Tzero)**3 + &
         coefB_liqice/(tmp1d1(ns_ciso:n)+Tzero)**2) &
         / EXP(coefA_liqice/((tmp1d1(ns_ciso:n)+Tzero)**2)+coefB_liqice/(tmp1d1(ns_ciso:n)+Tzero)+coefC_liqice)
    alphaplus_liqice(ns_ciso:n) = one/alphaplus_liqice(ns_ciso:n)  ! needs to be > 1

    ! if (experiment==1 .or. experiment==2.or. experiment==9.or. experiment==10 .or. experiment == 16) then
    IF (experiment==1 .OR. experiment==2.OR. experiment==9.OR. experiment==10) THEN
       alphaplus_s      = one
       alphaplus        = one
       dalphaplusdT     = zero
       alphaplus_liqice = one
    ENDIF
    !MC
    ! alphaplus_s      = one
    ! alphaplus        = one
    ! dalphaplusdT     = zero
    ! alphaplus_liqice = one

    ! beta
    beta(ns_ciso:n)      = alphaplus(ns_ciso:n)
    deltabeta(ns_ciso:n) = dalphaplusdT(ns_ciso:n)*deltaT(ns_ciso:n)
    beta(ns_ciso:n)      = beta(ns_ciso:n) + sig*deltabeta(ns_ciso:n) ! beta_sig

    ! adjust S and h and cv for sig of time-step
    S(ns_ciso:n)       = Sliqice(ns_ciso:n) + deltaSliqice(ns_ciso:n)*(sig-one) ! set S to Ssig. N.B. S = Sliqice
    Sliqsig(ns_ciso:n) = Sliq(ns_ciso:n) + deltaSliq(ns_ciso:n)*(sig-one)
    Sicesig(ns_ciso:n) = Sice(ns_ciso:n) + deltaSice(ns_ciso:n)*(sig-one)

    thetaice(1:n)      = Sice(1:n) * (thetasat(1:n)-thetar(1:n))
    deltathetaice(1:n) = deltaSice(1:n) * (thetasat(1:n)-thetar(1:n))

    kfreeze(ns_ciso:n)  = MERGE(alphaplus_liqice(ns_ciso:n)*deltaSice(ns_ciso:n)/Sice(ns_ciso:n), &
         zero, deltaSice(ns_ciso:n) > zero)
    kfreeze2(ns_ciso:n) = MERGE(deltaSice(ns_ciso:n)/Sice(ns_ciso:n)*(alphaplus_liqice(ns_ciso:n)*ciso(ns_ciso:n) - &
         cisoice(ns_ciso:n)), zero, deltaSice(ns_ciso:n) > zero)
    ! adapt kfreeze for totally frozen snow
    IF (nsnow > 0) THEN
       WHERE (.NOT. ((Sliq(ns_ciso:0) > zero) .OR. (deltaSliq(ns_ciso:0) > zero))) ! solve for change in isotopes in ice
          kfreeze(ns_ciso:0)  = one
          kfreeze2(ns_ciso:0) = zero
          ciso(ns_ciso:0)     = cisoice(ns_ciso:0)
       endwhere
       ! composition of new ice is composition of snow
       IF  (((Sliq(ns_ciso) > zero) .OR. (deltaSliq(ns_ciso) > zero)) .AND. (qprec_snow > zero)) THEN
          kfreeze(ns_ciso)  =  zero
          kfreeze2(ns_ciso) = deltaSice(ns_ciso)/Sice(ns_ciso)*(cprec_snow-cisoice(ns_ciso))
       ENDIF
    ENDIF
    ! composition of new ice in surface layer is composition of snow
    IF  (((Sliq(ns_ciso) > zero) .OR. (deltaSliq(ns_ciso) > zero)) .AND. &
         (qprec_snow > zero) .AND. (Sice(ns_ciso) > zero) .AND. (deltaSice(ns_ciso) > zero)) THEN
       kfreeze(ns_ciso)  =  zero
       kfreeze2(ns_ciso) = deltaSice(ns_ciso)/Sice(ns_ciso)*(cprec_snow-cisoice(ns_ciso))
    ENDIF
    IF ((Sice(1) <= zero) .AND. (deltaSice(1) > zero)) THEN
       WRITE(*,*) "deltaSice inconistent with Sice"
    ENDIF

    ! calculate deltacv which is consistent with deltaS and deltaSliqice
    deltaS(ns_ciso:n) = ( qlsig(ns_ciso-1:n-1) + qvsig(ns_ciso-1:n-1) &
         - qlsig(ns_ciso:n) - qvsig(ns_ciso:n) - qex_ss(ns_ciso:n) ) * &
         dt/(dx(ns_ciso:n)*thetasat(ns_ciso:n))

    ! modify for snow melt (including disappearance of snow pack) and/or transfer from top soil to new snow pack
    ! valid for 3 snow layers ???
    IF ((qmelt.GT.zero) .OR. ((qtransfer).GT.zero)) THEN
       deltaS(0) = (qlsig(-1) + qvsig(-1) - (qlsig(0)+qmelt-qtransfer) - qvsig(0))*dt/dx(0)/thetasat(0)
       deltaS(1) = (qlsig(0)+qmelt-qtransfer + qvsig(0) - qlsig(1)- qvsig(1)-qex_ss(1))*dt/dx(1)/thetasat(1)
    ENDIF
    ! modify deltaS in top layer for precip
    deltaS(ns_ciso) = deltaS(ns_ciso) + (qprec+qprec_snow)*dt/dx(ns_ciso)/thetasat(ns_ciso)
    ! modify deltaS in top soil layer for runoff
    deltaS(1) = deltaS(1) - qrunoff*dt/thetasat(1)/dx(1)

    WHERE (var_cv(ns_ciso:n).GT.zero)
       deltacv(ns_ciso:n) = (deltaS(ns_ciso:n) - deltaSliqice(ns_ciso:n) + var_cv(ns_ciso:n)*deltaSliqice(ns_ciso:n))/ &
            (1._r_2 - (S(ns_ciso:n) + deltaSliqice(ns_ciso:n)*(one-sig)))
    ELSEWHERE
       deltacv(ns_ciso:n) = zero
    endwhere
    cvsig(ns_ciso:n) = var_cv(ns_ciso:n) + deltacv(ns_ciso:n)*(sig-one)

    WHERE (S(ns_ciso:n)<one)
       Seff(ns_ciso:n) = Sliqsig(ns_ciso:n) + (one-S(ns_ciso:n))*cvsig(ns_ciso:n)*beta(ns_ciso:n) ! &
       Seff(ns_ciso:n) = Seff(ns_ciso:n)   + thetar(ns_ciso:n)/(thetasat(ns_ciso:n)-thetar(ns_ciso:n))
       deltaSeff(ns_ciso:n) = deltaSliq(ns_ciso:n) + beta(ns_ciso:n)*deltacv(ns_ciso:n) &
            + cvsig(ns_ciso:n)*deltabeta(ns_ciso:n) &
            - (S(ns_ciso:n)*beta(ns_ciso:n)*deltacv(ns_ciso:n) + cvsig(ns_ciso:n)*beta(ns_ciso:n)*deltaSliqice(ns_ciso:n) + &
            cvsig(ns_ciso:n)*S(ns_ciso:n)*deltabeta(ns_ciso:n))
    ELSEWHERE
       Seff(ns_ciso:n)      = Sliqsig(ns_ciso:n)
       Seff(ns_ciso:n)      = Seff(ns_ciso:n) + thetar(ns_ciso:n)/thetasat(ns_ciso:n)
       deltaSeff(ns_ciso:n) = deltaSliq(ns_ciso:n)
    endwhere

    ! diffusional fractionation factor
    ! air
    IF (isotopologue==1) alphak_vdiff = one / 1.0251_r_2   ! HDO diffusivity in air (Merlivat 1978)
    IF (isotopologue==2) alphak_vdiff = one / 1.0285_r_2   ! H218O diffusivity in air (Merlivat 1978)
    IF ((experiment >= 1 .AND. experiment <= 5) .OR. (experiment == 9 .OR. experiment == 10)) alphak_vdiff = one
    ! if (experiment == 9 .or. experiment == 10 .or. experiment == 16) alphak_vdiff = one
    ! kinetic fractionation factor at the surface
    ! Dvs = Dva*1.e5_r_2/patm*((Ts+Tzero)/Tzero)**1.88_r_2 ! vapour diffusivity of water in air (m2s-1)
    ! if (isotopologue/=0) Divs = Dvs * alphak_vdiff  ! isotope diffusivity in air
    nk = MIN(S(1),one)*half + (one-MIN(S(1),one))*one
    IF (experiment == 7 .OR. experiment == 8) nk = one
    alphak = alphak_vdiff**nk ! = one/((Dvs/Divs)**nk)
    IF ((experiment >= 1 .AND. experiment <= 5) .OR. (experiment == 9 .OR. experiment == 10)) alphak = one
    ! if (experiment == 9 .or. experiment == 10 .or. experiment == 16) alphak = one

    ! liquid diffusivity in the pond and soil
    IF (isotopologue==1) alphak_ldiff = one / 1.013_r_2
    IF (isotopologue==2) alphak_ldiff = one / 1.026_r_2
    ! molecular diffusion of isotopes in normal liquid water (m2s-1)
    Dl(ns_ciso:n) = tortuosity(ns_ciso:n) * alphak_ldiff * 1.0e-7_r_2*EXP(-577.0_r_2/((Tsoil(ns_ciso:n)+Tzero)-145._r_2))
    Dl(ns_ciso:n) = Dl(ns_ciso:n) * (MIN(Sliqsig(ns_ciso:n),one) * (thetasat(ns_ciso:n)-thetar(ns_ciso:n)) + thetar(ns_ciso:n))
    IF ((experiment >= 1 .AND. experiment <= 4) .OR. (experiment == 9 .OR. experiment == 10)) Dl = zero
    ! if (experiment == 9 .or. experiment == 10 .or. experiment == 16) Dl = zero

    ! vapour diffusivity in the soil
    Dv(ns_ciso:n) = var_Dv(ns_ciso:n) * alphak_vdiff  ! isotope diffusivity in soil air spaces Dvi
    !MC
    Dv(ns_ciso:n) = Dv(ns_ciso:n) * MAX(one-S(ns_ciso:n),zero)*(thetasat(ns_ciso:n)-thetar(ns_ciso:n))
    ! Dvi*cv always together on RHS
    Dv(ns_ciso:n) = Dv(ns_ciso:n) * cvsig(ns_ciso:n)

    ! upper boundary condition
    cvs = cva + qevap*rbw ! concentration of water vapour at soil/air interface (m3 (H2O liq)/ m3 (air))

    IF (var_Dv(ns_ciso) /= zero) THEN
       cv1 = -qv0*(half*dx(ns_ciso))/var_Dv(ns_ciso) + cvs
    ELSE
       cv1 = var_cv(ns_ciso)
    ENDIF

    IF (ql0 > zero) THEN
       w1 = zero
    ELSE
       w1 = one
    ENDIF
    IF (qv0 > zero) THEN
       w2 = zero
    ELSE
       w2 = one
    ENDIF

    !MC - alphak=1
    ! alphak = one
    IF (nsnow .GE. 1) THEN
       !MC
       ! cisos          = ciso(ns_ciso)
       ! dcevapoutdciso = one
       !MC ???
       ! retain in incoming cisos
       num            = zero
       den            = zero
       dcevapoutdciso = alphak*alphaplus_s
    ELSE
       !MC
       num   = alphak_vdiff*var_Dv(1)/(half*dx(ns_ciso))*cv1*alphaplus(ns_ciso)*ciso(ns_ciso) &
            - ql0*ciso(ns_ciso)*w1 +civa*alphak/rbw + Dl(ns_ciso)*ciso(ns_ciso)/(half*dx(ns_ciso))
       den   = alphak*cvs*alphaplus_s/(rbw) + ql0*(one-w1) + &
            alphaplus(ns_ciso)*alphak_vdiff*cvs*var_Dv(1)/(half*dx(ns_ciso)) +Dl(ns_ciso)/(half*dx(ns_ciso))
       cisos = num/den
       dcevapoutdciso = alphak*alphaplus_s
       dcevapoutdciso = dcevapoutdciso*(alphak_vdiff*var_Dv(1)/(half*dx(ns_ciso))*var_cv(ns_ciso)*alphaplus(ns_ciso) - &
            ql0*w1  + Dl(ns_ciso)/(half*dx(ns_ciso)))/den
    ENDIF

    qevapin  = cva/rbw
    qevapout = cvs/rbw
    !MC
    ! cevapin  = alphak * civa/cva
    cevapin  = alphak * civa/cva / alphaplus_a
    cevapout = alphak * alphaplus_s * cisos

    ! concentrations_ciso of advective fluxes and corresponding partial derivs wrt ciso
    SELECT CASE (formulation)
    CASE (1)
       cql(ns_ciso-1)         = ciso(ns_ciso)
       cql(ns_ciso:n-1)       = MERGE(ciso(ns_ciso:n-1), ciso(ns_ciso+1:n), qlsig(ns_ciso:n-1)>zero)
       dcqldca(ns_ciso-1:n-1) = MERGE(one,  zero, qlsig(ns_ciso-1:n-1)>zero)
       dcqldcb(ns_ciso-1:n-1) = MERGE(zero, one,  qlsig(ns_ciso-1:n-1)>zero)
       cql(n)                 = ciso(n)
       dcqldca(n)             = one
       dcqldcb(n)             = zero

       cqv(ns_ciso-1)         = ciso(ns_ciso) *beta(ns_ciso)
       cqv(ns_ciso:n-1)       = MERGE(ciso(ns_ciso:n-1), ciso(ns_ciso+1:n), qvsig(ns_ciso:n-1)>zero)
       dcqvdca(ns_ciso-1:n-1) = MERGE(one,  zero, qvsig(ns_ciso-1:n-1)>zero)
       dcqvdcb(ns_ciso-1:n-1) = MERGE(zero, one,  qvsig(ns_ciso-1:n-1)>zero)
       cqv(n)                 = ciso(n)
       dcqvdca(n)             = one
       dcqvdcb(n)             = zero

       betaqv(ns_ciso-1)      = beta(ns_ciso)  *alphak_vdiff
       betaqv(ns_ciso:n-1)    = MERGE(beta(ns_ciso:n-1), beta(ns_ciso:n), qvsig(ns_ciso:n-1)>0)   * alphak_vdiff
       betaqv(n)              = beta(n)  * alphak_vdiff

       dbetaqv(ns_ciso:n-1)   = (beta(ns_ciso:n-1) - beta(ns_ciso+1:n))/deltaz(ns_ciso:n-1)
       dbetaqv(ns_ciso-1)     = zero ! vh ????
       dbetaqv(n)             = zero

       ! modify for snow melt (including disappearance of snow pack) and/or transfer from top soil to new snow pack
       IF ((qmelt.GT.zero).OR.((qtransfer).GT.zero)) THEN
          cql(0)     = (qlsig(0)*cql(0)+qmelt*ciso(0)+ciso(1)*(-qtransfer))/(qlsig(0)+qmelt-qtransfer)
          dcqldcb(0) = MERGE(zero, one, qlsig(0)>zero)*qlsig(0)/(qlsig(0)+qmelt -qtransfer)
          dcqldca(0) = MERGE(one,  zero, qlsig(0)>zero)*qlsig(0)/(qlsig(0)+qmelt -qtransfer)
          qlsig(0)   = qlsig(0) + qmelt - qtransfer
       ENDIF

       IF (experiment == 16) THEN
          ! print*, 'Ha03 ', betaqv
          ! print*, 'Ha04 ', dbetaqv
          ! betaqv  = one
          ! dbetaqv = zero
       ENDIF

    CASE (2)
       cql(ns_ciso-1)         = ciso(ns_ciso)
       cql(ns_ciso:n-1)       = half*(ciso(ns_ciso:n-1)+ciso(ns_ciso+1:n))
       dcqldca(ns_ciso-1:n-1) = half
       dcqldcb(ns_ciso-1:n-1) = half
       cql(n)                 = ciso(n)
       dcqldca(n)             = one
       dcqldcb(n)             = zero

       !cqv(ns_ciso-1)         = ciso(ns_ciso) *beta(ns_ciso)
       !cqv(ns_ciso:n-1)       = half*(ciso(ns_ciso:n-1)*beta(ns_ciso:n-1)+ciso(ns_ciso+1:n)*beta(ns_ciso+1:n))
       !dcqvdca(ns_ciso-1:n-1) = half * beta(ns_ciso-1:n-1)
       !dcqvdcb(ns_ciso-1:n-1) = half * beta(ns_ciso:n)
       !cqv(n)                 = ciso(n)*beta(n)
       !dcqvdca(n)             = one*beta(n)
       !dcqvdcb(n)             = zero

       cqv(ns_ciso-1)         = ciso(ns_ciso)
       cqv(ns_ciso:n-1)       = half*(ciso(ns_ciso:n-1)+ciso(ns_ciso+1:n))
       dcqvdca(ns_ciso-1:n-1) = half
       dcqvdcb(ns_ciso-1:n-1) = half
       cqv(n)                 = ciso(n)
       dcqvdca(n)             = one
       dcqvdcb(n)             = zero

       betaqv(ns_ciso-1)      = beta(ns_ciso)*alphak_vdiff
       betaqv(ns_ciso:n-1)    = half*(beta(ns_ciso:n-1)+beta(ns_ciso+1:n))*alphak_vdiff
       betaqv(n)              = beta(n)*alphak_vdiff
       ! print*, 'betaqv ', betaqv
       ! print*, 'beta ', beta
       ! print*, 'alpha ', alphak_vdiff, half

       dbetaqv(ns_ciso:n-1)   = (beta(ns_ciso:n-1) - beta(ns_ciso+1:n))/deltaz(ns_ciso:n-1)
       dbetaqv(ns_ciso-1)     = zero ! vh ???? !
       dbetaqv(n)             = zero

       !MC
       ! if (experiment == 16) then
       !    print*, 'Ha01 ', betaqv
       !    ! print*, 'Ha02 ', dbetaqv
       ! betaqv  = one
       !   dbetaqv = zero
       ! endif

       ! modify for snow melt (including disappearance of snow pack) and/or transfer from top soil to new snow pack
       IF ((qmelt.GT.zero) .OR. ((qtransfer).GT.zero)) THEN
          cql(0)      = (qlsig(0)*cql(0)+qmelt*ciso(0)+cisoice(1)*(-qtransfer))/(qlsig(0)+qmelt-qtransfer)
          dcqldcb(0)  =  half*qlsig(0)/(qlsig(0)+qmelt-qtransfer)
          dcqldca(0)  =  half*qlsig(0)/(qlsig(0)+qmelt-qtransfer)
          qlsig(0)    = qlsig(0) + qmelt - qtransfer
       ENDIF

    CASE default
       WRITE(*,*) "isotope_vap: illegal formulation [1-2]: ", formulation
       STOP 2
    END SELECT

    ! mean diffusivities
    wl(ns_ciso:n)         = dx(ns_ciso:n)
    Dlmean(ns_ciso-1:n-1) = (Dl(ns_ciso-1:n-1)*wl(ns_ciso-1:n-1) + &
         Dl(ns_ciso:n)*wl(ns_ciso:n))/(wl(ns_ciso-1:n-1)+wl(ns_ciso:n))
    DLmean(n)             = zero

    wv(ns_ciso:n)       = dx(ns_ciso:n)
    Dvmean(ns_ciso:n-1) = (Dv(ns_ciso:n-1)*wv(ns_ciso:n-1) + Dv(ns_ciso+1:n)*wv(ns_ciso+1:n))/(wv(ns_ciso:n-1)+wv(ns_ciso+1:n))
    Dvmean(n)           = zero

    Dvbetamean(ns_ciso:n-1) = (Dv(ns_ciso:n-1)*beta(ns_ciso:n-1)*wv(ns_ciso:n-1) &
         + Dv(ns_ciso+1:n)*beta(ns_ciso+1:n)*wv(ns_ciso+1:n))/(wv(ns_ciso:n-1)+wv(ns_ciso+1:n))
    Dvbetamean(n)           = zero

    ! coefficients of tridiagonal matrix
    aa(ns_ciso)     = zero

    aa(ns_ciso+1:n) = qlsig(ns_ciso:n-1)*dcqldca(ns_ciso:n-1) &
         + qvsig(ns_ciso:n-1)*betaqv(ns_ciso:n-1)*dcqvdca(ns_ciso:n-1) &
         + dbetaqv(ns_ciso:n-1)*dcqvdca(ns_ciso:n-1)*Dvmean(ns_ciso:n-1) &
         + Dlmean(ns_ciso:n-1)/deltaz(ns_ciso:n-1) &
         + Dvbetamean(ns_ciso:n-1)/deltaz(ns_ciso:n-1)
    !MC ??? thetasat-thetar
    bb(ns_ciso)       = -(Seff(ns_ciso)+kfreeze(ns_ciso)*Sicesig(ns_ciso)) * &
         thetasat(ns_ciso)*dx(ns_ciso)/sig/dt & !vh! NB thetasat should be (thetasat-thetar)??
         - qevapout*dcevapoutdciso &
         - qlsig(ns_ciso)*dcqldca(ns_ciso) - qvsig(ns_ciso)*betaqv(ns_ciso)*dcqvdca(ns_ciso) &
         - dbetaqv(ns_ciso)*dcqvdca(ns_ciso)*Dvmean(ns_ciso) &
         - Dlmean(ns_ciso)/deltaz(ns_ciso) &
         - Dvbetamean(ns_ciso)/deltaz(ns_ciso) &
         - (qex_ss(ns_ciso))
    bb(ns_ciso+1:n-1) = -(Seff(ns_ciso+1:n-1)+kfreeze(ns_ciso+1:n-1)*Sicesig(ns_ciso+1:n-1)) * &
         thetasat(ns_ciso+1:n-1)*dx(ns_ciso+1:n-1)/sig/dt &
         + qlsig(ns_ciso:n-2)*dcqldcb(ns_ciso:n-2) &
         - qlsig(ns_ciso+1:n-1)*dcqldca(ns_ciso+1:n-1) &
         + qvsig(ns_ciso:n-2)*betaqv(ns_ciso:n-2)*dcqvdcb(ns_ciso:n-2) &
         - qvsig(ns_ciso+1:n-1)*betaqv(ns_ciso+1:n-1)*dcqvdca(ns_ciso+1:n-1) &
         - (Dlmean(ns_ciso:n-2)/deltaz(ns_ciso:n-2) + Dlmean(ns_ciso+1:n-1)/deltaz(ns_ciso+1:n-1)) &
         - (Dvbetamean(ns_ciso:n-2)/deltaz(ns_ciso:n-2) + Dvbetamean(ns_ciso+1:n-1)/deltaz(ns_ciso+1:n-1)) &
         - qex_ss(ns_ciso+1:n-1) &
         + dbetaqv(ns_ciso:n-2)*dcqvdcb(ns_ciso:n-2)*Dvmean(ns_ciso:n-2) &
         - dbetaqv(ns_ciso+1:n-1)*dcqvdca(ns_ciso+1:n-1)*Dvmean(ns_ciso+1:n-1)

    bb(1) = bb(1) - qrunoff

    bb(n) = -(Seff(n)+kfreeze(n)*Sicesig(n)) * &
         thetasat(n)*dx(n)/sig/dt &
         + qlsig(n-1)*dcqldcb(n-1)  +qvsig(n-1)*betaqv(n-1)*dcqvdcb(n-1) &
         + dbetaqv(n-1)*dcqvdcb(n-1) *Dvmean(n-1) &
         - qlsig(n)*dcqldca(n) &
         - Dlmean(n-1)/deltaz(n-1) &
         - Dvbetamean(n-1)/deltaz(n-1) &
         - qex_ss(n)

    cc(ns_ciso:n-1) = -qlsig(ns_ciso:n-1)*dcqldcb(ns_ciso:n-1)  - qvsig(ns_ciso:n-1)*betaqv(ns_ciso:n-1)*dcqvdcb(ns_ciso:n-1) &
         - dbetaqv(ns_ciso:n-1)*dcqvdcb(ns_ciso:n-1)*Dvmean(ns_ciso:n-1) &
         + Dlmean(ns_ciso:n-1)/deltaz(ns_ciso:n-1) &
         + Dvbetamean(ns_ciso:n-1)/deltaz(ns_ciso:n-1)

    cc(n)           = zero

    dd(ns_ciso) = thetasat(ns_ciso)*dx(ns_ciso)/sig/dt* &
         (ciso(ns_ciso)*deltaSeff(ns_ciso) + cisoice(ns_ciso)*deltaSice(ns_ciso) + &
         kfreeze2(ns_ciso)*Sicesig(ns_ciso)) &
         - qprec_snow*cprec_snow/sig - qprec*cprec/sig - qevapin*cevapin/sig + qevapout*cevapout/sig &
         + qlsig(ns_ciso)*cql(ns_ciso)/sig + qvsig(ns_ciso)*betaqv(ns_ciso)*cqv(ns_ciso)/sig &
         + dbetaqv(ns_ciso)*cqv(ns_ciso)*Dvmean(ns_ciso)/sig &
         + Dlmean(ns_ciso)/deltaz(ns_ciso)/sig*(ciso(ns_ciso) - ciso(ns_ciso+1)) &
         + Dvbetamean(ns_ciso)/deltaz(ns_ciso)/sig*(ciso(ns_ciso)-ciso(ns_ciso+1)) &
         + (qex_ss(ns_ciso))*ciso(ns_ciso)/sig

    dd(ns_ciso+1:n-1) = thetasat(ns_ciso+1:n-1)*dx(ns_ciso+1:n-1)/sig/dt* &
         (ciso(ns_ciso+1:n-1)*deltaSeff(ns_ciso+1:n-1) + cisoice(ns_ciso+1:n-1)*deltaSice(ns_ciso+1:n-1) + &
         kfreeze2(ns_ciso+1:n-1)*Sicesig(ns_ciso+1:n-1)) &
         - qlsig(ns_ciso:n-2)*cql(ns_ciso:n-2)/sig &
         - qvsig(ns_ciso:n-2)*betaqv(ns_ciso:n-2)*cqv(ns_ciso:n-2)/sig &
         - dbetaqv(ns_ciso:n-2)*cqv(ns_ciso:n-2)*Dvmean(ns_ciso:n-2)/sig &
         + qlsig(ns_ciso+1:n-1)*cql(ns_ciso+1:n-1)/sig &
         + qvsig(ns_ciso+1:n-1)*betaqv(ns_ciso+1:n-1)*cqv(ns_ciso+1:n-1)/sig &
         + dbetaqv(ns_ciso+1:n-1)*cqv(ns_ciso+1:n-1)*Dvmean(ns_ciso+1:n-1)/sig &
         - Dlmean(ns_ciso:n-2)/deltaz(ns_ciso:n-2)/sig*(ciso(ns_ciso:n-2) - ciso(ns_ciso+1:n-1)) &
         - Dvbetamean(ns_ciso:n-2)/deltaz(ns_ciso:n-2)/sig*(ciso(ns_ciso:n-2) - &
         ciso(ns_ciso+1:n-1)) &
         + Dlmean(ns_ciso+1:n-1)/deltaz(ns_ciso+1:n-1)/sig*(ciso(ns_ciso+1:n-1) - ciso(ns_ciso+2:n)) &
         + Dvbetamean(ns_ciso+1:n-1)/deltaz(ns_ciso+1:n-1)/sig*(ciso(ns_ciso+1:n-1) - &
         ciso(ns_ciso+2:n)) &
         + qex_ss(ns_ciso+1:n-1)*ciso(ns_ciso+1:n-1)/sig

    dd(1) = dd(1) + qrunoff*ciso(1)/sig

    dd(n) = thetasat(n)*dx(n)/sig/dt* &
         (ciso(n)*deltaSeff(n) + cisoice(n)*deltaSice(n) + &
         kfreeze2(n)*Sicesig(n)) &
         - qlsig(n-1)*cql(n-1)/sig &
         - qvsig(n-1)*betaqv(n-1)*cqv(n-1)/sig &
         - dbetaqv(n-1)*cqv(n-1)*Dvmean(n-1)/sig &
         + qlsig(n)*cql(n)/sig &
         - Dlmean(n-1)/deltaz(n-1)/sig*(ciso(n-1) - ciso(n)) &
         - Dvbetamean(n-1)/deltaz(n-1)/sig*(ciso(n-1) - ciso(n)) &
         + qex_ss(n)*ciso(n)/sig

    IF (cali>zero .OR. experiment==7 .OR. experiment==8) THEN
       bb(n) = bb(n) + qlsig(n)*dcqldca(n)
       dd(n) = dd(n) + qlsig(n)*(cali-cql(n))/sig
    ENDIF

    ! print*, 'aa ', aa(ns_ciso)
    ! print*, 'bb ', bb(ns_ciso)
    ! print*, 'cc ', cc(ns_ciso)
    ! print*, 'dd ', dd(ns_ciso)
    CALL tri(ns_ciso,n,aa,bb,cc,dd,dc)
    ! print*, 'After ', bb(ns_ciso) * dc(ns_ciso) + cc(ns_ciso) * dc(ns_ciso+1), dd(ns_ciso), &
    !      bb(ns_ciso) * dc(ns_ciso) + cc(ns_ciso) * dc(ns_ciso+1) - dd(ns_ciso)
    !MC ???
    ! dcice(1:n) = sig*dc(1:n)*kfreeze(1:n) + kfreeze2(1:n)
    dcice(1:n) = dc(1:n)*kfreeze(1:n) + kfreeze2(1:n)
    IF (nsnow.GT.0) THEN
       WHERE ((Sliq(ns_ciso:0).GT.zero).OR.(deltaSliq(ns_ciso:0).GT.zero))  ! solve for change in isotopes in liquid
          ! dcice(ns_ciso:0) = sig*dc(ns_ciso:0)*kfreeze(ns_ciso:0) + kfreeze2(ns_ciso:0)
          dcice(ns_ciso:0) = dc(ns_ciso:0)*kfreeze(ns_ciso:0) + kfreeze2(ns_ciso:0)
       ELSEWHERE  ! solve for change in isotopes in ice
          dcice(ns_ciso:0) = dc(ns_ciso:0)
       endwhere
    ENDIF

    ! check for mass balance
    !  if (ns_ciso == 1) then
    LHS (ns_ciso:n) = thetasat(ns_ciso:n)*dx(ns_ciso:n)/dt*(dc(ns_ciso:n)*Seff(ns_ciso:n) + &
         ciso(ns_ciso:n)*deltaSeff(ns_ciso:n)) + &
         thetasat(ns_ciso:n)*dx(ns_ciso:n)/dt*(dcice(ns_ciso:n)*Sicesig(ns_ciso:n) + &
         cisoice(ns_ciso:n)*deltaSice(ns_ciso:n))

    RHS(ns_ciso+1:n-1) = qlsig(ns_ciso:n-2)*(cql(ns_ciso:n-2) + sig*dc(ns_ciso:n-2)*dcqldca(ns_ciso:n-2) + &
         sig*dc(ns_ciso+1:n-1)*dcqldcb(ns_ciso:n-2)) &
         + qvsig(ns_ciso:n-2)*betaqv(ns_ciso:n-2)*(cqv(ns_ciso:n-2) + sig*dc(ns_ciso:n-2)*dcqvdca(ns_ciso:n-2) &
         + sig*dc(ns_ciso+1:n-1)*dcqvdcb(ns_ciso:n-2)) &
         -qlsig(ns_ciso+1:n-1)*(cql(ns_ciso+1:n-1) + sig*dc(ns_ciso+1:n-1)*dcqldca(ns_ciso+1:n-1) + &
         sig*dc(ns_ciso+2:n)*dcqldcb(ns_ciso+1:n-1) ) &
         - qvsig(ns_ciso+1:n-1)*betaqv(ns_ciso+1:n-1)*(cqv(ns_ciso+1:n-1) + sig*dc(ns_ciso+1:n-1)*dcqvdca(ns_ciso+1:n-1) + &
         sig*dc(ns_ciso+2:n)*dcqvdcb(ns_ciso+1:n-1)) &
         + Dlmean(ns_ciso:n-2)*((ciso(ns_ciso:n-2) + sig*dc(ns_ciso:n-2))- &
         (ciso(ns_ciso+1:n-1)+sig*dc(ns_ciso+1:n-1)))/deltaz(ns_ciso:n-2) &
         - Dlmean(ns_ciso+1:n-1)*((ciso(ns_ciso+1:n-1) + sig*dc(ns_ciso+1:n-1))- &
         (ciso(ns_ciso+2:n)+sig*dc(ns_ciso+2:n)))/deltaz(ns_ciso+1:n-1) &
         + Dvbetamean(ns_ciso:n-2)*((ciso(ns_ciso:n-2) + sig*dc(ns_ciso:n-2)) - &
         (ciso(ns_ciso+1:n-1) &
         + sig*dc(ns_ciso+1:n-1))*beta(ns_ciso+1:n-1))/deltaz(ns_ciso:n-2) &
         - Dvbetamean(ns_ciso+1:n-1)*((ciso(ns_ciso+1:n-1) + sig*dc(ns_ciso+1:n-1)) - &
         (ciso(ns_ciso+2:n) + sig*dc(ns_ciso+2:n)))/deltaz(ns_ciso+1:n-1) &
         - qex_ss(ns_ciso+1:n-1)*(ciso(ns_ciso+1:n-1) + sig*dc(ns_ciso+1:n-1)) &
         + dbetaqv(ns_ciso:n-2)*dcqvdcb(ns_ciso:n-2)*Dvmean(ns_ciso:n-2)*(ciso(ns_ciso:n-2) + sig*dc(ns_ciso:n-2)) &
         - dbetaqv(ns_ciso+1:n-1)*dcqvdcb(ns_ciso+1:n-1)*Dvmean(ns_ciso+1:n-1)*(ciso(ns_ciso+1:n-1) + sig*dc(ns_ciso+1:n-1))

    RHS(ns_ciso) = qprec_snow*cprec_snow + qprec*cprec - qevapout*(cevapout + sig*dc(ns_ciso)*dcevapoutdciso) &
         +qevapin*cevapin &
         -qlsig(ns_ciso)*(cql(ns_ciso) + sig*dc(ns_ciso)*dcqldca(ns_ciso) + sig*dc(ns_ciso+1)*dcqldcb(ns_ciso)) &
         - qvsig(ns_ciso)*betaqv(ns_ciso)*(cqv(ns_ciso) + sig*dc(ns_ciso)*dcqvdca(ns_ciso) + &
         sig*dc(ns_ciso+1)*dcqvdcb(ns_ciso)) &
         - Dlmean(ns_ciso)*((ciso(ns_ciso) + sig*dc(ns_ciso))-(ciso(ns_ciso+1)+sig*dc(ns_ciso+1)))/deltaz(ns_ciso) &
         - Dvbetamean(ns_ciso)*((ciso(ns_ciso) + sig*dc(ns_ciso)) - &
         (ciso(ns_ciso+1) + sig*dc(ns_ciso+1)))/deltaz(ns_ciso) &
         - (qex_ss(ns_ciso))*(ciso(ns_ciso) + sig*dc(ns_ciso)) &
         - dbetaqv(ns_ciso)*dcqvdcb(ns_ciso)*Dvmean(ns_ciso)*(ciso(ns_ciso) + sig*dc(ns_ciso))
    ! print*, 'Ha01 ', thetasat(ns_ciso)*dx(ns_ciso)/dt*(dc(ns_ciso)*Seff(ns_ciso) + &
    !      ciso(ns_ciso)*deltaSeff(ns_ciso)), &
    !      thetasat(ns_ciso)*dx(ns_ciso)/dt*(dcice(ns_ciso)*Sicesig(ns_ciso) + &
    !      (cisoice(ns_ciso:n)+sig*dcice(ns_ciso:n))*deltaSice(ns_ciso:n))
    ! print*, 'Ha02 ', qprec_snow*cprec_snow, &
    !      qprec*cprec, &
    !      qevapout*(cevapout + sig*dc(ns_ciso)*dcevapoutdciso), &
    !      qevapin*cevapin, &
    !      qlsig(ns_ciso)*(cql(ns_ciso) + sig*dc(ns_ciso)*dcqldca(ns_ciso) + sig*dc(ns_ciso+1)*dcqldcb(ns_ciso)), &
    !      qvsig(ns_ciso)*betaqv(ns_ciso)*(cqv(ns_ciso) + sig*dc(ns_ciso)*dcqvdca(ns_ciso) + &
    !      sig*dc(ns_ciso+1)*dcqvdcb(ns_ciso)), &
    !      Dlmean(ns_ciso)*((ciso(ns_ciso) + sig*dc(ns_ciso))-(ciso(ns_ciso+1)+sig*dc(ns_ciso+1)))/deltaz(ns_ciso), &
    !      Dvbetamean(ns_ciso)*((ciso(ns_ciso) + sig*dc(ns_ciso)) - &
    !      (ciso(ns_ciso+1) + sig*dc(ns_ciso+1)))/deltaz(ns_ciso), &
    !      (qex_ss(ns_ciso))*(ciso(ns_ciso) + sig*dc(ns_ciso)), &
    !      dbetaqv(ns_ciso)*dcqvdcb(ns_ciso)*Dvmean(ns_ciso)*(ciso(ns_ciso) + sig*dc(ns_ciso))
    ! print*, 'Ha03 ', qvsig(ns_ciso), betaqv(ns_ciso), cqv(ns_ciso), sig, dc(ns_ciso), dcqvdca(ns_ciso), &
    !      dc(ns_ciso+1), dcqvdcb(ns_ciso)
    ! print*, 'Ha04 ', cqv(ns_ciso), sig*dc(ns_ciso)*dcqvdca(ns_ciso), sig*dc(ns_ciso+1)*dcqvdcb(ns_ciso)


    RHS(1) = RHS(1) -qrunoff*(ciso(1) + sig*dc(1))

    RHS(n) =  qlsig(n-1)*(cql(n-1) + sig*dc(n-1)*dcqldca(n-1) + sig*dc(n)*dcqldcb(n-1)) &
         + qvsig(n-1)*betaqv(n-1)*(cqv(n-1) + sig*dc(n-1)*dcqvdca(n-1) + sig*dc(n)*dcqvdcb(n-1)) &
         -qsig(n)*(ciso(n) + sig*dc(n)) &
         + Dlmean(n-1)*((ciso(n-1) + sig*dc(n-1))-(ciso(n)+sig*dc(n)))/deltaz(n-1) &
         + Dvbetamean(n-1)*((ciso(n-1) + sig*dc(n-1)) - (ciso(n) + sig*dc(n)))/deltaz(n-1) &
         -qex_ss(n)*(ciso(n)+sig*dc(n)) &
         + dbetaqv(n)*dcqvdcb(n)*Dvmean(n)*(ciso(n) + sig*dc(n))

    IF (cali>zero .OR. experiment==7 .OR. experiment==8) THEN
       RHS(n) = RHS(n) - qsig(n) * (cali - (ciso(n)+sig*dc(n)))
    ENDIF

    ! if (any(abs(LHS(ns_ciso:n)-RHS(ns_ciso:n))>tiny(one))) then
    ! if (any(abs(LHS(ns_ciso:n)-RHS(ns_ciso:n))>epsilon(one))) then
    IF (ANY(ABS(LHS(ns_ciso:n)-RHS(ns_ciso:n))>1.e-6_r_2)) THEN
       WRITE(*,*) 'abs(LHS-RHS) ', ABS(LHS(ns_ciso:n)-RHS(ns_ciso:n))
       ii = MAXLOC(ABS(LHS(ns_ciso:n)-RHS(ns_ciso:n)))
       WRITE(*,*) 'Max of abs(LHS-RHS): ', MAXVAL(ABS(LHS(ns_ciso:n)-RHS(ns_ciso:n))), ii
       WRITE(*,*) 'nsnow ', nsnow, irec, ns_ciso
       WRITE(*,*) 'surface ', ciso(ns_ciso), dc(ns_ciso), dcice(ns_ciso)
       WRITE(*,*) 'flux ', cprec_snow, cevapin, cevapout
       WRITE(*,*) 'surface flux ', qv0, ql0, -qevap
       WRITE(*,*) 'layer ', ciso(ii(1)), dc(ii(1)), dcice(ii(1))
       WRITE(*,*) 'cqv', cqv
       WRITE(*,*) 'cql', cql
       WRITE(*,*) 'qprec', qprec, qprec_snow, kfreeze(ns_ciso), kfreeze2(ns_ciso)
       WRITE(*,*) 'qmelt', qmelt, qtransfer, qrunoff, Seff(1)
       WRITE(*,*) 'surface balance ', LHS(ns_ciso), RHS(ns_ciso), qprec_snow*cprec_snow
       WRITE(*,*) 'layer balance ', LHS(ii(1)), RHS(ii(1))
       WRITE(*,*) 'surface sigs ', nsnow_last, deltaSice(ns_ciso), deltaSliq(ns_ciso), cvsig(ns_ciso), deltacv(ns_ciso)
       STOP 2
    ENDIF

    !   endif ! 1==1

    ! isotopic fluxes
    qiso_in    = qprec_snow*cprec_snow + qprec*cprec +qevapin*cevapin
    qiso_out   = qevapout*(cevapout + sig*dc(ns_ciso)*dcevapoutdciso)
    qiso_evap  = qevapout*(cevapout + sig*dc(ns_ciso)*dcevapoutdciso) - qevapin*cevapin
    qiso_trans = SUM(qex_ss(ns_ciso:n)*(ciso(ns_ciso:n)+sig*dc(ns_ciso:n)),1)

    qiso_liq_diff(ns_ciso:n-1) = Dlmean(ns_ciso:n-1)*((ciso(ns_ciso:n-1) + &
         sig*dc(ns_ciso:n-1))-(ciso(ns_ciso+1:n)+sig*dc(ns_ciso+1:n)))/deltaz(ns_ciso:n-1)
    qiso_vap_diff(ns_ciso:n-1) = Dvbetamean(ns_ciso:n-1)*((ciso(ns_ciso:n-1) + sig*dc(ns_ciso:n-1)) &
         - (ciso(ns_ciso+1:n) + sig*dc(ns_ciso+1:n)))/deltaz(ns_ciso :n-1)
    qiso_liq_adv(ns_ciso:n-1)  = qlsig(ns_ciso:n-1)*(cql(ns_ciso:n-1) + sig*dc(ns_ciso:n-1)*dcqldca(ns_ciso:n-1) + &
         sig*dc(ns_ciso+1:n)*dcqldcb(ns_ciso:n-1))
    qiso_liq_adv(n)      = qlsig(n)*(cql(n) + sig*dc(n))
    qiso_vap_adv(ns_ciso:n-1)  = qvsig(ns_ciso:n-1) * betaqv(ns_ciso:n-1) &
         * (cqv(ns_ciso:n-1) + sig*dc(ns_ciso:n-1)*dcqvdca(ns_ciso:n-1) + sig*dc(ns_ciso+1:n)*dcqvdcb(ns_ciso:n-1))
    qiso_vap_adv(n)      = zero

    ciso         = ciso + dc
    cisoice(1:n) = cisoice(1:n) + dcice(1:n)
    IF (nsnow > 0) THEN
       cisoice(ns_ciso:0) = MERGE(cisoice(ns_ciso:0) + dcice(ns_ciso:0), & ! solve for change in isotopes in liquid
            cisoice(ns_ciso:n) + dc(ns_ciso:0), & ! solve for change in isotopes in ice
            (Sliq(ns_ciso:0) > zero) .OR. (deltaSliq(ns_ciso:0) > zero))
    ENDIF

    WRITE(993,*) ciso(ns_ciso), cisos, civa/cva/alphaplus_a

  END SUBROUTINE isotope_vap

  !=============================================================================

END MODULE sli_solve
