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 (IO, S, NK, NP, 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
!!      B. Decharme   10/2016  bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_s_t, isba_k_t, isba_p_t, isba_nk_t, isba_np_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_options_t), INTENT(INOUT) :: IO
TYPE(isba_s_t), INTENT(INOUT) :: S
TYPE(isba_nk_t), INTENT(INOUT) :: NK
TYPE(isba_np_t), INTENT(INOUT) :: NP
!
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
!
TYPE(isba_k_t), POINTER :: KK
TYPE(isba_p_t), POINTER :: PK
!
REAL, DIMENSION(SIZE(PCPL_DRAIN,1),SIZE(PCPL_DRAIN,2)) :: ZCPL_DRAIN
!
REAL, DIMENSION(SIZE(S%XPATCH,1)) :: ZSUMPATCH
REAL, DIMENSION(SIZE(S%XPATCH,1)) :: ZBUDGET
!
INTEGER :: INJ, JP, IMASK
INTEGER :: JI ! tile loop counter
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('DIAG_CPL_ESM_ISBA',0,zhook_handle)
!
!* Initialization
!  --------------
!
inj=SIZE(s%XPATCH,1)
!
zsumpatch(:) = 0.0
DO jp=1,io%NPATCH
  DO ji=1,inj
     zsumpatch(ji) = zsumpatch(ji) + s%XPATCH(ji,jp)
  ENDDO
ENDDO
!
IF(io%CISBA/='DIF')THEN
! prevent small negatives values with ISBA-FR
  zcpl_drain(:,:)=max(0.0,pcpl_drain(:,:))
ELSE
  zcpl_drain(:,:)=pcpl_drain(:,:)
ENDIF
!
!* update ISBA - RRM coupling variable (kg/m2)
!  -------------------------------------------
!
!kg/m²
DO jp=1,io%NPATCH
  DO ji=1,inj
!  
     IF(zsumpatch(ji)>0.0)THEN
       s%XCPL_DRAIN (ji) = s%XCPL_DRAIN (ji) + ptstep * zcpl_drain(ji,jp) * s%XPATCH(ji,jp)/zsumpatch(ji) 
       s%XCPL_RUNOFF(ji) = s%XCPL_RUNOFF(ji) + ptstep * pcpl_runoff(ji,jp) * s%XPATCH(ji,jp)/zsumpatch(ji) 
     ENDIF
!
     IF(io%LGLACIER.AND.zsumpatch(ji)>0.0)THEN
        s%XCPL_ICEFLUX(ji) = s%XCPL_ICEFLUX(ji) + ptstep * pcpl_iceflux(ji,jp) * s%XPATCH(ji,jp)/zsumpatch(ji)
     ENDIF
!   
     IF(lcpl_flood.AND.io%LFLOOD.AND.zsumpatch(ji)>0.0)THEN
        s%XCPL_EFLOOD  (ji) = s%XCPL_EFLOOD  (ji) + ptstep * pcpl_eflood(ji,jp)*s%XPATCH(ji,jp)/zsumpatch(ji)
        s%XCPL_PFLOOD  (ji) = s%XCPL_PFLOOD  (ji) + ptstep * pcpl_pflood(ji,jp)*s%XPATCH(ji,jp)/zsumpatch(ji)
        s%XCPL_IFLOOD  (ji) = s%XCPL_IFLOOD  (ji) + ptstep * pcpl_iflood(ji,jp)*s%XPATCH(ji,jp)/zsumpatch(ji)
     ENDIF
!    
  ENDDO
ENDDO
!
!* update ISBA Floodplains variable for mass conservation (kg/m2)
!  --------------------------------------------------------------
!
IF(lcpl_flood.AND.io%LFLOOD)THEN
  zbudget(:) = 0.0
  DO jp = 1,io%NPATCH
    kk => nk%AL(jp)
    pk => np%AL(jp)

    DO ji = 1,pk%NSIZE_P
      imask = pk%NR_P(ji)
      zbudget(imask) = zbudget(imask) + (kk%XPIFLOOD(ji)*xtstep_cpl_land) + &
                       (s%XCPL_PFLOOD(imask)-s%XCPL_IFLOOD(imask)-s%XCPL_EFLOOD(imask))
    ENDDO
  ENDDO

  DO jp = 1,io%NPATCH
    kk => nk%AL(jp)
    pk => np%AL(jp)
  
    DO ji = 1,pk%NSIZE_P
      imask = pk%NR_P(ji)
      IF (zbudget(imask)<=0.) THEN
        kk%XPIFLOOD(ji) = 0.0
        kk%XFFLOOD (ji) = 0.0
      ENDIF
    ENDDO
  ENDDO
ENDIF
!
IF (lhook) CALL dr_hook('DIAG_CPL_ESM_ISBA',1,zhook_handle)
!
END SUBROUTINE diag_cpl_esm_isba