sfx_oasis_define.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_define (IO, U, HPROGRAM,KNPTS,KPARAL)
!###################################################
!
!!****  *SFX_OASIS_DEFINE* - Definitions for exchange of coupling fields
!!
!!    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_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surf_par,  ONLY : nundef
!
USE modn_sfx_oasis
USE modd_sfx_oasis
!
USE modi_get_luout
USE modi_abor1_sfx
USE modi_sfx_oasis_check
!
#ifdef CPLOASIS
USE mod_oasis
#endif
!
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(surf_atm_t), INTENT(INOUT) :: U
!
 CHARACTER(LEN=6),        INTENT(IN) :: HPROGRAM    ! program calling surf. schemes
INTEGER,                 INTENT(IN) :: KNPTS  ! Number of grid point on this proc
INTEGER, DIMENSION(:),   INTENT(IN) :: KPARAL
!
!
!*       0.2   Declarations of local parameter
!              -------------------------------
!
INTEGER, DIMENSION(2), PARAMETER  :: IVAR_NODIMS  = (/1,1/) ! rank and number of bundles in coupling field
!
!
!*       0.3   Declarations of local variables
!              -------------------------------
!
INTEGER, DIMENSION(2)          :: IVAR_SHAPE  ! indexes for the coupling field local dimension
!
INTEGER                        :: IPART_ID ! Local partition ID
INTEGER                        :: IERR     ! Error info
!
INTEGER                        :: ILUOUT, IFLAG
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('SFX_OASIS_DEFINE',0,zhook_handle)
!
!-------------------------------------------------------------------------------
#ifdef CPLOASIS
!-------------------------------------------------------------------------------
!
!
!*       0.     Initialize :
!               ------------
!
 CALL get_luout(hprogram,iluout)
!
 CALL sfx_oasis_check(io, u, iluout)
!
!-------------------------------------------------------------------------------
!
!*       1.     Define parallel partitions:
!               ---------------------------
!
 CALL oasis_def_partition(ipart_id,kparal(:),ierr)
