get_sfxcpln.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_sfxcpl_n (IM, S, U, W, &
                               HPROGRAM,KI,PRUI,PWIND,PFWSU,PFWSV,PSNET, &
                                PHEAT,PEVAP,PRAIN,PSNOW,PICEFLUX,PFWSM,   &
                                PHEAT_ICE,PEVAP_ICE,PSNET_ICE)  
!     ###################################################################
!
!!****  *GETSFXCPL_n* - routine to get some variables from surfex into
!                       ocean and/or a river routing model when the coupler
!                       is not in SURFEX but in ARPEGE.
!
!                       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                       This routine will be suppress soon.
!                       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme      *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    08/2009
!!    10/2016 B. Decharme : bug surface/groundwater coupling 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
USE modd_surfex_n, ONLY : isba_model_t
USE modd_seaflux_n, ONLY : seaflux_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_watflux_n, ONLY : watflux_t
!
USE modd_surf_par,   ONLY : xundef
!
USE modn_sfx_oasis,  ONLY : lwater
USE modd_sfx_oasis,  ONLY : lcpl_land, lcpl_calving, lcpl_gw, &
                            lcpl_flood, lcpl_sea, lcpl_seaice
!
USE modi_get_sfx_sea
USE modi_get_sfx_land
USE modi_abor1_sfx
USE modi_get_luout
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_get_1d_mask
!
USE modi_get_frac_n
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(isba_model_t), INTENT(INOUT) :: IM
TYPE(seaflux_t), INTENT(INOUT) :: S
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(watflux_t), INTENT(INOUT) :: W
!
 CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM
INTEGER,             INTENT(IN)  :: KI      ! number of points
!
REAL, DIMENSION(KI), INTENT(OUT) :: PRUI
REAL, DIMENSION(KI), INTENT(OUT) :: PWIND
REAL, DIMENSION(KI), INTENT(OUT) :: PFWSU
REAL, DIMENSION(KI), INTENT(OUT) :: PFWSV
REAL, DIMENSION(KI), INTENT(OUT) :: PSNET
REAL, DIMENSION(KI), INTENT(OUT) :: PHEAT
REAL, DIMENSION(KI), INTENT(OUT) :: PEVAP
REAL, DIMENSION(KI), INTENT(OUT) :: PRAIN
REAL, DIMENSION(KI), INTENT(OUT) :: PSNOW
REAL, DIMENSION(KI), INTENT(OUT) :: PICEFLUX
REAL, DIMENSION(KI), INTENT(OUT) :: PFWSM
REAL, DIMENSION(KI), INTENT(OUT) :: PHEAT_ICE
REAL, DIMENSION(KI), INTENT(OUT) :: PEVAP_ICE
REAL, DIMENSION(KI), INTENT(OUT) :: PSNET_ICE
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(KI)   :: ZRUNOFF    ! Cumulated Surface runoff             (kg/m2)
REAL, DIMENSION(KI)   :: ZDRAIN     ! Cumulated Deep drainage              (kg/m2)
REAL, DIMENSION(KI)   :: ZCALVING   ! Cumulated Calving flux               (kg/m2)
REAL, DIMENSION(KI)   :: ZSRCFLOOD  ! Cumulated flood freshwater flux      (kg/m2)
!
REAL, DIMENSION(KI)   :: ZSEA_FWSU  ! Cumulated zonal wind stress       (Pa.s)
REAL, DIMENSION(KI)   :: ZSEA_FWSV  ! Cumulated meridian wind stress    (Pa.s)
REAL, DIMENSION(KI)   :: ZSEA_HEAT  ! Cumulated Non solar net heat flux (J/m2)
REAL, DIMENSION(KI)   :: ZSEA_SNET  ! Cumulated Solar net heat flux     (J/m2)
REAL, DIMENSION(KI)   :: ZSEA_WIND  ! Cumulated 10m wind speed          (m)
REAL, DIMENSION(KI)   :: ZSEA_FWSM  ! Cumulated wind stress             (Pa.s)
REAL, DIMENSION(KI)   :: ZSEA_EVAP  ! Cumulated Evaporation             (kg/m2)
REAL, DIMENSION(KI)   :: ZSEA_RAIN  ! Cumulated Rainfall rate           (kg/m2)
REAL, DIMENSION(KI)   :: ZSEA_SNOW  ! Cumulated Snowfall rate           (kg/m2)
REAL, DIMENSION(KI)   :: ZSEA_WATF  ! Cumulated freshwater flux         (kg/m2)
!
REAL, DIMENSION(KI)   :: ZSEAICE_HEAT ! Cumulated Sea-ice non solar net heat flux (J/m2)
REAL, DIMENSION(KI)   :: ZSEAICE_SNET ! Cumulated Sea-ice solar net heat flux     (J/m2)
REAL, DIMENSION(KI)   :: ZSEAICE_EVAP ! Cumulated Sea-ice sublimation             (kg/m2)
!
INTEGER :: ILU, ILUOUT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('GET_SFXCPL_N',0,zhook_handle)
!
 CALL get_luout(hprogram,iluout)
