control_water_budget_topd.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 control_water_budget_topd (IO, S, U, PWGM, PWG, PDG, PMESH_SIZE, PAVG_MESH_SIZE, PWSAT)
!     #####################
!
!!****  *CONTROL_WATER_BUDGET_TOPD*  
!!
!!    PURPOSE
!!    -------
!     To control water budget after topodyn_lat lateral distribution
!     
!         
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    
!!    
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    
!!      
!!    AUTHOR
!!    ------
!!
!!      B. Vincendon *  Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   : Out of COUPL_TOPD in february 2014
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_s_t
!
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surf_par,         ONLY : xundef, nundef
USE modd_coupling_topd,    ONLY : xtotbv_in_mesh
USE modd_isba_par,         ONLY : xwgmin
USE modi_avg_patch_wg
!
USE modi_pack_same_rank
!
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_s_t), INTENT(INOUT) :: S
!
TYPE(surf_atm_t), INTENT(INOUT) :: U
!
REAL, DIMENSION(:,:), INTENT(IN)    :: PWGM
REAL, DIMENSION(:,:), INTENT(INOUT) :: PWG
REAL, DIMENSION(:,:), INTENT(IN)    :: PDG
REAL, DIMENSION(:),   INTENT(IN)    :: PMESH_SIZE
REAL,                 INTENT(IN)    :: PAVG_MESH_SIZE
REAL, DIMENSION(:),   INTENT(IN)    :: PWSAT
!
!
!*      0.2    declarations of local variables
!
!
REAL, DIMENSION(SIZE(PWG,1),3)     :: ZWG_3L, ZWGI_3L, ZDG_3L          
REAL                               :: ZSTOCK_WGM, ZSTOCK_WG
REAL                               :: ZAVG_DGALL, ZCONTROL_WATER_BUDGET_TOPD
REAL                               :: ZTMP, ZTMP2
INTEGER                            :: JMESH, JP, JJ
REAL,    DIMENSION(SIZE(S%XPATCH,1)) :: ZSUMPATCH
REAL,    DIMENSION(SIZE(S%XPATCH,1)) :: ZWG_CORR, ZAVG_WGM, ZAVG_WG, ZAVG_DG
REAL,    DIMENSION(SIZE(S%XPATCH,1)) :: ZTOTBV_IN_MESH
LOGICAL, DIMENSION(SIZE(S%XPATCH,1)) :: LMODIF
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('CONTROL_WATER_BUDGET_TOPD',0,zhook_handle)
!
IF(io%NPATCH/=1) THEN
  !
  zsumpatch(:) = 0.0
  DO jp=1,io%NPATCH
    DO jj=1,SIZE(s%XPATCH,1)
      zsumpatch(jj) = zsumpatch(jj) + s%XPATCH(jj,jp)
    ENDDO
  ENDDO
  zavg_wgm(:)  = 0.
  zavg_wg(:)  = 0.
  zavg_dg(:)  = 0.
  !
  DO jp=1,io%NPATCH
    DO jj=1,SIZE(s%XPATCH,1)     
      IF(zsumpatch(jj) > 0..AND.pwgm(jj,jp)/=xundef.AND.pwg(jj,jp)/=xundef.AND.pdg(jj,jp)/=xundef)THEN
        !
        zavg_wgm(jj) = zavg_wgm(jj) + s%XPATCH(jj,jp) * pwgm(jj,jp) * pdg(jj,jp) 
        zavg_wg(jj) = zavg_wg(jj) + s%XPATCH(jj,jp) * pwg(jj,jp) * pdg(jj,jp) 
        zavg_dg(jj) = zavg_dg(jj) + s%XPATCH(jj,jp) * pdg(jj,jp)
        !          
      ENDIF
    ENDDO
  ENDDO     
  !     
  WHERE (zavg_dg(:)>0.0.AND.zsumpatch(:)>0.)
    zavg_wgm(:) = zavg_wgm(:) / zavg_dg(:)
    zavg_wg(:)  = zavg_wg(:)  / zavg_dg(:)
  ENDWHERE
  !
