source: trunk/LMDZ.MARS/libf/phymars/soil_tifeedback.F @ 1047

      SUBROUTINE soil_tifeedback(ngrid,nsoil,icecover,newtherm_i)

      use tracer_mod, only: nqmx, igcm_h2o_ice, rho_ice
      use comsoil_h, only: layer, inertiedat
      use surfdat_h, only: watercaptag, inert_h2o_ice
      IMPLICIT NONE

c=======================================================================
c   Description :
c       Surface water ice / Thermal inertia feedback.
c
c   When surface water-ice is thick enough, this routine creates a new
c   soil thermal inertia with three different layers :
c   - One layer of surface water ice (the thickness is given
c     by the variable icecover (in kg of ice per m2) and the thermal
c     inertia is prescribed by inert_h2o_ice (see surfdat_h and inifis)); 
c   - A transitional layer of mixed thermal inertia;
c   - A last layer of regolith below the ice cover whose thermal inertia
c     is equal to inertiedat.
c
c   To use the model :
c       SET THE tifeedback LOGICAL TO ".true." in callphys.def.
c
c   Author: J.-B. Madeleine Mars 2008 - Updated November 2012
c=======================================================================

#include "dimensions.h"
#include "dimphys.h"
!#include "comsoil.h"
!#include "tracer.h"
!#include "surfdat.h"

c Local variables
c ---------------

      INTEGER :: ig                     ! Grid point (ngrid)
      INTEGER :: ik                     ! Grid point (nsoil)
      INTEGER :: iref                   ! Ice/Regolith boundary index
      INTEGER :: ngrid                  ! Number of horizontal grid points 
      INTEGER :: nsoil                  ! Number of soil layers 
      REAL :: icedepth                  ! Ice cover thickness (m)

c Inputs
c ------

      REAL icecover(ngrid,nqmx)         ! tracer on the surface (kg.m-2)
                                        ! (iq=igcm_h2o_ice) is surface
                                        ! water ice
c Outputs
c -------

      REAL newtherm_i(ngrid,nsoil)    ! New soil thermal inertia

c Initialization
c --------------

      newtherm_i(1:ngrid,1:nsoil) = 0

c Creating the new soil thermal inertia table
c -------------------------------------------
      DO ig=1,ngrid
c       Calculating the ice cover thickness
        icedepth=icecover(ig,igcm_h2o_ice)/rho_ice
c       If the ice cover is too thick or watercaptag=true,
c         the entire column is changed :
        IF ((icedepth.ge.layer(nsoil)).or.(watercaptag(ig))) THEN
          DO ik=1,nsoil
               newtherm_i(ig,ik)=inert_h2o_ice
          ENDDO 
c       We neglect the effect of a very thin ice cover :
        ELSE IF (icedepth.lt.layer(1)) THEN
          DO ik=1,nsoil
               newtherm_i(ig,ik)=inertiedat(ig,ik)
          ENDDO 
        ELSE
c         Ice/regolith boundary index :
          iref=1
c         Otherwise, we find the ice/regolith boundary:
          DO ik=1,nsoil-1
              IF ((icedepth.ge.layer(ik)).and.
     &        (icedepth.lt.layer(ik+1))) THEN
                  iref=ik+1
                  EXIT
              ENDIF
          ENDDO
c         And we change the thermal inertia:
          DO ik=1,iref-1
            newtherm_i(ig,ik)=inert_h2o_ice
          ENDDO
c         Transition (based on the equations of thermal conduction):
          newtherm_i(ig,iref)=sqrt( (layer(iref)-layer(iref-1)) /
     &        ( ((icedepth-layer(iref-1))/inert_h2o_ice**2) +
     &        ((layer(iref)-icedepth)/inertiedat(ig,ik)**2) ) )
c         Underlying regolith:
          DO ik=iref+1,nsoil
              newtherm_i(ig,ik)=inertiedat(ig,ik)
          ENDDO
        ENDIF ! icedepth
      ENDDO ! ig

c=======================================================================
      RETURN
      END