diag_cpl_esm_isba.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 diag_cpl_esm_isba (I, &
                                    ptstep,pcpl_drain,pcpl_runoff,pcpl_eflood, &
                                     pcpl_pflood,pcpl_iflood,pcpl_iceflux         )  
!     #####################################################################
!
!!****  *DIAG_CPL_ESM_ISBA*  
!!
!!    PURPOSE
!!    -------
!         
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      B. Decharme           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      B. Decharme    01/16 : Bug with flood budget and add cpl keys
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_n, ONLY : isba_t
!
USE modn_sfx_oasis, ONLY : xtstep_cpl_land
!
USE modd_sfx_oasis,  ONLY : lcpl_flood, lcpl_gw
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(isba_t), INTENT(INOUT) :: i
!
REAL, INTENT(IN)                   :: ptstep
REAL, DIMENSION(:,:), INTENT(IN)   :: pcpl_drain
REAL, DIMENSION(:,:), INTENT(IN)   :: pcpl_runoff
REAL, DIMENSION(:,:), INTENT(IN)   :: pcpl_eflood
REAL, DIMENSION(:,:), INTENT(IN)   :: pcpl_pflood
REAL, DIMENSION(:,:), INTENT(IN)   :: pcpl_iflood
REAL, DIMENSION(:,:), INTENT(IN)   :: pcpl_iceflux
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PCPL_DRAIN,1),SIZE(PCPL_DRAIN,2)) :: zcpl_drain
REAL, DIMENSION(SIZE(PCPL_DRAIN,1),SIZE(PCPL_DRAIN,2)) :: zcpl_recharge
!
REAL, DIMENSION(SIZE(I%XPATCH,1)) :: zsumpatch
REAL, DIMENSION(SIZE(I%XPATCH,1)) :: zbudget
!
INTEGER :: ini,inp
INTEGER :: ji, jpatch ! tile loop counter
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('DIAG_CPL_ESM_ISBA',0,zhook_handle)
!
!* Initialization
!  --------------
!
ini=SIZE(i%XPATCH,1)
inp=SIZE(i%XPATCH,2)
!
zsumpatch(:) = 0.0
DO jpatch=1,inp
  DO ji=1,ini
     zsumpatch(ji) = zsumpatch(ji) + i%XPATCH(ji,jpatch)
  ENDDO
ENDDO
!
zcpl_recharge(:,:) = 0.0
!
IF(i%CISBA/='DIF')THEN
! prevent small negatives values with ISBA-FR
  zcpl_drain(:,:)=max(0.0,pcpl_drain(:,:))
ELSE
  zcpl_drain(:,:)=pcpl_drain(:,:)
ENDIF
!
!* groundwater case
!  ----------------
!
IF(lcpl_gw.AND.i%LWTD)THEN
  DO jpatch=1,inp
    DO ji=1,ini
      IF(i%XGW(ji)>0.0.AND.zsumpatch(ji)>0.0)THEN
        zcpl_recharge(ji,jpatch) = pcpl_drain(ji,jpatch)
        zcpl_drain(ji,jpatch) = 0.0
      ENDIF
    ENDDO
  ENDDO
ENDIF
!
!* update ISBA - RRM coupling variable (kg/m2)
!  -------------------------------------------
!
!kg/m²
DO jpatch=1,inp
  DO ji=1,ini
!  
     IF(zsumpatch(ji)>0.0)THEN
       i%XCPL_DRAIN (ji) = i%XCPL_DRAIN (ji) + ptstep * zcpl_drain(ji,jpatch) * i%XPATCH(ji,jpatch)/zsumpatch(ji) 
       i%XCPL_RUNOFF(ji) = i%XCPL_RUNOFF(ji) + ptstep * pcpl_runoff(ji,jpatch) * i%XPATCH(ji,jpatch)/zsumpatch(ji) 
     ENDIF
!
     IF(i%LGLACIER.AND.zsumpatch(ji)>0.0)THEN
        i%XCPL_ICEFLUX(ji) = i%XCPL_ICEFLUX(ji) + ptstep * pcpl_iceflux(ji,jpatch) * i%XPATCH(ji,jpatch)/zsumpatch(ji)
     ENDIF
!
     IF(lcpl_gw.AND.i%LWTD.AND.zsumpatch(ji)>0.0)THEN
        i%XCPL_RECHARGE(ji) = i%XCPL_RECHARGE(ji) + ptstep * zcpl_recharge(ji,jpatch) * i%XPATCH(ji,jpatch)/zsumpatch(ji)
     ENDIF
!   
     IF(lcpl_flood.AND.i%LFLOOD.AND.zsumpatch(ji)>0.0)THEN
        i%XCPL_EFLOOD  (ji) = i%XCPL_EFLOOD  (ji) + ptstep * pcpl_eflood(ji,jpatch)*i%XPATCH(ji,jpatch)/zsumpatch(ji)
        i%XCPL_PFLOOD  (ji) = i%XCPL_PFLOOD  (ji) + ptstep * pcpl_pflood(ji,jpatch)*i%XPATCH(ji,jpatch)/zsumpatch(ji)
        i%XCPL_IFLOOD  (ji) = i%XCPL_IFLOOD  (ji) + ptstep * pcpl_iflood(ji,jpatch)*i%XPATCH(ji,jpatch)/zsumpatch(ji)
     ENDIF
!    
  ENDDO
ENDDO
!
!* update ISBA Floodplains variable for mass conservation (kg/m2)
!  --------------------------------------------------------------
!
IF(lcpl_flood.AND.i%LFLOOD)THEN
  zbudget(:)=(i%XPIFLOOD(:)*xtstep_cpl_land)+i%XCPL_PFLOOD(:)-i%XCPL_IFLOOD(:)-i%XCPL_EFLOOD(:)
  WHERE(zbudget(:)<=0.0)
        i%XPIFLOOD(:)=0.0
        i%XFFLOOD (:)=0.0
  ENDWHERE
ENDIF
!
IF (lhook) CALL dr_hook('DIAG_CPL_ESM_ISBA',1,zhook_handle)
!
END SUBROUTINE diag_cpl_esm_isba