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 (I, 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
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
USE modd_isba_n, ONLY : isba_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_t), INTENT(INOUT) :: i
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)   :: zrecharge  ! Cumulated Recharge to groundwater    (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
  zrecharge(:) = xundef
  zsrcflood(:) = xundef
!
! * Get land output fields
!       
  CALL get_sfx_land(i, u, &
                    lcpl_gw,lcpl_flood,lcpl_calving,    &
                    zrunoff,zdrain,zcalving,zrecharge,  &
                    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