!
!-------------------------------------------------------------------------------
! Global argument
!
IF(ki/=u%NSIZE_FULL)THEN
  WRITE(iluout,*) 'size of field expected by the coupling :', ki
  WRITE(iluout,*) 'size of field in SURFEX                :', u%NSIZE_FULL
  CALL abor1_sfx('GET_SFXCPL_N: VECTOR SIZE NOT CORRECT FOR COUPLING')
ENDIF
!
!-------------------------------------------------------------------------------
! Get variable over nature tile
!
IF(lcpl_land)THEN
!
! * Init land output fields
!
  zrunoff(:) = xundef
  zdrain(:) = xundef
  zcalving(:) = xundef
  zsrcflood(:) = xundef
!
! * Get land output fields
!       
  CALL get_sfx_land(im%O, im%S, u, &
                    lcpl_gw,lcpl_flood,lcpl_calving,    &
                    zrunoff,zdrain,zcalving,zsrcflood )
!
! * Assign land output fields
!        
  prui(:) = zrunoff(:)+zdrain(:)
  piceflux(:) = zcalving(:)
!
ENDIF
!
!-------------------------------------------------------------------------------
! Get variable over sea and water tiles and for ice
!
IF(lcpl_sea)THEN
!
! * Init sea output fields
!
  zsea_fwsu(:) = xundef
  zsea_fwsv(:) = xundef
  zsea_heat(:) = xundef
  zsea_snet(:) = xundef
  zsea_wind(:) = xundef
  zsea_fwsm(:) = xundef
  zsea_evap(:) = xundef
  zsea_rain(:) = xundef
  zsea_snow(:) = xundef
  zsea_watf(:) = xundef
!
  zseaice_heat(:) = xundef
  zseaice_snet(:) = xundef
  zseaice_evap(:) = xundef
!
! * Get sea output fields
!
  CALL get_sfx_sea(s, u, w, &
                   lcpl_seaice,lwater,                      &
                   zsea_fwsu,zsea_fwsv,zsea_heat,zsea_snet, &
                   zsea_wind,zsea_fwsm,zsea_evap,zsea_rain, &
                   zsea_snow,zsea_watf,                     &
                   zseaice_heat,zseaice_snet,zseaice_evap   )
!
! * Assign sea output fields
!
  pfwsu(:) = zsea_fwsu(:)
  pfwsv(:) = zsea_fwsv(:)
  psnet(:) = zsea_snet(:)
  pheat(:) = zsea_heat(:)
  pevap(:) = zsea_evap(:)
  prain(:) = zsea_rain(:)
  psnow(:) = zsea_snow(:)
  pfwsm(:) = zsea_fwsm(:)
  pheat_ice(:) = zseaice_heat(:)
  pevap_ice(:) = zseaice_evap(:)
  psnet_ice(:) = zseaice_snet(:)
!
ENDIF
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('GET_SFXCPL_N',1,zhook_handle)
!
END SUBROUTINE get_sfxcpl_n