dif_layer.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 dif_layer(KLU, KGROUND_LAYER, KPATCH, KSIZE_NATURE_P, &
                     ppatch, pdg, pdroot, pdg2, prootfrac,       &
                     kwg_layer, pdzg, pdzdif, psoilwght,         &
                     prunoffd, klayer_hort, klayer_dun           )  
!#############################################################
!
!!****  *DIF_LAYER_n* - routine to initialize dif numbers of layers
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!    S. Faroux
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    02/2012!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_surf_par,       ONLY : xundef, nundef
USE modd_sgh_par,        ONLY : xhort_depth
!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
INTEGER, INTENT(IN) :: klu
INTEGER, INTENT(IN) :: kground_layer
INTEGER, INTENT(IN) :: kpatch
INTEGER, DIMENSION(:),  INTENT(IN) :: ksize_nature_p
REAL, DIMENSION(:,:),   INTENT(IN) :: ppatch
REAL, DIMENSION(:,:,:), INTENT(IN) :: pdg
REAL, DIMENSION(:,:),   INTENT(IN) :: pdroot
REAL, DIMENSION(:,:),   INTENT(IN) :: pdg2
REAL, DIMENSION(:,:,:), INTENT(IN) :: prootfrac
INTEGER, DIMENSION(:,:),INTENT(IN) :: kwg_layer
REAL, DIMENSION(:,:,:), INTENT(OUT) :: pdzg
REAL, DIMENSION(:,:,:), INTENT(OUT) :: pdzdif
REAL, DIMENSION(:,:,:), INTENT(OUT) :: psoilwght
REAL, DIMENSION(:,:),   INTENT(OUT) :: prunoffd
INTEGER, INTENT(OUT) :: klayer_hort
INTEGER, INTENT(OUT) :: klayer_dun
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(KLU) :: zwork
INTEGER, DIMENSION(KLU,KPATCH) :: iwork
INTEGER :: jlayer, jpatch, jilu, idepth
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!               Initialisation for IO
!
IF (lhook) CALL dr_hook('DIF_LAYER',0,zhook_handle)
!
DO jlayer = 1, kground_layer
  IF (any((prootfrac(:,jlayer,:)<0. .OR. prootfrac(:,jlayer,:)>1.) .AND. ppatch(:,:).NE.0.)) &
    CALL abor1_sfx('DIF_LAYER: WITH CISBA=DIF ROOTFRAC MUST BE DEFINED')
ENDDO
!
pdzg(:,:,:) = xundef
pdzdif(:,:,:) = xundef
psoilwght(:,:,:) = 0.0
!
DO jpatch=1,kpatch
!
  IF (ksize_nature_p(jpatch) == 0 ) cycle
!
!*   soil layers thicknesses
  pdzg(:,1,jpatch) = pdg(:,1,jpatch)
  DO jlayer=2,kground_layer
    DO jilu=1,klu
      pdzg(jilu,jlayer,jpatch) = pdg(jilu,jlayer,jpatch) - pdg(jilu,jlayer-1,jpatch)
    ENDDO
  ENDDO
!
!*   distance between consecuative layer mid-points
  DO jlayer=1,kground_layer
    DO jilu=1,klu
      IF(jlayer<kground_layer)THEN
        pdzdif(jilu,jlayer,jpatch)=0.5*(pdzg(jilu,jlayer,jpatch)+pdzg(jilu,jlayer+1,jpatch))
      ELSE
        pdzdif(jilu,jlayer,jpatch)=0.5*pdzg(jilu,jlayer,jpatch) 
      ENDIF
    ENDDO
  ENDDO 
! 
ENDDO
!
! Horton runoff parameter
!
iwork(:,:) = kwg_layer(:,:)
!
DO jpatch=1,kpatch
!  
  IF( ksize_nature_p(jpatch) == 0 ) cycle
!
  DO jilu=1,klu
    idepth = kwg_layer(jilu,jpatch)
    IF (idepth==nundef) idepth = kground_layer
    DO jlayer=1,idepth-1
      IF(pdg(jilu,jlayer,jpatch)<xhort_depth) iwork(jilu,jpatch)=jlayer+1
    ENDDO
  ENDDO
!
END DO
!  
klayer_hort=maxval(iwork(:,:),iwork(:,:)/=nundef)
!  
! Dunne runoff parameter
!
iwork(:,:)=kwg_layer(:,:)
!
DO jpatch=1,kpatch
!  
  IF (ksize_nature_p(jpatch) == 0 ) cycle
!
  DO jilu=1,klu
    IF(ppatch(jilu,jpatch)>0.0)THEN 
      idepth = kwg_layer(jilu,jpatch)    
      IF(pdroot(jilu,jpatch)>0.0.AND.pdroot(jilu,jpatch)/=xundef)THEN
        prunoffd(jilu,jpatch) = pdg(jilu,1,jpatch)
        DO jlayer=1,idepth-1
          IF(prootfrac(jilu,jlayer,jpatch)<0.90)THEN
            prunoffd(jilu,jpatch) = pdg(jilu,jlayer+1,jpatch)
          ENDIF
        ENDDO
      ELSE
        prunoffd(jilu,jpatch) = min(0.6,pdg2(jilu,jpatch))
      ENDIF
    ENDIF
  ENDDO
!
  zwork(:) = 0.0
  DO jlayer=1,kground_layer
    DO jilu=1,klu
      IF(ppatch(jilu,jpatch)>0.0)THEN
        idepth=kwg_layer(jilu,jpatch)
        IF(jlayer<=idepth)THEN
          zwork(jilu              ) = zwork(jilu) + pdzg(jilu,jlayer,jpatch)  
          psoilwght(jilu,jlayer,jpatch) = min(pdzg(jilu,jlayer,jpatch), &
                                          max(0.0,prunoffd(jilu,jpatch)-zwork(jilu)+pdzg(jilu,jlayer,jpatch)))
        ENDIF
        IF(pdg(jilu,jlayer,jpatch)<prunoffd(jilu,jpatch))THEN
          iwork(jilu,jpatch)=jlayer+1
        ENDIF
      ENDIF
    ENDDO
  ENDDO
!  
END DO
!
klayer_dun=maxval(iwork(:,:),iwork(:,:)/=nundef)
!
IF (lhook) CALL dr_hook('DIF_LAYER',1,zhook_handle)
!
END SUBROUTINE dif_layer