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 (I, U, &
                               ocpl_gw,ocpl_flood,ocpl_calving,  &
                              prunoff,pdrain,pcalving,precharge, &
                              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
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_isba_n, ONLY : isba_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_t), INTENT(INOUT) :: i
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) :: precharge  ! Cumulated Recharge to groundwater    (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: psrcflood  ! Cumulated freshwater flux            (kg/m2)
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(SIZE(I%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
precharge(:) = xundef
psrcflood(:) = xundef
!
!*       2.0   Get variable over nature
!              ------------------------
!
IF(u%NSIZE_NATURE>0)THEN
!
! * surface runoff
!
  CALL unpack_same_rank(u%NR_NATURE,i%XCPL_RUNOFF(:),prunoff(:),xundef)
  i%XCPL_RUNOFF (:) = 0.0
!
! * deep drainage
!
  CALL unpack_same_rank(u%NR_NATURE,i%XCPL_DRAIN(:),pdrain(:),xundef)
  i%XCPL_DRAIN(:) = 0.0
!
! * Calving flux
!
  IF(ocpl_calving)THEN
    CALL unpack_same_rank(u%NR_NATURE,i%XCPL_ICEFLUX(:),pcalving(:),xundef)
    i%XCPL_ICEFLUX(:) = 0.0
  ELSEIF(i%LGLACIER)THEN
    i%XCPL_DRAIN  (:) = i%XCPL_DRAIN(:) + i%XCPL_ICEFLUX(:)
    i%XCPL_ICEFLUX(:) = 0.0
  ENDIF
!
! * groundwater recharge 
!
  IF(ocpl_gw)THEN
    CALL unpack_same_rank(u%NR_NATURE,i%XCPL_RECHARGE(:),precharge(:),xundef)
    i%XCPL_RECHARGE(:)=0.0
  ENDIF
!
! * floodplain source terms
!
  IF(ocpl_flood)THEN
    zsrcflood(:) = i%XCPL_PFLOOD(:)-i%XCPL_EFLOOD(:)-i%XCPL_IFLOOD(:)
    i%XCPL_PFLOOD(:) = 0.0
    i%XCPL_EFLOOD(:) = 0.0
    i%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