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 (IO, NP, 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_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_np_t, isba_p_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_options_t), INTENT(INOUT) :: IO
TYPE(isba_np_t), INTENT(INOUT) :: NP
!
 REAL, DIMENSION(:,:), INTENT(OUT) :: PDG
!      
!*      0.2    declarations of local variables
TYPE(isba_p_t), POINTER :: PK
 INTEGER                         :: JI, JL ! loop indexes
 INTEGER                         :: IDEPTH 
 INTEGER                         :: IMASK, JP
 REAL                            :: ZWORK 
 !
 REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('DG_DFTO3L',0,zhook_handle)
!
pdg(:,:)=0.0
!
DO jp=1,io%NPATCH
  !
  pk => np%AL(jp)
  !
  IF (pk%NSIZE_P == 0 ) cycle
  !
  DO jl = 1,io%NGROUND_LAYER
    !
    DO ji=1,pk%NSIZE_P
      !
      imask = pk%NR_P(ji)
      !
      idepth=pk%NWG_LAYER(ji)
      !
      IF(jl<=idepth.AND.idepth/=nundef.AND.pk%XPATCH(ji)/=xundef)THEN
        !
        pdg(imask,1) = pdg(imask,1) + pk%XDG(ji,1) * pk%XPATCH(ji) 
        ! ISBA-FR-DG2 comparable soil wetness index, liquid water and ice contents
        zwork = min(pk%XDZG(ji,jl),max(0.0,pk%XDG2(ji)-pk%XDG(ji,jl)+pk%XDZG(ji,jl)))
        pdg(imask,2) = pdg(imask,2) + zwork * pk%XPATCH(ji) 
        !
        ! ISBA-FR-DG3 comparable soil wetness index, liquid water and ice contents
        zwork=min(pk%XDZG(ji,jl),max(0.0,pk%XDG(ji,jl)-pk%XDG2(ji)))
        pdg(imask,3) = pdg(imask,3) + zwork * pk%XPATCH(ji) 
        !
      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