ELSE
  zavg_wgm(:) = pwgm(:,1)
  zavg_wg(:) = pwg(:,1) 
  zavg_dg(:) = pdg(:,1)
  !
  zsumpatch(:) = 1.0
ENDIF
!
!
zstock_wgm = sum(zavg_wgm(:)*zavg_dg(:)*pmesh_size(:),&
            mask=(zavg_wgm(:)/=xundef.AND.zavg_dg(:)/=xundef.AND.&
                  pmesh_size(:)/=xundef.AND.zsumpatch(:)>0.))    ! water stocked in the ground (m3)
!
zstock_wg  = sum(zavg_wg(:)*zavg_dg(:)*pmesh_size(:),&
            mask=(zavg_wg(:)/=xundef.AND.zavg_dg(:)/=xundef.AND.&
                  pmesh_size(:)/=xundef.AND.zsumpatch(:)>0.))    ! water stocked in the ground (m3)
!
IF ( count(zavg_dg(:)/=xundef.AND.zsumpatch(:)>0.)/=0. )  &
  zavg_dgall = sum(zavg_dg(:),mask=(zavg_dg(:)/=xundef.AND.zsumpatch(:)>0.))&
              / count(zavg_dg(:)/=xundef.AND.zsumpatch(:)>0.)

IF (zavg_dgall/=0.) THEN
  !
  zcontrol_water_budget_topd = ( zstock_wg - zstock_wgm )/ zavg_dgall / pavg_mesh_size
  !
  IF (zcontrol_water_budget_topd==0.0) GOTO 66
  !
  ztmp  = count( zavg_wg(:)/=zavg_wgm(:).AND.zavg_wg(:)/=xundef.AND.zavg_wgm(:)/=xundef.AND.zsumpatch(:)>0. )
  !
  lmodif(:)=.false.

  CALL pack_same_rank(u%NR_NATURE,xtotbv_in_mesh,ztotbv_in_mesh)

  IF (ztmp/=0.) THEN
    WHERE (ztotbv_in_mesh(:)/=0.0.AND.zavg_wgm(:)/=xundef.AND.zavg_wg(:)/=xundef.AND.&
      zavg_wg(:)/=zavg_wgm(:) .AND. zavg_wg(:)>xwgmin+(zcontrol_water_budget_topd/ztmp).AND.&
      zavg_wg(:)<=pwsat(:)+(zcontrol_water_budget_topd/ztmp).AND.zsumpatch(:)>0.)
      lmodif(:)=.true.
    ENDWHERE
    !
    WHERE (lmodif)
      zavg_wg(:) = min(max(zavg_wg(:) - (zcontrol_water_budget_topd/ztmp),xwgmin),pwsat(:))
    ENDWHERE
    ! 
  ENDIF
 !
ENDIF

DO jp=1,io%NPATCH
  WHERE ((pwg(:,jp)/=xundef).AND.(s%XPATCH(:,jp)>0.).AND.(s%XPATCH(:,jp)/=xundef).AND.(ztotbv_in_mesh(:)/=0.0))
    pwg(:,jp)=min(max(zavg_wg(:),xwgmin),pwsat(:))
  ENDWHERE
ENDDO


zstock_wg  = sum(zavg_wg(:)*zavg_dg(:)*pmesh_size(:),&
            mask=(zavg_wg(:)/=xundef.AND.zavg_dg(:)/=xundef.AND.&
                  pmesh_size(:)/=xundef.AND.zsumpatch(:)>0.))    ! water stocked in the ground (m3)


IF (zavg_dgall/=0) THEN
  zcontrol_water_budget_topd = ( zstock_wg - zstock_wgm )/ zavg_dgall / pavg_mesh_size
ENDIF

66 CONTINUE
!
IF (lhook) CALL dr_hook('CONTROL_WATER_BUDGET_TOPD',1,zhook_handle)
!
END SUBROUTINE control_water_budget_topd