comput_cold_layers_thick.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
SUBROUTINE comput_cold_layers_thick(PDG,PTG,PALT,PFLT)
!     ###############################################################################
!
!!****  *COMPUT_COLD_LAYERS_THICK* - additional diagnostics for ISBA
!!
!!    PURPOSE
!!    -------
!! Comput active layer (ALT) and frozen layer (FLT) theaknesses 
!! using linear interpolation between two nodes :
!!       ALT = depth to zero centigrade isotherm in permafrost
!!       FLT = depth to zero centigrade isotherm in non-permafrost
!!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     B. Decharme 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/2014
!!
!!------------------------------------------------------------------
!
USE modd_csts,     ONLY : xtt
USE modd_surf_par, ONLY : nundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL, DIMENSION(:,:),  INTENT(IN)  :: pdg           ! soil layer depth
REAL, DIMENSION(:,:),  INTENT(IN)  :: ptg           ! soil temperature
REAL, DIMENSION(:),    INTENT(OUT) :: palt          ! active layer theakness
REAL, DIMENSION(:),    INTENT(OUT) :: pflt          ! frozen layer theakness
!
!*      0.2    declarations of local variables
!
REAL,    DIMENSION(SIZE(PDG,1),SIZE(PDG,2)) :: znode
INTEGER, DIMENSION(SIZE(PDG,1))             :: iup_alt, idown_alt
INTEGER, DIMENSION(SIZE(PDG,1))             :: iup_flt, idown_flt
!
REAL    :: ztg_up, ztg_down
REAL    :: zup, zdown
REAL    :: zalt, zflt, zslope
!
INTEGER :: ji, jl, ini, inl
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('COMPUT_COLD_LAYERS_THICK',0,zhook_handle)
!
ini=SIZE(pdg,1)
inl=SIZE(pdg,2)
!
iup_alt(:)=0
idown_alt(:)=0
iup_flt(:)=0
idown_flt(:)=0
!
!Surface soil layer
!
znode(:,1)=0.5*pdg(:,1)
WHERE(ptg(:,1)>xtt.AND.ptg(:,2)<=xtt.AND.ptg(:,3)<=xtt)
      iup_alt(:)=1
      idown_alt(:)=2
ENDWHERE
WHERE(ptg(:,1)<xtt.AND.ptg(:,2)>=xtt.AND.ptg(:,3)>=xtt)
      iup_flt(:)=1
      idown_flt(:)=2
ENDWHERE
!
!Middle soil layer
!
DO jl=2,inl-1
   DO ji=1,ini
      znode(ji,jl)=0.5*(pdg(ji,jl)+pdg(ji,jl-1))
      IF(ptg(ji,jl-1)>xtt.AND.ptg(ji,jl)>xtt.AND.ptg(ji,jl+1)<=xtt)THEN
        iup_alt(ji)=jl
        idown_alt(ji)=jl+1
      ENDIF
      IF(ptg(ji,jl-1)<xtt.AND.ptg(ji,jl)<xtt.AND.ptg(ji,jl+1)>=xtt)THEN
        iup_flt(ji)=jl
        idown_flt(ji)=jl+1
      ENDIF      
   ENDDO
ENDDO
!
!Last soil layer
!
znode(:,inl)=0.5*(pdg(:,inl)+pdg(:,inl-1))
WHERE(ptg(:,inl)>xtt)idown_alt(:)=nundef
WHERE(ptg(:,inl)<xtt)idown_flt(:)=nundef
!
DO ji=1,ini
!
   palt(ji)=0.0
   IF(idown_alt(ji)>0.AND.idown_alt(ji)<=inl)THEN
     ztg_up    = ptg(ji,iup_alt(ji))
     ztg_down  = ptg(ji,idown_alt(ji))
     zup       = znode(ji,iup_alt(ji))
     zdown     = znode(ji,idown_alt(ji))
     zslope    = (zup-zdown)/(ztg_up-ztg_down)
     palt(ji)  = zdown+(xtt-ztg_down)*zslope
   ENDIF
!
   pflt(ji)=0.0
   IF(idown_flt(ji)>0.AND.idown_flt(ji)<=inl)THEN
     ztg_up    = ptg(ji,iup_flt(ji))
     ztg_down  = ptg(ji,idown_flt(ji))
     zup       = znode(ji,iup_flt(ji))
     zdown     = znode(ji,idown_flt(ji))
     zslope    = (zup-zdown)/(ztg_up-ztg_down)
     pflt(ji)  = zdown+(xtt-ztg_down)*zslope
   ENDIF
!
ENDDO
!
IF (lhook) CALL dr_hook('COMPUT_COLD_LAYERS_THICK',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE comput_cold_layers_thick