sfx_oasis_read_nam.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_read_nam(HPROGRAM,PTSTEP_SURF,HINIT)
!##################################################################
!
!!****  *SFX_OASIS_READ_NAM* - routine to read the configuration for SFX-OASIS coupling
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    05/2008 
!!    10/2016 B. Decharme : bug surface/groundwater coupling 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modn_sfx_oasis
!
USE modd_sfx_oasis, ONLY : loasis, xruntime,               &
                           lcpl_land, lcpl_gw, lcpl_flood, &
                           lcpl_calving, lcpl_lake,        &
                           lcpl_sea, lcpl_seaice
!
USE mode_pos_surf
!
USE modi_get_luout
USE modi_open_namelist
USE modi_close_namelist
!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=6), INTENT(IN)           :: HPROGRAM    ! program calling surf. schemes
REAL,             INTENT(IN)           :: PTSTEP_SURF ! Surfex time step
 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HINIT       ! choice of fields to initialize
!
!*       0.2   Declarations of local parameter
!              -------------------------------
!
INTEGER,          PARAMETER :: KIN   = 1
INTEGER,          PARAMETER :: KOUT  = 0
 CHARACTER(LEN=5), PARAMETER :: YLAND = 'land'
 CHARACTER(LEN=5), PARAMETER :: YLAKE = 'lake'
 CHARACTER(LEN=5), PARAMETER :: YSEA  = 'ocean'
!
!*       0.3   Declarations of local variables
!              -------------------------------
!
LOGICAL            :: GFOUND         ! Return code when searching namelist
INTEGER            :: ILUOUT         ! Listing id
INTEGER            :: ILUNAM         ! logical unit of namelist file
 CHARACTER(LEN=20)  :: YKEY
 CHARACTER(LEN=50)  :: YCOMMENT
 CHARACTER(LEN=3)   :: YINIT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('SFX_OASIS_READ_NAM',0,zhook_handle)
!
!
!*       0.     Initialize :
!               ------------
!
lcpl_land    = .false.
lcpl_gw      = .false.
lcpl_flood   = .false.
lcpl_calving = .false.
lcpl_lake    = .false.
lcpl_sea     = .false.
lcpl_seaice  = .false.
!
IF(.NOT.loasis)THEN
  IF (lhook) CALL dr_hook('SFX_OASIS_READ_NAM',1,zhook_handle)
  RETURN
ENDIF
!
yinit = 'ALL'
IF(PRESENT(hinit))yinit=hinit
!
 CALL get_luout(hprogram,iluout)
!
!*       1.     Read namelists and check status :
!               --------------------------------
!
 CALL open_namelist(hprogram,ilunam)
!
 CALL posnam(ilunam,'NAM_SFX_LAND_CPL',gfound,iluout)
!
IF (gfound) THEN
   READ(unit=ilunam,nml=nam_sfx_land_cpl)
ELSE
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(iluout,*)'NAM_SFX_LAND_CPL not found : Surfex land not coupled with river routing'
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
!
 CALL posnam(ilunam,'NAM_SFX_SEA_CPL',gfound,iluout)
!
IF (gfound) THEN
   READ(unit=ilunam,nml=nam_sfx_sea_cpl)
ELSE
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(iluout,*)'NAM_SFX_SEA_CPL not found : Surfex sea not coupled with ocean model'
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
!
 CALL posnam(ilunam,'NAM_SFX_LAKE_CPL',gfound,iluout)
!
IF (gfound) THEN
   READ(unit=ilunam,nml=nam_sfx_lake_cpl)
