sfx_oasis_send.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 sfx_oasis_send(KLUOUT,KI,KDATE,OSEND_LAND,OSEND_LAKE,OSEND_SEA,      &
                          pland_runoff,pland_drain,pland_calving,pland_recharge,&
                          pland_srcflood,                                       &
                          plake_evap,plake_rain,plake_snow,plake_watf,          &
                          psea_fwsu,psea_fwsv,psea_heat,psea_snet,psea_wind,    &
                          psea_fwsm,psea_evap,psea_rain,psea_snow,psea_watf,    &
                          pseaice_heat,pseaice_snet,pseaice_evap                )
!###########################################
!
!!****  *SFX_OASIS_SEND* - Send coupling fields
!!
!!    PURPOSE
!!    -------
!!
!!    Attention : all fields are sent in Pa, m/s, W/m2 or kg/m2/s
!!   
!!
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme   *Meteo France*    
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2013
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modn_sfx_oasis,  ONLY : xtstep_cpl_sea, xtstep_cpl_lake, &
                            xtstep_cpl_land
!                    
USE modd_surf_par,   ONLY : xundef, nundef
!
USE modd_sfx_oasis
!
USE modi_get_luout
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef CPLOASIS
USE mod_oasis
#endif
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
INTEGER,             INTENT(IN) :: kluout
INTEGER,             INTENT(IN) :: ki            ! number of points
INTEGER,             INTENT(IN) :: kdate  ! current coupling time step (s)
LOGICAL,             INTENT(IN) :: osend_land
LOGICAL,             INTENT(IN) :: osend_lake
LOGICAL,             INTENT(IN) :: osend_sea
!
REAL, DIMENSION(KI), INTENT(IN) :: pland_runoff    ! Cumulated Surface runoff             (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: pland_drain     ! Cumulated Deep drainage              (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: pland_calving   ! Cumulated Calving flux               (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: pland_recharge  ! Cumulated Recharge to groundwater    (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: pland_srcflood  ! Cumulated flood freshwater flux      (kg/m2)
!
REAL, DIMENSION(KI), INTENT(IN) :: plake_evap  ! Cumulated Evaporation              (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: plake_rain  ! Cumulated Rainfall rate            (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: plake_snow  ! Cumulated Snowfall rate            (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: plake_watf  ! Cumulated freshwater flux          (kg/m2)
!
REAL, DIMENSION(KI), INTENT(IN) :: psea_fwsu  ! Cumulated zonal wind stress       (Pa.s)
REAL, DIMENSION(KI), INTENT(IN) :: psea_fwsv  ! Cumulated meridian wind stress    (Pa.s)
REAL, DIMENSION(KI), INTENT(IN) :: psea_heat  ! Cumulated Non solar net heat flux (J/m2)
REAL, DIMENSION(KI), INTENT(IN) :: psea_snet  ! Cumulated Solar net heat flux     (J/m2)
REAL, DIMENSION(KI), INTENT(IN) :: psea_wind  ! Cumulated 10m wind speed          (m)
REAL, DIMENSION(KI), INTENT(IN) :: psea_fwsm  ! Cumulated wind stress             (Pa.s)
REAL, DIMENSION(KI), INTENT(IN) :: psea_evap  ! Cumulated Evaporation             (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: psea_rain  ! Cumulated Rainfall rate           (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: psea_snow  ! Cumulated Snowfall rate           (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: psea_watf  ! Cumulated freshwater flux         (kg/m2)
!
REAL, DIMENSION(KI), INTENT(IN) :: pseaice_heat ! Cumulated Sea-ice non solar net heat flux (J/m2)
REAL, DIMENSION(KI), INTENT(IN) :: pseaice_snet ! Cumulated Sea-ice solar net heat flux     (J/m2)
REAL, DIMENSION(KI), INTENT(IN) :: pseaice_evap ! Cumulated Sea-ice sublimation             (kg/m2)
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(KI,1) :: zwrite ! Mean flux send to OASIS (Pa, m/s, W/m2 or kg/m2/s)
!
 CHARACTER(LEN=50)     :: ycomment
INTEGER               :: ierr   ! Error info
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
#ifdef CPLOASIS
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('SFX_OASIS_SEND',0,zhook_handle)
!
!*       1.     Initialize :
!               ------------
!
zwrite(:,:) = xundef
!
!-------------------------------------------------------------------------------
!
!*       2.     Send land fields to OASIS:
!               --------------------------
!
IF(osend_land)THEN
!
! * Send river output fields
!
  ycomment='Surface runoff over land'
  CALL outvar(pland_runoff,xtstep_cpl_land,zwrite(:,1))
  CALL oasis_put(nrunoff_id,kdate,zwrite(:,:),ierr)
  CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
!
  ycomment='Deep drainage over land'
  CALL outvar(pland_drain,xtstep_cpl_land,zwrite(:,1))
  CALL oasis_put(ndrain_id,kdate,zwrite(:,:),ierr)
  CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
!
  IF(lcpl_calving)THEN
    ycomment='calving flux over land'
    CALL outvar(pland_calving,xtstep_cpl_land,zwrite(:,1))
    CALL oasis_put(ncalving_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(lcpl_gw)THEN
    ycomment='groundwater recharge over land'
    CALL outvar(pland_recharge,xtstep_cpl_land,zwrite(:,1))
    CALL oasis_put(nrecharge_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(lcpl_flood)THEN      
    ycomment='flood freshwater flux over land (P-E-I)'
    CALL outvar(pland_srcflood,xtstep_cpl_land,zwrite(:,1))
    CALL oasis_put(nsrcflood_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1)) 
  ENDIF
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       3.     Send lake fields to OASIS :
!               --------------------------
IF(osend_lake)THEN
!
! * Send output fields (in kg/m2/s)
!
  IF(nlake_evap_id/=nundef)THEN
    ycomment='Evaporation over lake'
    CALL outvar(plake_evap,xtstep_cpl_lake,zwrite(:,1))
    CALL oasis_put(nlake_evap_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nlake_rain_id/=nundef)THEN
    ycomment='Rainfall rate over lake'
    CALL outvar(plake_rain,xtstep_cpl_lake,zwrite(:,1))
    CALL oasis_put(nlake_rain_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nlake_snow_id/=nundef)THEN
    ycomment='Snowfall rate over lake'
    CALL outvar(plake_snow,xtstep_cpl_lake,zwrite(:,1))
    CALL oasis_put(nlake_snow_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nlake_watf_id/=nundef)THEN
    ycomment='Freshwater flux over lake (P-E)'
    CALL outvar(plake_watf,xtstep_cpl_lake,zwrite(:,1))
    CALL oasis_put(nlake_watf_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF


ENDIF
!
!-------------------------------------------------------------------------------
!
!*       4.     Send sea fields to OASIS :
!               --------------------------
!
IF(osend_sea)THEN
!
! * Send sea output fields (in Pa, m/s, W/m2 or kg/m2/s)
!
  IF(nsea_fwsu_id/=nundef)THEN
    ycomment='zonal wind stress over sea'
    CALL outvar(psea_fwsu,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_fwsu_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nsea_fwsv_id/=nundef)THEN
    ycomment='meridian wind stress over sea'
    CALL outvar(psea_fwsv,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_fwsv_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nsea_heat_id/=nundef)THEN
    ycomment='Non solar net heat flux over sea'
    CALL outvar(psea_heat,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_heat_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nsea_snet_id/=nundef)THEN
    ycomment='Solar net heat flux over sea'
    CALL outvar(psea_snet,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_snet_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nsea_wind_id/=nundef)THEN
    ycomment='10m wind speed over sea'
    CALL outvar(psea_wind,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_wind_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nsea_fwsm_id/=nundef)THEN
    ycomment='wind stress over sea'
    CALL outvar(psea_fwsm,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_fwsm_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nsea_evap_id/=nundef)THEN
    ycomment='Evaporation over sea'
    CALL outvar(psea_evap,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_evap_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nsea_rain_id/=nundef)THEN
    ycomment='Rainfall rate over sea'
    CALL outvar(psea_rain,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_rain_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nsea_snow_id/=nundef)THEN
    ycomment='Snowfall rate over sea'
    CALL outvar(psea_snow,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_snow_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
  IF(nsea_watf_id/=nundef)THEN
    ycomment='Freshwater flux over sea (P-E)'
    CALL outvar(psea_watf,xtstep_cpl_sea,zwrite(:,1))
    CALL oasis_put(nsea_watf_id,kdate,zwrite(:,:),ierr)
    CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
  ENDIF
!
! * Sea-ice output fields (in W/m2 or kg/m2/s)
!
  IF(lcpl_seaice)THEN
!
    IF(nseaice_heat_id/=nundef)THEN
      ycomment='Sea-ice non solar net heat flux over sea-ice'
      CALL outvar(pseaice_heat,xtstep_cpl_sea,zwrite(:,1))
      CALL oasis_put(nseaice_heat_id,kdate,zwrite(:,:),ierr)
      CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
    ENDIF
!
    IF(nseaice_snet_id/=nundef)THEN
      ycomment='Sea-ice solar net heat flux over sea-ice'
      CALL outvar(pseaice_snet,xtstep_cpl_sea,zwrite(:,1))
      CALL oasis_put(nseaice_snet_id,kdate,zwrite(:,:),ierr)
      CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
    ENDIF
!
    IF(nseaice_evap_id/=nundef)THEN
      ycomment='Sea-ice sublimation over sea-ice'
      CALL outvar(pseaice_evap,xtstep_cpl_sea,zwrite(:,1))
      CALL oasis_put(nseaice_evap_id,kdate,zwrite(:,:),ierr)
      CALL check_sfx_send(kluout,ierr,ycomment,zwrite(:,1))
    ENDIF
!
  ENDIF
!
ENDIF
!
IF (lhook) CALL dr_hook('SFX_OASIS_SEND',1,zhook_handle)
!
!-------------------------------------------------------------------------------
 CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE check_sfx_send(KLUOUT,KERR,HCOMMENT,PWRITE)
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
INTEGER,          INTENT(IN) :: kluout
INTEGER,          INTENT(IN) :: kerr
 CHARACTER(LEN=*), INTENT(IN) :: hcomment
!
REAL, DIMENSION(:), INTENT(OUT):: pwrite
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('SFX_OASIS_SEND:CHECK_SFX_SEND',0,zhook_handle)
!
pwrite(:) = xundef
!
IF (kerr/=oasis_ok.AND.kerr<oasis_sent) THEN
   WRITE(kluout,'(A,I4)')'Return OASIS code from sending '//trim(hcomment)//' : ',kerr
   CALL abor1_sfx('SFX_OASIS_SEND: problem sending '//trim(hcomment))
ENDIF 
!
IF (lhook) CALL dr_hook('SFX_OASIS_SEND:CHECK_SFX_SEND',1,zhook_handle)
!
END SUBROUTINE check_sfx_send
!
!-------------------------------------------------------------------------------
!
SUBROUTINE outvar(PIN,PDIV,PWRITE)
!
IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN) :: pin
REAL,               INTENT(IN) :: pdiv
!
REAL, DIMENSION(:), INTENT(OUT):: pwrite
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('SFX_OASIS_SEND:OUTVAR',0,zhook_handle)
!
WHERE(pin(:)/=xundef)
     pwrite(:)=pin(:)/pdiv
ELSEWHERE
     pwrite(:)=xundef
ENDWHERE
!
IF (lhook) CALL dr_hook('SFX_OASIS_SEND:OUTVAR',1,zhook_handle)
!
END SUBROUTINE outvar
!
!-------------------------------------------------------------------------------
#endif
!-------------------------------------------------------------------------------
!
END SUBROUTINE sfx_oasis_send