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 (I, 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_n, ONLY : isba_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_t), INTENT(INOUT) :: i
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, jpatch, jj
REAL,    DIMENSION(SIZE(I%XPATCH,1)) :: zsumpatch
REAL,    DIMENSION(SIZE(I%XPATCH,1)) :: zwg_corr, zavg_wgm, zavg_wg, zavg_dg
REAL,    DIMENSION(SIZE(I%XPATCH,1)) :: ztotbv_in_mesh
LOGICAL, DIMENSION(SIZE(I%XPATCH,1)) :: lmodif
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('CONTROL_WATER_BUDGET_TOPD',0,zhook_handle)
!
IF(i%NPATCH/=1) THEN
 zsumpatch(:) = 0.0
 DO jpatch=1,i%NPATCH
   DO jj=1,SIZE(i%XPATCH,1)
      zsumpatch(jj) = zsumpatch(jj) + i%XPATCH(jj,jpatch)
   ENDDO
 ENDDO
zavg_wgm(:)  = 0.
zavg_wg(:)  = 0.
zavg_dg(:)  = 0.
!
  DO jpatch=1,i%NPATCH
     DO jj=1,SIZE(i%XPATCH,1)     
        IF(zsumpatch(jj) > 0..AND.pwgm(jj,jpatch)/=xundef.AND.pwg(jj,jpatch)/=xundef.AND.pdg(jj,jpatch)/=xundef)THEN
!
          zavg_wgm(jj)  = zavg_wgm(jj)  + i%XPATCH(jj,jpatch) * pwgm(jj,jpatch)  * pdg(jj,jpatch) 
          zavg_wg(jj)  = zavg_wg(jj)  + i%XPATCH(jj,jpatch) * pwg(jj,jpatch)  * pdg(jj,jpatch) 
          zavg_dg(jj) = zavg_dg(jj) + i%XPATCH(jj,jpatch) * pdg(jj,jpatch)
!          
       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 jpatch=1,i%NPATCH
 WHERE ((pwg(:,jpatch)/=xundef).AND.(i%XPATCH(:,jpatch)>0.)&
         .AND.(i%XPATCH(:,jpatch)/=xundef).AND.(ztotbv_in_mesh(:)/=0.0))
  pwg(:,jpatch)=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