!
IF(ierr/=oasis_ok)THEN
   WRITE(iluout,*)'SFX_OASIS_DEFINE: OASIS def partition problem, err = ',ierr
   CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def partition problem')
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       2.     Coupling fields shape :
!               -----------------------
!
ivar_shape(1)= 1
ivar_shape(2)= knpts
!
!-------------------------------------------------------------------------------
!
!*       3.     Sea variables for Surfex - Oasis coupling :
!               -------------------------------------------
!
IF(lcpl_sea)THEN
!
! Sea output fields
!
  IF(len_trim(csea_fwsu)/=0)THEN
    CALL oasis_def_var(nsea_fwsu_id,csea_fwsu,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea zonal wind stress')
  ELSE
    nsea_fwsu_id=nundef
  ENDIF
!
  IF(len_trim(csea_fwsv)/=0)THEN
    CALL oasis_def_var(nsea_fwsv_id,csea_fwsv,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea meridian wind stress')
  ELSE
    nsea_fwsv_id=nundef
  ENDIF
!
  IF(len_trim(csea_heat)/=0)THEN
    CALL oasis_def_var(nsea_heat_id,csea_heat,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea Non solar net heat flux')
  ELSE
    nsea_heat_id=nundef
  ENDIF
!
  IF(len_trim(csea_snet)/=0)THEN
    CALL oasis_def_var(nsea_snet_id,csea_snet,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea Solar net heat')
  ELSE
    nsea_snet_id=nundef
  ENDIF
!
  IF(len_trim(csea_wind)/=0)THEN
    CALL oasis_def_var(nsea_wind_id,csea_wind,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea 10m wind speed')
  ELSE
    nsea_wind_id=nundef
  ENDIF
!
  IF(len_trim(csea_fwsm)/=0)THEN
    CALL oasis_def_var(nsea_fwsm_id,csea_fwsm,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea wind stress')
  ELSE
    nsea_fwsm_id=nundef
  ENDIF
!
  IF(len_trim(csea_evap)/=0)THEN
    CALL oasis_def_var(nsea_evap_id,csea_evap,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea Evaporation')
  ELSE
    nsea_evap_id=nundef
  ENDIF
!
  IF(len_trim(csea_rain)/=0)THEN
    CALL oasis_def_var(nsea_rain_id,csea_rain,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea Rainfall rate')
  ELSE
    nsea_rain_id=nundef
  ENDIF
!
  IF(len_trim(csea_snow)/=0)THEN
    CALL oasis_def_var(nsea_snow_id,csea_snow,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea Snowfall rate')
  ELSE
    nsea_snow_id=nundef
  ENDIF
!
  IF(len_trim(csea_watf)/=0)THEN
    CALL oasis_def_var(nsea_watf_id,csea_watf,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea freshwater rate')
  ELSE
    nsea_watf_id=nundef
  ENDIF
!
! Sea intput fields
!
  CALL oasis_def_var(nsea_sst_id,csea_sst,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)
  IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for Sea surface temperature')
!
  CALL oasis_def_var(nsea_ucu_id,csea_ucu,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)
  IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for Sea u-current stress')
!
  CALL oasis_def_var(nsea_vcu_id,csea_vcu,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)
  IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for Sea v-current stress')
!
! Particular case due to Sea-ice
!
  IF(lcpl_seaice)THEN
!
!   Output fields
!
    IF(len_trim(cseaice_heat)/=0)THEN
      CALL oasis_def_var(nseaice_heat_id,cseaice_heat,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
      IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for Sea-ice non solar net heat')
    ELSE
      nseaice_heat_id=nundef
    ENDIF
!
    IF(len_trim(cseaice_snet)/=0)THEN
      CALL oasis_def_var(nseaice_snet_id,cseaice_snet,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
      IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for Sea-ice solar net heat flux')
    ELSE
      nseaice_snet_id=nundef
    ENDIF
!
    IF(len_trim(cseaice_evap)/=0)THEN
      CALL oasis_def_var(nseaice_evap_id,cseaice_evap,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
      IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for Sea-ice sublimation')
    ELSE
      nseaice_evap_id=nundef
    ENDIF
!
!   Intput fields
!
    CALL oasis_def_var(nseaice_sit_id,cseaice_sit,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for Sea-ice non solar net heat')
!
    CALL oasis_def_var(nseaice_cvr_id,cseaice_cvr,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for Sea-ice non solar net heat')
!
    CALL oasis_def_var(nseaice_alb_id,cseaice_alb,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for Sea-ice non solar net heat')
!
  ENDIF
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       4.     Lake variables for Surfex - Oasis coupling :
!               -------------------------------------------
!
IF(lcpl_lake)THEN
!
! Output fields
!
  IF(len_trim(clake_evap)/=0)THEN
    CALL oasis_def_var(nlake_evap_id,clake_evap,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for lake Evaporation')
  ELSE
    nlake_evap_id=nundef
  ENDIF
!
  IF(len_trim(clake_rain)/=0)THEN
    CALL oasis_def_var(nlake_rain_id,clake_rain,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for lake Rainfall rate')
  ELSE
    nlake_rain_id=nundef
  ENDIF
!
  IF(len_trim(clake_snow)/=0)THEN
    CALL oasis_def_var(nlake_snow_id,clake_snow,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for lake Snowfall rate')
  ELSE
    nlake_snow_id=nundef
  ENDIF
!
  IF(len_trim(clake_watf)/=0)THEN
    CALL oasis_def_var(nlake_watf_id,clake_watf,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for sea freshwater rate')
  ELSE
    nlake_watf_id=nundef
  ENDIF
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       5.     Land surface variables for Surfex - Oasis coupling :
!               ----------------------------------------------------
!
IF(lcpl_land)THEN
!
! Output Surface runoff
!
  CALL oasis_def_var(nrunoff_id,crunoff,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)
  IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for land Surface runoff')
!
! Output Calving flux
!
  IF(lcpl_calving)THEN
!
!     Output Calving flux
      CALL oasis_def_var(ncalving_id,ccalving,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)  
      IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for land Calving flux')
!
  ENDIF  
!
! Output Deep drainage
!
  CALL oasis_def_var(ndrain_id,cdrain,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)  
  IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for land Deep drainage')
!
! Particular case due to water table depth / surface coupling
!
  IF(lcpl_gw)THEN
!
!     Input Water table depth
      CALL oasis_def_var(nwtd_id,cwtd,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)  
      IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for land Water table depth')
!          
!     Input grid-cell fraction of WTD to rise
      CALL oasis_def_var(nfwtd_id,cfwtd,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)  
      IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for land fraction of WTD to rise')
!   
  ENDIF      
!
! Particular case due to floodplains coupling
!
  IF(lcpl_flood)THEN
!
!   Output Flood precip interception
    CALL oasis_def_var(nsrcflood_id,csrcflood,ipart_id,ivar_nodims,oasis_out,ivar_shape,oasis_double,ierr)  
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for land Floodplains freshwater flux')
!          
!   Input floodplains fraction
    CALL oasis_def_var(nfflood_id,cfflood,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)  
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for land Floodplains fraction')
!          
!   Input floodplains potential infiltration
    CALL oasis_def_var(npiflood_id,cpiflood,ipart_id,ivar_nodims,oasis_in,ivar_shape,oasis_double,ierr)  
    IF(ierr/=oasis_ok) CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS def var problem for land Floodplains potential infiltration')
!    
  ENDIF
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       6.     End of declaration phase:
!               --------------
!
 CALL oasis_enddef(ierr)
!
IF(ierr/=oasis_ok)THEN
   WRITE(iluout,*)'SFX_OASIS_DEFINE: OASIS enddef problem, err = ',ierr
   CALL abor1_sfx('SFX_OASIS_DEFINE: OASIS enddef problem')
ENDIF
!
!-------------------------------------------------------------------------------
#endif
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('SFX_OASIS_DEFINE',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE sfx_oasis_define