dg_dfto3l.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 dg_dfto3l (I, &
                            ki,pdg)
!     ##########################
!
!!
!!    PURPOSE
!!    -------
!      from  AVERAGE_DIAG_MISC_ISBA_n
!     
!!**  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 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(OUT) :: pdg
!      
!*      0.2    declarations of local variables
 INTEGER                         :: jj, jlayer, jpatch ! loop indexes
 INTEGER                         :: idepth 
 INTEGER                         :: ini, inp
 REAL                            :: zwork 
 !
 REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('DG_DFTO3L',0,zhook_handle)
ini=SIZE(i%XPATCH,1)
inp=SIZE(i%XPATCH,2)
!
pdg(:,:)=0.0
!
    DO jpatch=1,inp
!  
      IF (i%NSIZE_NATURE_P(jpatch) == 0 ) cycle
      DO jlayer = 1,i%NGROUND_LAYER
        DO jj=1,ini
          idepth=i%NWG_LAYER(jj,jpatch)
          IF(jlayer<=idepth.AND.idepth/=nundef.AND.i%XPATCH(jj,jpatch)/=xundef)THEN
            !
            pdg(jj,1) = pdg(jj,1) + i%XDG(jj,1,jpatch) * i%XPATCH(jj,jpatch) 
            ! ISBA-FR-DG2 comparable soil wetness index, liquid water and ice contents
            zwork=min(i%XDZG(jj,jlayer,jpatch),max(0.0,i%XDG2(jj,jpatch)-i%XDG(jj,jlayer,jpatch)+i%XDZG(jj,jlayer,jpatch)))
            pdg(jj,2) = pdg(jj,2) + zwork * i%XPATCH(jj,jpatch) 
            !
            ! ISBA-FR-DG3 comparable soil wetness index, liquid water and ice contents
            zwork=min(i%XDZG(jj,jlayer,jpatch),max(0.0,i%XDG(jj,jlayer,jpatch)-i%XDG2(jj,jpatch)))
            pdg(jj,3) = pdg(jj,3) + zwork * i%XPATCH(jj,jpatch) 
            !
          ENDIF
        ENDDO
      ENDDO
!
    ENDDO
    ! 
     pdg(:,3) =  pdg(:,2) + pdg(:,3)
     WHERE (pdg(:,:)==0.0)
             pdg(:,:)=xundef
     ENDWHERE
!
IF (lhook) CALL dr_hook('DG_DFTO3L',1,zhook_handle)

END SUBROUTINE dg_dfto3l