source: trunk/LMDZ.COMMON/libf/evolution/update_soil.F90 @ 2794

   SUBROUTINE update_soil(ngrid,nslope,nsoil_PEM,tend_h2oglaciers,tend_co2glaciers,co2ice,waterice,ps_new,&
                          cellarea,ice_depth,TI_PEM)


 USE comsoil_h, only:  inertiedat, volcapa
 USE comsoil_h_PEM, only: layer_PEM,n_1km,inertiedat_PEM
 USE vertical_layers_mod, ONLY: ap,bp
 implicit none
! Input: 
 INTEGER,INTENT(IN) ::  ngrid, nslope, nsoil_PEM
 REAL,INTENT(IN) :: tend_h2oglaciers(ngrid,nslope),tend_co2glaciers(ngrid,nslope)
 REAL,INTENT(IN) :: ps_new(ngrid)
 REAL,INTENT(IN) :: cellarea(ngrid)
 REAL,INTENT(IN) :: co2ice(ngrid,nslope)
 REAL,INTENT(IN) :: waterice(ngrid,nslope)
 REAL,INTENT(in) :: ice_depth(ngrid,nslope)
 

! Outputs:

 REAL,INTENT(INOUT) :: TI_PEM(ngrid,nsoil_PEM,nslope)
  
! Constants:

 REAL ::  alpha = 0.2
 REAL ::  beta = 1.08e7
 REAL ::  To = 273.15
 REAL ::  R =  8.314
 REAL ::  L =  51058.
 REAL ::  inertie_thresold = 800. ! look for ice
 REAL ::  inertie_co2glaciers = 2120 ! Mellon et al. 2000
 REAL ::  inertie_averaged = 250 ! Mellon et al. 2000
 REAL ::  ice_inertia = 2120  ! Inertia of ice
 REAL ::  surfaceice_inertia = 800  ! Inertia of ice
 REAL ::  P610 = 610.0
 REAL ::  m_h2o = 18.01528E-3
 REAL ::  m_co2 = 44.01E-3  ! CO2 molecular mass (kg/mol)   
 REAL ::  m_noco2 = 33.37E-3  ! Non condensible mol mass (kg/mol)   
 REAL ::  A,B,mmean             

! Local variables:

 INTEGER :: ig,islope,iloop,iref,k
 REAL :: regolith_inertia(ngrid,nslope) ! TI of the regolith 
 REAL :: d(ngrid,nsoil_PEM,nslope)
 REAL :: p_avg_new
 REAL :: Total_surface
 INTEGER :: ispermanent_co2glaciers(ngrid,nslope)
 INTEGER :: ispermanent_h2oglaciers(ngrid,nslope)


! 0. Initialisation




  Total_surface = sum(cellarea)
  p_avg_new = 0.
  do ig = 1,ngrid
    p_avg_new = p_avg_new + ps_new(ig)*cellarea(ig)/Total_surface
  enddo



  do ig = 1,ngrid
    do islope = 1,nslope
     if((abs(tend_h2oglaciers(ig,islope)).lt.1e-5).and.(abs(waterice(ig,islope)).gt.0)) then
        ispermanent_h2oglaciers(ig,islope) = 1
     else
        ispermanent_h2oglaciers(ig,islope) = 0
     endif 

     if((abs(tend_co2glaciers(ig,islope)).lt.1e-5).and.(abs(co2ice(ig,islope)).gt.0)) then
        ispermanent_co2glaciers(ig,islope) = 1
     else
        ispermanent_co2glaciers(ig,islope) = 0
     endif
    enddo

  enddo


 ispermanent_co2glaciers(:,:) = 0
 ispermanent_h2oglaciers(:,:) = 0


!  1.Ice TI feedback

!  do ig=1,ngrid
!    do islope=1,nslope
!      if ((ispermanent_co2glaciers(ig,islope).eq.1).or.(ispermanent_h2oglaciers(ig,islope).eq.1)) then
!       do iloop = 1,n_1km
!         TI_PEM(ig,iloop,islope) = surfaceice_inertia
!       enddo
!      endif
!    enddo
!   enddo
    do islope = 1,nslope
     call soil_TIfeedback_PEM(ngrid,nsoil_PEM,waterice(:,islope),   TI_PEM(:,:,islope))
    enddo

! 2. Modification of the regolith thermal inertia.



  do ig=1,ngrid
    do islope=1,nslope
     do iloop =1,n_1km
       d(ig,iloop,islope) = ((inertiedat_PEM(ig,iloop)*inertiedat_PEM(ig,iloop))/(volcapa*alpha*P610**0.6))**(-1/(0.11*log10(P610/beta)))
   if(TI_PEM(ig,iloop,islope).lt.inertie_thresold) then !           we are modifying the regolith properties, not ice
          TI_PEM(ig,iloop,islope) = sqrt(volcapa*alpha*(p_avg_new**0.6)* d(ig,iloop,islope)**(-0.11*log10(p_avg_new/beta)))

   endif 
     enddo
   enddo
enddo






!  3. Build new TI for the PEM
! a) For the regolith
  do ig=1,ngrid
    do islope=1,nslope

  if (ice_depth(ig,islope).gt. -1.e-10) then
! 3.0 FIrst if permanent ice
   if (ice_depth(ig,islope).lt. 1e-10) then
      do iloop = 1,nsoil_PEM
       TI_PEM(ig,iloop,islope)=max(ice_inertia,inertiedat_PEM(ig,iloop))
      enddo
     else 
      ! 4.1 find the index of the mixed layer
      iref=0 ! initialize iref
      do k=1,nsoil_PEM ! loop on layers
        if (ice_depth(ig,islope).ge.layer_PEM(k)) then
          iref=k ! pure regolith layer up to here
        else
         ! correct iref was obtained in previous cycle
         exit
        endif
       
      enddo



      ! 4.2 Build the new ti
      do iloop=1,iref
         TI_PEM(ig,iloop,islope) =TI_PEM(ig,iloop,islope)
      enddo
      if (iref.lt.nsoil_PEM) then
        if (iref.ne.0) then
          ! mixed layer
           TI_PEM(ig,iref+1,islope)=sqrt((layer_PEM(iref+1)-layer_PEM(iref))/ &
            (((ice_depth(ig,islope)-layer_PEM(iref))/(TI_PEM(ig,iref,islope)**2))+ &
                      ((layer_PEM(iref+1)-ice_depth(ig,islope))/(ice_inertia**2))))
        else ! first layer is already a mixed layer
          ! (ie: take layer(iref=0)=0)
          TI_PEM(ig,1,islope)=sqrt((layer_PEM(1))/ &
                          (((ice_depth(ig,islope))/(TI_PEM(ig,1,islope)**2))+ &
                           ((layer_PEM(1)-ice_depth(ig,islope))/(ice_inertia**2))))
        endif ! of if (iref.ne.0)        
        ! lower layers of pure ice
        do iloop=iref+2,nsoil_PEM
          TI_PEM(ig,iloop,islope)=ice_inertia
        enddo
      endif ! of if (iref.lt.(nsoilmx))
      endif ! permanent glaciers
      endif ! depth > 0
     enddo !islope
    enddo !ig







!=======================================================================
      RETURN
      END