topd_to_df.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 topd_to_df (I, &
                             ki,pwg)
!     ##########################
!
!!
!!    PURPOSE
!!    -------
!     This routines updates the soil water content of ISBA DIF afeter TOPODYN
!     lateral distribution  
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    REFERENCE
!!    ---------
!!     
!!    AUTHOR
!!    ------
!!
!!       ELYAZIDI/HEYMES/RISTOR * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original  02/2011 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
!
USE modd_isba_n, ONLY : isba_t
!
USE modd_surf_par,      ONLY : xundef, nundef
USE modd_coupling_topd, ONLY : xtotbv_in_mesh, xfrac_d3
USE modd_isba_par,      ONLY : xwgmin
!
USE yomhook   ,         ONLY : lhook,   dr_hook
USE parkind1  ,         ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments

!
TYPE(isba_t), INTENT(INOUT) :: i
!
 INTEGER, INTENT(IN)              :: ki
 REAL, DIMENSION(:,:), INTENT(IN) :: pwg
!      
!*      0.2    declarations of local variables
REAL                              :: zwork          ! numbers of layers in root and deep zones
INTEGER                           :: idepth
INTEGER                           :: ji, jlayer, jpatch ! loop indexes
REAL(KIND=JPRB)                   :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('TOPD_TO_DF',0,zhook_handle)
!
DO jpatch=1,i%NPATCH

 IF (i%NSIZE_NATURE_P(jpatch) == 0 ) cycle

 DO jlayer = 1,i%NGROUND_LAYER

  DO ji=1,ki

  idepth=i%NWG_LAYER(ji,jpatch)

     IF(jlayer<=idepth.AND.idepth/=nundef.AND.(xtotbv_in_mesh(ji)/=0.0).AND.(xtotbv_in_mesh(ji)/=xundef)) THEN

     ! root layers
      IF (i%XDZG(ji,jlayer,jpatch)/=xundef.AND.i%XDG2(ji,jpatch)/=xundef.AND.i%XDG(ji,jlayer,jpatch)/=xundef)&! 
        zwork=min(i%XDZG(ji,jlayer,jpatch),max(0.0,i%XDG2(ji,jpatch)-i%XDG(ji,jlayer,jpatch)+i%XDZG(ji,jlayer,jpatch)))

      IF ((pwg(ji,2)/=xundef).AND.(zwork>0.).AND.(zwork/=xundef))& 
        i%XWG(ji,jlayer,jpatch)=min(max(pwg(ji,2),xwgmin),i%XWSAT(ji,jlayer)) 

     ! deep layers
     IF ((xfrac_d3(ji)/=0.0).AND.(xfrac_d3(ji)/=xundef)) THEN     

      IF (i%XDZG(ji,jlayer,jpatch)/=xundef.AND.i%XDG2(ji,jpatch)/=xundef.AND.i%XDG(ji,jlayer,jpatch)/=xundef) &
        zwork=min(i%XDZG(ji,jlayer,jpatch),max(0.0,i%XDG(ji,jlayer,jpatch)-i%XDG2(ji,jpatch)))

      IF ((pwg(ji,3)/=xundef).AND.(zwork>0.).AND.(zwork/=xundef)) &! 
        i%XWG(ji,jlayer,jpatch)=min(max(pwg(ji,3),xwgmin),i%XWSAT(ji,jlayer))

     ENDIF

    ENDIF

  ENDDO
 ENDDO
ENDDO
!
IF (lhook) CALL dr_hook('TOPD_TO_DF',1,zhook_handle)

END SUBROUTINE topd_to_df