ELSE
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(iluout,*)'NAM_SFX_LAKE_CPL not found : Surfex lake not coupled with ocean model'
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(iluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
!
 CALL close_namelist(hprogram,ilunam)
!
IF(xtstep_cpl_land>0.0)lcpl_land=.true.
IF(xtstep_cpl_lake>0.0)lcpl_lake=.true.
IF(xtstep_cpl_sea >0.0)lcpl_sea =.true.
!
IF(.NOT.lcpl_land.AND..NOT.lcpl_sea)THEN
  CALL abor1_sfx('SFX_OASIS_READ_NAM: OASIS USED BUT NAMELIST NOT FOUND')
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       2.     Check time step consistency
!               ---------------------------
!
IF(yinit/='PRE')THEN
  IF(mod(xruntime,ptstep_surf)/=0.)THEN
    WRITE(iluout,*)'! MOD(XRUNTIME,XTSTEP_SURF)/=0 !!!'     
    WRITE(iluout,*)'! XTSTEP_SURF (model timestep) must be a multiple of $RUNTIME in oasis namcouple !!!'     
    CALL abor1_sfx('SFX_OASIS_READ_NAM: XTSTEP_SURF must be a multiple of $RUNTIME in oasis namcouple !!!')
  ENDIF
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       3.     Check status for Land surface fields 
!               ------------------------------------
!
IF(lcpl_land)THEN
!
  IF(yinit/='PRE')THEN
    IF(mod(xtstep_cpl_land,ptstep_surf)/=0.)THEN
      WRITE(iluout,*)'! MOD(XTSTEP_SURF,XTSTEP_CPL_LAND) /= 0     !'
      WRITE(iluout,*)'XTSTEP_SURF =',ptstep_surf,'XTSTEP_CPL_LAND = ',xtstep_cpl_land
      IF(ptstep_surf>xtstep_cpl_land) &
      WRITE(iluout,*)'! XTSTEP_SURF (model timestep) is superiror to  XTSTEP_CPL_LAND !'         
      CALL abor1_sfx('SFX_OASIS_READ_NAM: XTSTEP_SURF and XTSTEP_CPL_LAND not consistent !!!')
    ENDIF
  ENDIF
!
! Land Output variable
!
  ykey  ='CRUNOFF'
  ycomment='Surface runoff'
  CALL check_field(crunoff,ykey,ycomment,yland,kout)
!
  ykey  ='CDRAIN'
  ycomment='Deep drainage'
  CALL check_field(cdrain,ykey,ycomment,yland,kout)
!
! Particular case due to calving case
!
  IF(len_trim(ccalving)>0)THEN
    lcpl_calving = .true.
  ENDIF
!
  IF(lcpl_calving)THEN
    ykey  ='CCALVING'
    ycomment='Calving flux'
    CALL check_field(ccalving,ykey,ycomment,yland,kout)
  ENDIF
!
! Particular case due to water table depth / surface coupling
!    
  IF(len_trim(cwtd)>0.OR.len_trim(cfwtd)>0)THEN
    lcpl_gw = .true.
  ENDIF
!
  IF(lcpl_gw)THEN
!
!   Input variable
!
    ykey  ='CWTD'
    ycomment='Water table depth'
    CALL check_field(cwtd,ykey,ycomment,yland,kin)
!
    ykey  ='CFWTD'
    ycomment='Fraction of WTD to rise'
    CALL check_field(cfwtd,ykey,ycomment,yland,kin)
!
  ENDIF
!
! Particular case due to floodplains coupling
!    
  IF(len_trim(csrcflood)>0.OR.len_trim(cfflood)>0.OR.len_trim(cpiflood)>0)THEN
    lcpl_flood = .true.
  ENDIF
!
  IF(lcpl_flood)THEN
!
!   Output variable
!
    ykey  ='CSRCFLOOD'
    ycomment='flood freshwater flux'
    CALL check_field(csrcflood,ykey,ycomment,yland,kout)
!
!   Input variable
!
    ykey  ='CFFLOOD'
    ycomment='Flood fraction'
    CALL check_field(cfflood,ykey,ycomment,yland,kin)
!
    ykey  ='CPIFLOOD'
    ycomment='Flood potential infiltration'
    CALL check_field(cpiflood,ykey,ycomment,yland,kin)
!
  ENDIF
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       4.     Check status for Land surface fields 
!               ------------------------------------
!
IF(lcpl_lake)THEN
!
  IF(yinit/='PRE')THEN
    IF(mod(xtstep_cpl_lake,ptstep_surf)/=0.)THEN
      WRITE(iluout,*)'! MOD(XTSTEP_SURF,XTSTEP_CPL_LAKE) /= 0     !'
      WRITE(iluout,*)'XTSTEP_SURF =',ptstep_surf,'XTSTEP_CPL_LAKE = ',xtstep_cpl_lake
      IF(ptstep_surf>xtstep_cpl_lake) &
      WRITE(iluout,*)'! XTSTEP_SURF (model timestep) is superiror to  XTSTEP_CPL_LAKE !'     
      CALL abor1_sfx('SFX_OASIS_READ_NAM: XTSTEP_SURF and XTSTEP_CPL_LAKE not consistent !!!')          
    ENDIF
  ENDIF
!
! Output variables
!
  ykey  ='CLAKE_EVAP'
  ycomment='Evaporation rate'
  CALL check_field(clake_evap,ykey,ycomment,ylake,kout)
!
  ykey  ='CLAKE_RAIN'
  ycomment='Rainfall rate'
  CALL check_field(clake_rain,ykey,ycomment,ylake,kout)
!
  ykey  ='CLAKE_SNOW'
  ycomment='Snowfall rate'
  CALL check_field(clake_snow,ykey,ycomment,ylake,kout)
!
  ykey  ='CLAKE_WATF'
  ycomment='Freshwater flux'
  CALL check_field(clake_watf,ykey,ycomment,ylake,kout)
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       5.     Check status for Sea fields 
!               ---------------------------
!
IF(lcpl_sea)THEN
!
  IF(yinit/='PRE')THEN
    IF(mod(xtstep_cpl_sea,ptstep_surf)/=0.)THEN
      WRITE(iluout,*)'! MOD(XTSTEP_SURF,XTSTEP_CPL_SEA) /= 0     !'
      WRITE(iluout,*)'XTSTEP_SURF =',ptstep_surf,'XTSTEP_CPL_SEA = ',xtstep_cpl_sea
      IF(ptstep_surf>xtstep_cpl_sea) &
      WRITE(iluout,*)'! XTSTEP_SURF (model timestep) is superiror to  XTSTEP_CPL_SEA !'     
      CALL abor1_sfx('SFX_OASIS_READ_NAM: XTSTEP_SURF and XTSTEP_CPL_SEA not consistent !!!')          
    ENDIF
  ENDIF
!
! Sea Output variables
!
  ykey  ='CSEA_FWSU'
  ycomment='zonal wind stress'
  CALL check_field(csea_fwsu,ykey,ycomment,ysea,kout)
!
  ykey  ='CSEA_FWSV'
  ycomment='meridian wind stress'
  CALL check_field(csea_fwsv,ykey,ycomment,ysea,kout)
!
  ykey  ='CSEA_HEAT'
  ycomment='Non solar net heat flux'
  CALL check_field(csea_heat,ykey,ycomment,ysea,kout)
!
  ykey  ='CSEA_SNET'
  ycomment='Solar net heat flux'
  CALL check_field(csea_snet,ykey,ycomment,ysea,kout)
!
  ykey  ='CSEA_WIND'
  ycomment='module of 10m wind speed'
  CALL check_field(csea_wind,ykey,ycomment,ysea,kout)
!
  ykey  ='CSEA_FWSM'
  ycomment='module of wind stress'
  CALL check_field(csea_fwsm,ykey,ycomment,ysea,kout)
!
  ykey  ='CSEA_EVAP'
  ycomment='Evaporation rate'
  CALL check_field(csea_evap,ykey,ycomment,ysea,kout)
!
  ykey  ='CSEA_RAIN'
  ycomment='Rainfall rate'
  CALL check_field(csea_rain,ykey,ycomment,ysea,kout)
!
  ykey  ='CSEA_SNOW'
  ycomment='Snowfall rate'
  CALL check_field(csea_snow,ykey,ycomment,ysea,kout)
!
  ykey  ='CSEA_WATF'
  ycomment='Freshwater flux'
  CALL check_field(csea_watf,ykey,ycomment,ysea,kout)
!
! Sea Input variables
!
  ykey  ='CSEA_SST'
  ycomment='Sea surface temperature'
  CALL check_field(csea_sst,ykey,ycomment,ysea,kin)
!
  ykey  ='CSEA_UCU'
  ycomment='Sea u-current stress'
  CALL check_field(csea_ucu,ykey,ycomment,ysea,kin)
!
  ykey  ='CSEA_VCU'
  ycomment='Sea v-current stress'
  CALL check_field(csea_vcu,ykey,ycomment,ysea,kin)
!
! Sea-ice fluxes
!
  IF(len_trim(cseaice_heat)>0.OR.len_trim(cseaice_snet)>0.OR. &
     len_trim(cseaice_evap)>0.OR.len_trim(cseaice_sit )>0.OR. &
     len_trim(cseaice_cvr )>0.OR.len_trim(cseaice_alb )>0     )THEN
     lcpl_seaice=.true.
  ENDIF
!
  IF(lcpl_seaice)THEN
!
!   Sea-ice Output variables
!
    ykey  ='CSEAICE_HEAT'
    ycomment='Sea-ice non solar net heat flux'
    CALL check_field(cseaice_heat,ykey,ycomment,ysea,kout)
!
    ykey  ='CSEAICE_SNET'
    ycomment='Sea-ice solar net heat flux'
    CALL check_field(cseaice_snet,ykey,ycomment,ysea,kout)
!
    ykey  ='CSEAICE_EVAP'
    ycomment='Sea-ice sublimation'
    CALL check_field(cseaice_evap,ykey,ycomment,ysea,kout)
!
!   Sea-ice Input variables
!
    ykey  ='CSEAICE_SIT'
    ycomment='Sea-ice temperature'
    CALL check_field(cseaice_sit,ykey,ycomment,ysea,kin)
!
    ykey  ='CSEAICE_CVR'
    ycomment='Sea-ice cover'
    CALL check_field(cseaice_cvr,ykey,ycomment,ysea,kin)
!
    ykey  ='CSEAICE_ALB'
    ycomment='Sea-ice albedo'
    CALL check_field(cseaice_alb,ykey,ycomment,ysea,kin)
!
  ENDIF
!  
ENDIF
!
IF (lhook) CALL dr_hook('SFX_OASIS_READ_NAM',1,zhook_handle)
!
!-------------------------------------------------------------------------------
CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE check_field(HFIELD,HKEY,HCOMMENT,HTYP,KID)
!
IMPLICIT NONE
!
 CHARACTER(LEN=*), INTENT(IN) :: HFIELD
 CHARACTER(LEN=*), INTENT(IN) :: HKEY
 CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
 CHARACTER(LEN=*), INTENT(IN) :: HTYP
INTEGER,          INTENT(IN) :: KID
!
 CHARACTER(LEN=20)  :: YWORK
 CHARACTER(LEN=20)  :: YNAMELIST
 CHARACTER(LEN=128) :: YCOMMENT1
 CHARACTER(LEN=128) :: YCOMMENT2
LOGICAL            :: LSTOP
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('SFX_OASIS_READ_NAM:CHECK_FIELD',0,zhook_handle)
!
IF(len_trim(hfield)==0)THEN
!
  IF(kid==0)THEN
    ywork=trim(htyp)//' - SFX'
  ELSE
    ywork='SFX - '//trim(htyp)
  ENDIF
!
  SELECT CASE (htyp)
     CASE(yland)
          ynamelist='NAM_SFX_LAND_CPL'
     CASE(ysea)
          ynamelist='NAM_SFX_SEA_CPL'
     CASE(ylake)
          ynamelist='NAM_SFX_LAKE_CPL'          
     CASE DEFAULT
          CALL abor1_sfx('SFX_OASIS_READ_NAM: TYPE NOT SUPPORTED OR IMPLEMENTD : '//trim(htyp))               
  END SELECT
!
  ycomment1= 'SFX_OASIS_READ_NAM: '//trim(hcomment)//' is not done for '//trim(ywork)//' coupling'
  ycomment2= 'SFX_OASIS_READ_NAM: Namelist key '//trim(hkey)//' is not in '//trim(ynamelist)
!
  WRITE(iluout,*)trim(ycomment1)
  WRITE(iluout,*)trim(ycomment2)
!
! For oceanic coupling do not stop the model if a field from surfex to ocean is
! not  done because many particular case can be used
!
  IF(kid==0.AND.htyp/=yland)THEN
    lstop=.false.
  ELSE
    lstop=.true.
  ENDIF
!
  IF(lstop)THEN
    CALL abor1_sfx(ycomment1)
  ENDIF
!  
ENDIF
!
IF (lhook) CALL dr_hook('SFX_OASIS_READ_NAM:CHECK_FIELD',1,zhook_handle)
!
END SUBROUTINE check_field
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE sfx_oasis_read_nam