get_sfx_land.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 get_sfx_land (IO, S, U, &
                               OCPL_GW,OCPL_FLOOD,OCPL_CALVING,  &
                               PRUNOFF,PDRAIN,PCALVING,PSRCFLOOD )  
!     ###############################################################################
!
!!****  *GET_SFX_LAND* - routine to get some land surface variables from surfex
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme      *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2013
!!    10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!*       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
!
!
!
USE modi_unpack_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
!
LOGICAL,            INTENT(IN)  :: OCPL_GW     ! groundwater/surface key
LOGICAL,            INTENT(IN)  :: OCPL_FLOOD   ! flood key
LOGICAL,            INTENT(IN)  :: OCPL_CALVING ! calving key
!
REAL, DIMENSION(:), INTENT(OUT) :: PRUNOFF    ! Cumulated Surface runoff             (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PDRAIN     ! Cumulated Deep drainage              (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PCALVING   ! Cumulated Calving flux               (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PSRCFLOOD  ! Cumulated freshwater flux            (kg/m2)
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(SIZE(S%XCPL_PFLOOD)) :: ZSRCFLOOD
!
REAL, DIMENSION(SIZE(PCALVING)) :: ZCALVING
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('GET_SFX_LAND',0,zhook_handle)
!-------------------------------------------------------------------------------
!
!*       1.0   Initialization
!              --------------
!
prunoff(:) = xundef
pdrain(:) = xundef
pcalving(:) = xundef
psrcflood(:) = xundef
!
!*       2.0   Get variable over nature
!              ------------------------
!
IF(u%NSIZE_NATURE>0)THEN
!
! * surface runoff
!
  CALL unpack_same_rank(u%NR_NATURE,s%XCPL_RUNOFF(:),prunoff(:),xundef)
  s%XCPL_RUNOFF (:) = 0.0
!
! * deep drainage
!
  CALL unpack_same_rank(u%NR_NATURE,s%XCPL_DRAIN(:),pdrain(:),xundef)
  s%XCPL_DRAIN(:) = 0.0
!
! * Calving flux
!
  IF(ocpl_calving)THEN
    CALL unpack_same_rank(u%NR_NATURE,s%XCPL_ICEFLUX(:),pcalving(:),xundef)
    s%XCPL_ICEFLUX(:) = 0.0
  ELSEIF(io%LGLACIER)THEN
    s%XCPL_DRAIN  (:) = s%XCPL_DRAIN(:) + s%XCPL_ICEFLUX(:)
    s%XCPL_ICEFLUX(:) = 0.0
  ENDIF
!
! * floodplain source terms
!
  IF(ocpl_flood)THEN
    zsrcflood(:) = s%XCPL_PFLOOD(:)-s%XCPL_EFLOOD(:)-s%XCPL_IFLOOD(:)
    s%XCPL_PFLOOD(:) = 0.0
    s%XCPL_EFLOOD(:) = 0.0
    s%XCPL_IFLOOD(:) = 0.0
    CALL unpack_same_rank(u%NR_NATURE,zsrcflood(:),psrcflood(:),xundef)
  ENDIF
!
ENDIF
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('GET_SFX_LAND',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE get_sfx_land