source: trunk/LMDZ.COMMON/libf/evolution/computeice_table.F90 @ 2831

   SUBROUTINE computeice_table(timelen,ngrid,nslope,nsoil_GCM,nsoil_PEM,tsoil,tsurf,q_co2,q_h2o,ps,ice_table)
    USE comsoil_h, only:  inertiedat, volcapa
    USE vertical_layers_mod, ONLY: ap,bp
    USE comsoil_h_PEM, only: layer_PEM 
    implicit none 


    integer,intent(in) :: timelen,ngrid,nslope,nsoil_PEM,nsoil_GCM
    real,intent(in) :: tsoil(ngrid,nsoil_PEM,nslope,timelen)    ! soil temperature, timeseries [K]
    real,intent(in) :: tsurf(ngrid,nslope,timelen)              ! surface temperature [K]
    real,intent(in) :: q_co2(ngrid,timelen)                     ! MMR tracer co2 [kg/kg]
    real,intent(in) :: q_h2o(ngrid,timelen)                     ! MMR tracer h2o [kg/kg]
    real,intent(in) :: ps(ngrid,timelen)                        ! surface pressure [Pa]
    real,intent(out) :: ice_table(ngrid,nslope)                 ! ice table [m]


    real :: m_h2o = 18.01528E-3
    real :: m_co2 = 44.01E-3  
    real :: m_noco2 = 33.37E-3  
    real :: A,B,z1,z2
    real :: alpha = -6143.7 
    real :: beta = 29.9074


    integer ig, islope,isoil,it
    real,allocatable :: mass_mean(:,:)                            ! mean mass above the surface
    real,allocatable :: zplev_mean(:,:)                           ! pressure above the surface
    real,allocatable :: pvapor(:,:)                               ! partial pressure above the surface

    real,allocatable :: rhovapor(:,:,:)
    real,allocatable :: rhovapor_avg(:,:)                          ! mean vapor_density at the surface yearly averaged

    real :: psv_surf
    real,allocatable :: rho_soil(:,:,:,:)            ! water vapor in the soil
    real,allocatable :: rho_soil_avg(:,:,:)                ! water vapor in the soil yearly averaged

    real,allocatable :: diff_rho(:,:,:)                    ! difference of vapor content



     allocate(rhovapor(ngrid,nslope,timelen))
     allocate(rhovapor_avg(ngrid,nslope))
     allocate(pvapor(ngrid,timelen))

     allocate(mass_mean(ngrid,timelen))
     allocate(zplev_mean(ngrid,timelen))




! 0. Some initializations

      A =(1/m_co2 - 1/m_noco2)
      B=1/m_noco2
! 1. Compute rho surface yearly averaged

!   1.1 Compute the partial pressure of vapor
!a. the molecular mass into the column
     do ig = 1,ngrid
       mass_mean(ig,:) = 1/(A*q_co2(ig,:) +B)
     enddo


! b. pressure level
     do it = 1,timelen
       do ig = 1,ngrid
         zplev_mean(ig,it) = ap(1) + bp(1)*ps(ig,it)
       enddo
     enddo

! c. Vapor pressure
     pvapor(:,:) = mass_mean(:,:)/m_h2o*q_h2o(:,:)*zplev_mean(:,:)
    
     deallocate(mass_mean)
     deallocate(zplev_mean)
  
!    1.2   Check if there is frost at the surface and then compute the density
!    at the surface
     do ig = 1,ngrid
       do islope = 1,nslope
         do it = 1,timelen
           psv_surf = exp(alpha/tsurf(ig,islope,it) +beta)
          if ((isnan(psv_surf)).or.(isnan(pvapor(ig,it)))) then
          write(*,*) 'pb vapor',ig,islope,it
         stop
         endif       
         rhovapor(ig,islope,it) = min(psv_surf,pvapor(ig,it))/tsurf(ig,islope,it)
         enddo
       enddo
     enddo
     deallocate(pvapor)




!    1.3 Density at the surface yearly averaged
     rhovapor_avg(:,:) = SUM(rhovapor(:,:,:),3)/timelen


     deallocate(rhovapor)




! 2. Compute rho soil vapor
   
     allocate(rho_soil_avg(ngrid,nslope,nsoil_PEM))
     allocate(rho_soil(ngrid,nslope,nsoil_PEM,timelen))

     do ig = 1,ngrid
       do islope = 1,nslope
         do isoil = 1,nsoil_PEM
            do it = 1,timelen 
              rho_soil(ig,islope,isoil,it) = exp(alpha/tsoil(ig,isoil,islope,it) +beta)/tsoil(ig,isoil,islope,it)        
             enddo
           enddo
       enddo
     enddo



    rho_soil_avg(:,:,:) = SUM( rho_soil(:,:,:,:),4)/timelen
    deallocate(rho_soil)



! 3. Computing ice table
   
    ice_table (:,:) = -1e4

         allocate(diff_rho(ngrid,nslope,nsoil_PEM))

         do isoil = 1,nsoil_PEM


             diff_rho(:,:,isoil) = rhovapor_avg(:,:) - rho_soil_avg(:,:,isoil)
!             write(*,*) 'diff =',ig,islope,isoil,diff_rho(ig,islope,isoil),rhovapor_avg(ig,islope) ,rho_soil_avg(ig,islope,isoil)
         enddo
    

  deallocate(rhovapor_avg)
      deallocate(rho_soil_avg)







     do ig = 1,ngrid
       do islope = 1,nslope
         if(diff_rho(ig,islope,1) > 0) then
           ice_table(ig,islope) = 0.
         else
           do isoil = 1,nsoil_PEM -1
             if((diff_rho(ig,islope,isoil).lt.0).and.(diff_rho(ig,islope,isoil+1).gt.0.)) then
               z1 = (diff_rho(ig,islope,isoil) - diff_rho(ig,islope,isoil+1))/(layer_PEM(isoil) - layer_PEM(isoil+1))
               z2 = -layer_PEM(isoil+1)*z1 +  diff_rho(ig,islope,isoil+1)
               ice_table(ig,islope) = -z2/z1
               exit
             endif
           enddo
          endif
        enddo
      enddo

    
    deallocate(diff_rho)






!=======================================================================
      RETURN





      END