coupling_surf_atmn.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 coupling_surf_atm_n (YSC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH,  &
                                KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2,      &
                                PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV,   &
                                PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS,& 
                                PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, &
                                PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF,     &
                                PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF,       &
                                PPET_B_COEF, PPEQ_B_COEF, HTEST           )
!     #################################################################################
!
!!****  *COUPLING_INLAND_WATER_n * - Driver to call the schemes for the 
!!       four surface types (SEA, WATER, NATURE, TOWN)
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      Modified    09/2011 by S.Queguiner: Add total CO2 surface flux (anthropo+biogenic) as diagnostic
!!      Modified    11/2011 by S.Queguiner: Add total Chemical surface flux (anthropo) as diagnostic
!!      B. Decharme 04/2013 new coupling variables and replace RW_PRECIP_n by CPL_GCM_n
!!      Modified    06/2013 by J.Escobar  : replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
!!      R. Séférian 03/2014 Adding decoupling between CO2 seen by photosynthesis and radiative CO2
!!-------------------------------------------------------------
!
!
USE modd_surfex_n, ONLY : surfex_t
!
USE modd_surf_conf,      ONLY : cprogname
USE modd_surf_par,       ONLY : xundef
USE modd_csts,           ONLY : xp00, xcpd, xrd, xavogadro, xmd
USE modd_co2v_par,       ONLY : xmco2 
USE modd_surf_atm,       ONLY : lcpl_gcm, xco2uncpl
USE modd_data_cover_par, ONLY : ntilesfc
!
!
USE modd_surfex_mpi, ONLY : xtime_sea, xtime_water, xtime_nature, xtime_town
!
USE modi_add_forecast_to_date_surf
USE modi_average_flux
USE modi_average_phy
USE modi_average_rad
USE modi_diag_inline_surf_atm_n
USE modi_ch_emission_flux_n
USE modi_ch_emission_snap_n
USE modi_ch_emission_to_atm_n
USE modi_sso_z0_friction_n
USE modi_sso_be04_friction_n
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
USE modi_coupling_inland_water_n
!
USE modi_coupling_nature_n
!
USE modi_coupling_sea_n
!
USE modi_coupling_town_n
!
USE modi_cpl_gcm_n
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include 'mpif.h'
#endif
!
!*      0.1    declarations of arguments
!
TYPE(surfex_t), INTENT(INOUT) :: YSC
!
 CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
 CHARACTER(LEN=1),    INTENT(IN)  :: HCOUPLING ! type of coupling
                                              ! 'E' : explicit
                                              ! 'I' : implicit
REAL,                INTENT(IN)  :: PTIMEC    ! cumulated time since beginning of simulation
INTEGER,             INTENT(IN)  :: KYEAR     ! current year (UTC)
INTEGER,             INTENT(IN)  :: KMONTH    ! current month (UTC)
INTEGER,             INTENT(IN)  :: KDAY      ! current day (UTC)
REAL,                INTENT(IN)  :: PTIME     ! current time since midnight (UTC, s)
INTEGER,             INTENT(IN)  :: KI        ! number of points
INTEGER,             INTENT(IN)  :: KSV       ! number of scalars
INTEGER,             INTENT(IN)  :: KSW       ! number of short-wave spectral bands
REAL, DIMENSION(KI), INTENT(IN)  :: PTSUN     ! solar time                    (s from midnight)
REAL,                INTENT(IN)  :: PTSTEP    ! atmospheric time-step                 (s)
REAL, DIMENSION(KI), INTENT(IN)  :: PZREF     ! height of T,q forcing                 (m)
REAL, DIMENSION(KI), INTENT(IN)  :: PUREF     ! height of wind forcing                (m)
!
REAL, DIMENSION(KI), INTENT(IN)  :: PTA       ! air temperature forcing               (K)
REAL, DIMENSION(KI), INTENT(IN)  :: PQA       ! air humidity forcing                  (kg/m3)
REAL, DIMENSION(KI), INTENT(IN)  :: PRHOA     ! air density                           (kg/m3)
REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV     ! scalar variables
!                                             ! chemistry:   first char. in HSV: '#'  (molecule/m3)
!                                             !
 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV  ! name of all scalar variables
REAL, DIMENSION(KI), INTENT(IN)  :: PU        ! zonal wind                            (m/s)
REAL, DIMENSION(KI), INTENT(IN)  :: PV        ! meridian wind                         (m/s)
REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct  solar radiation (on horizontal surf.)
!                                             !                                       (W/m2)
REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
!                                             !                                       (W/m2)
REAL, DIMENSION(KSW),INTENT(IN)  :: PSW_BANDS ! mean wavelength of each shortwave band (m)
REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH   ! zenithal angle at t  (radian from the vertical)
REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH2  ! zenithal angle at t+1(radian from the vertical)
REAL, DIMENSION(KI), INTENT(IN)  :: PAZIM     ! azimuthal angle      (radian from North, clockwise)
REAL, DIMENSION(KI), INTENT(IN)  :: PLW       ! longwave radiation (on horizontal surf.)
!                                             !                                       (W/m2)
REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KI), INTENT(IN)  :: PPA       ! pressure at forcing level             (Pa)
REAL, DIMENSION(KI), INTENT(IN)  :: PZS       ! atmospheric model orography           (m)
REAL, DIMENSION(KI), INTENT(IN)  :: PCO2      ! CO2 concentration in the air          (kg/m3)
REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)
REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)
!
!
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFU      ! zonal momentum flux                   (Pa)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFV      ! meridian momentum flux                (Pa)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2    ! flux of CO2                           (m/s*kg_CO2/kg_air)
REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS   ! flux of scalar var.                   (kg/m2/s)
!
REAL, DIMENSION(KI), INTENT(INOUT) :: PTRAD     ! radiative temperature                 (K)
REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB  ! direct albedo for each spectral band  (-)
REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB  ! diffuse albedo for each spectral band (-)
REAL, DIMENSION(KI), INTENT(INOUT) :: PEMIS     ! emissivity                            (-)
!
REAL, DIMENSION(KI), INTENT(OUT)   :: PTSURF    ! surface effective temperature         (K)
REAL, DIMENSION(KI), INTENT(INOUT) :: PZ0       ! roughness length for momentum         (m)
REAL, DIMENSION(KI), INTENT(INOUT) :: PZ0H      ! roughness length for heat             (m)
REAL, DIMENSION(KI), INTENT(INOUT) :: PQSURF    ! specific humidity at surface          (kg/kg)
!
REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
 CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'
!
!
!*      0.2    declarations of local variables
!
INTEGER :: JTILE                        ! loop on type of surface
LOGICAL :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented
INTEGER :: ISWB                         ! number of shortwave spectral bands
!
REAL, DIMENSION(KI)  :: ZPEW_A_COEF ! implicit coefficients
REAL, DIMENSION(KI)  :: ZPEW_B_COEF ! needed if HCOUPLING='I'
REAL, DIMENSION(KI)  :: ZPET_A_COEF
REAL, DIMENSION(KI)  :: ZPEQ_A_COEF
REAL, DIMENSION(KI)  :: ZPET_B_COEF
REAL, DIMENSION(KI)  :: ZPEQ_B_COEF
!
! Tile outputs:
!
REAL, DIMENSION(KI,NTILESFC) :: ZSFTH_TILE     ! surface heat flux (Km/s)
REAL, DIMENSION(KI,NTILESFC) :: ZSFTQ_TILE     ! surface vapor flux (kgm/kg/s)
REAL, DIMENSION(KI,KSV,NTILESFC) :: ZSFTS_TILE ! scalar surface flux
REAL, DIMENSION(KI,NTILESFC) :: ZSFCO2_TILE    ! surface CO2 flux
REAL, DIMENSION(KI,NTILESFC) :: ZSFU_TILE      ! zonal momentum flux
REAL, DIMENSION(KI,NTILESFC) :: ZSFV_TILE      ! meridian momentum flux
REAL, DIMENSION(KI,NTILESFC) :: ZTRAD_TILE     ! radiative surface temperature
REAL, DIMENSION(KI,NTILESFC) :: ZEMIS_TILE     ! emissivity
REAL, DIMENSION(KI,NTILESFC) :: ZFRAC_TILE     ! fraction of each surface type
REAL, DIMENSION(KI,NTILESFC) :: ZTSURF_TILE    ! surface effective temperature
REAL, DIMENSION(KI,NTILESFC) :: ZZ0_TILE       ! roughness length for momentum
REAL, DIMENSION(KI,NTILESFC) :: ZZ0H_TILE      ! roughness length for heat
REAL, DIMENSION(KI,NTILESFC) :: ZQSURF_TILE    ! specific humidity at surface
!
REAL, DIMENSION(KI,KSW,NTILESFC) :: ZDIR_ALB_TILE ! direct albedo
REAL, DIMENSION(KI,KSW,NTILESFC) :: ZSCA_ALB_TILE ! diffuse albedo
!
REAL :: XTIME0
!
INTEGER :: IINDEXEND
INTEGER :: INBTS, JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('COUPLING_SURF_ATM_N',0,zhook_handle)
cprogname=hprogram
!
IF (htest/='OK') THEN
  CALL abor1_sfx('COUPLING_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Time evolution
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
ysc%U%TTIME%TIME = ysc%U%TTIME%TIME + ptstep
 CALL add_forecast_to_date_surf(ysc%U%TTIME%TDATE%YEAR,ysc%U%TTIME%TDATE%MONTH,&
                                ysc%U%TTIME%TDATE%DAY,ysc%U%TTIME%TIME)
!
!-------------------------------------------------------------------------------------
! Preliminaries: Tile related operations
!-------------------------------------------------------------------------------------
! FLAGS for the various surfaces:
!
gsea      = ysc%U%NDIM_SEA    >0
gwater    = ysc%U%NDIM_WATER  >0
gtown     = ysc%U%NDIM_TOWN   >0
gnature   = ysc%U%NDIM_NATURE >0

!
! Tile counter:
!
jtile     = 0 
!
! Number of shortwave spectral bands
!
iswb = SIZE(psw_bands)
!
! Initialization: Outputs to atmosphere over each tile:
!
zsfth_tile(:,:)       = xundef
ztrad_tile(:,:)       = xundef
zdir_alb_tile(:,:,:)  = xundef
zsca_alb_tile(:,:,:)  = xundef
zemis_tile(:,:)       = xundef
zsftq_tile(:,:)       = xundef
zsfts_tile(:,:,:)     = 0.
zsfco2_tile(:,:)      = 0.
zsfu_tile(:,:)        = xundef
zsfv_tile(:,:)        = xundef
ztsurf_tile(:,:)      = xundef
zz0_tile(:,:)         = xundef
zz0h_tile(:,:)        = xundef
zqsurf_tile(:,:)      = xundef
!
! Fractions for each tile:
!
zfrac_tile(:,:)    = 0.0
!
! initialization of implicit coefficients:
!
IF (hcoupling=='I') THEN
  zpew_a_coef = ppew_a_coef
  zpew_b_coef = ppew_b_coef
  zpet_a_coef = ppet_a_coef
  zpeq_a_coef = ppeq_a_coef
  zpet_b_coef = ppet_b_coef
  zpeq_b_coef = ppeq_b_coef
ELSE
  zpew_a_coef = 0.
  zpew_b_coef = sqrt(pu**2+pv**2)
  zpet_a_coef = xundef
  zpet_b_coef = xundef
  zpeq_a_coef = xundef
  zpeq_b_coef = xundef        
END IF
!
!--------------------------------------------------------------------------------------
! Call ALMA interfaces for sea, water, nature and town here...
!--------------------------------------------------------------------------------------
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! SEA Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
! first, pack vector...then call ALMA routine
!
jtile = jtile + 1
!
IF(gsea)THEN
!
  zfrac_tile(:,jtile) = ysc%U%XSEA(:)
!
  CALL treat_surf(jtile,ysc%U%NSIZE_SEA,ysc%U%NR_SEA)
!
ENDIF
!
#ifdef SFX_MPI
xtime_sea = xtime_sea + (mpi_wtime() - xtime0)*100./max(1,ysc%U%NSIZE_SEA)
xtime0 = mpi_wtime()
#endif
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! INLAND WATER Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
jtile = jtile + 1
!
IF(gwater)THEN
!
  zfrac_tile(:,jtile) = ysc%U%XWATER(:)
!
  CALL treat_surf(jtile,ysc%U%NSIZE_WATER,ysc%U%NR_WATER)
!
ENDIF 
!
#ifdef SFX_MPI
xtime_water = xtime_water + (mpi_wtime() - xtime0)*100./max(1,ysc%U%NSIZE_WATER)
xtime0 = mpi_wtime()
#endif
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! NATURAL SURFACE Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
jtile = jtile + 1
!
IF(gnature)THEN
!
  zfrac_tile(:,jtile) = ysc%U%XNATURE(:)
!
  CALL treat_surf(jtile,ysc%U%NSIZE_NATURE,ysc%U%NR_NATURE)
!
ENDIF 
!
#ifdef SFX_MPI
xtime_nature = xtime_nature + (mpi_wtime() - xtime0)*100./max(1,ysc%U%NSIZE_NATURE)
xtime0 = mpi_wtime()
#endif
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! URBAN Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
jtile = jtile + 1
!
IF(gtown)THEN
!
  zfrac_tile(:,jtile) = ysc%U%XTOWN(:)
!
  CALL treat_surf(jtile,ysc%U%NSIZE_TOWN,ysc%U%NR_TOWN)
!
ENDIF 
!
#ifdef SFX_MPI
xtime_town = xtime_town + (mpi_wtime() - xtime0)*100./max(1,ysc%U%NSIZE_TOWN)
#endif
!
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! Grid box average fluxes/properties:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
 CALL average_flux(zfrac_tile, zsfth_tile, zsftq_tile, zsfts_tile, zsfco2_tile, &
                   zsfu_tile, zsfv_tile, psfth, psftq, psfts, psfco2, psfu, psfv )
!
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! Chemical Emissions:                  
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
IF ((ysc%SV%NBEQ > 0).AND.(ysc%CHU%LCH_SURF_EMIS)) THEN
  IF (ysc%CHU%CCH_EMIS=='AGGR') THEN
    IF (ysc%SV%NSV_AEREND < 0)  THEN
      iindexend = ysc%SV%NSV_CHSEND ! case only gas chemistry
    ELSE
      iindexend = ysc%SV%NSV_AEREND ! case aerosol + gas chemistry
    ENDIF
    inbts=0
    DO ji=1,SIZE(ysc%CHE%TSEMISS)
      IF (SIZE(ysc%CHE%TSEMISS(ji)%NETIMES).GT.inbts) inbts=SIZE(ysc%CHE%TSEMISS(ji)%NETIMES)
    ENDDO
    CALL ch_emission_flux_n(ysc%DTCO, ysc%U, ysc%CHE, ysc%SV, ysc%CHU, &
                        hprogram,ptime,psfts(:,ysc%SV%NSV_CHSBEG:iindexend),prhoa,ptstep,inbts)
  ELSE IF (ysc%CHU%CCH_EMIS=='SNAP') THEN
    CALL ch_emission_snap_n(ysc%CHN, hprogram,ysc%U%NSIZE_FULL,ptime,ptsun,kyear,kmonth,kday,prhoa,ysc%UG%G%XLON)
    CALL ch_emission_to_atm_n(ysc%CHN, ysc%SV, psfts,prhoa)
  END IF
END IF
!
WHERE(psfts(:,:)==xundef)  psfts(:,:)=0.
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! CO2 Flux : adds biogenic and anthropogenic emissions
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! CO2 FLUXES  : PSFTS  in molecules/m2/s
!               PSFCO2 in kgCO2/kgair*m/s = *PRHOA kgCO2/m2/s
!               PSFCO2 in kgCO2/m2/s      = *Navogadro*1E3/Mco2(44g/mol) molecules/m2/s
!
DO ji=1,SIZE(psv,2)
  IF(trim(adjustl(ysc%SV%CSV(ji)))=="CO2") THEN
    ! CO2 Flux (Antrop + biog) (molec*m2/s)
    psfts(:,ji) = psfts(:,ji) + psfco2(:)*prhoa(:)*(xavogadro/44.)*1e3
    ! CO2 Flux (Antrop + biog) (kgCO2/kgair*m/s)
    psfco2(:)   = psfts(:,ji)/(prhoa(:)*(xavogadro/44.)*1e3)
  END IF
END DO
!
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! Radiative fluxes
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
 CALL average_rad(zfrac_tile, zdir_alb_tile, zsca_alb_tile, &
                  zemis_tile, ztrad_tile, pdir_alb, psca_alb,&
                  pemis, ptrad)
!
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! Physical properties
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
 CALL average_phy(zfrac_tile, ztsurf_tile, zz0_tile,       &
                  zz0h_tile, zqsurf_tile,                  &    
                  puref, pzref, ptsurf, pz0, pz0h, pqsurf  )
!
! store these field to write in restart file (important for AGCM)
!
IF(lcpl_gcm) CALL cpl_gcm_n(ysc%U, ki,pz0=pz0,pz0h=pz0h,pqsurf=pqsurf)
!
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! Orographic friction
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
!* adds friction due to subscale orography to momentum fluxes
!  but only over continental area
!
IF (ysc%USS%CROUGH=="Z01D" .OR. ysc%USS%CROUGH=="Z04D") THEN
  CALL sso_z0_friction_n(ysc%USS, ysc%U%XSEA,puref,prhoa,pu,pv,zpew_a_coef,zpew_b_coef,psfu,psfv)
ELSE IF (ysc%USS%CROUGH=="BE04") THEN
  CALL sso_be04_friction_n(ysc%SB, ysc%USS, ptstep,ysc%U%XSEA,puref,prhoa,pu,pv,psfu,psfv)
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! Inline diagnostics for full surface
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
 CALL diag_inline_surf_atm_n(ysc%DUO, ysc%DU, &
                             puref, pzref, pps, prhoa, ptrad, pemis, psfu, psfv, psfco2)
!
IF (lhook) CALL dr_hook('COUPLING_SURF_ATM_N',1,zhook_handle)
!
!=======================================================================================
CONTAINS
!=======================================================================================
SUBROUTINE treat_surf(KTILE,KSIZE,KMASK)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN)               :: KTILE
INTEGER, INTENT(IN)               :: KSIZE
INTEGER, INTENT(IN), DIMENSION(KI) :: KMASK
!
REAL, DIMENSION(KSIZE) :: ZP_TSUN     ! solar time                    (s from midnight)
REAL, DIMENSION(KSIZE) :: ZP_ZREF     ! height of T,q forcing                 (m)
REAL, DIMENSION(KSIZE) :: ZP_UREF     ! height of wind forcing                (m)
!
REAL, DIMENSION(KSIZE) :: ZP_TA       ! air temperature forcing               (K)
REAL, DIMENSION(KSIZE) :: ZP_QA       ! air specific humidity forcing         (kg/m3)
REAL, DIMENSION(KSIZE) :: ZP_RHOA     ! air density                           (kg/m3)
REAL, DIMENSION(KSIZE) :: ZP_U        ! zonal wind                            (m/s)
REAL, DIMENSION(KSIZE) :: ZP_V        ! meridian wind                         (m/s)
REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_SW   ! direct  solar radiation (on horizontal surf.)
!                                              !                                       (W/m2)
REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_SW   ! diffuse solar radiation (on horizontal surf.)
!                                              !                                       (W/m2)
REAL, DIMENSION(KSIZE) :: ZP_ZENITH   ! zenithal angle at t  (radian from the vertical)
REAL, DIMENSION(KSIZE) :: ZP_ZENITH2  ! zenithal angle at t+1(radian from the vertical)
REAL, DIMENSION(KSIZE) :: ZP_AZIM     ! azimuthal angle      (radian from North, clockwise)
REAL, DIMENSION(KSIZE) :: ZP_LW       ! longwave radiation (on horizontal surf.)
!                                              !                                       (W/m2)
REAL, DIMENSION(KSIZE) :: ZP_PS       ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KSIZE) :: ZP_PA       ! pressure at forcing level             (Pa)
REAL, DIMENSION(KSIZE) :: ZP_ZS       ! atmospheric model orography           (m)
REAL, DIMENSION(KSIZE) :: ZP_CO2      ! CO2 concentration in the air          (kg/m3)
REAL, DIMENSION(KSIZE,KSV) :: ZP_SV       ! scalar concentration in the air
REAL, DIMENSION(KSIZE) :: ZP_SNOW     ! snow precipitation                    (kg/m2/s)
REAL, DIMENSION(KSIZE) :: ZP_RAIN     ! liquid precipitation                  (kg/m2/s)
!
REAL, DIMENSION(KSIZE) :: ZP_SFTH     ! flux of heat                          (W/m2)
REAL, DIMENSION(KSIZE) :: ZP_SFTQ     ! flux of water vapor                   (kg/m2/s)
REAL, DIMENSION(KSIZE) :: ZP_SFU      ! zonal momentum flux                   (m/s)
REAL, DIMENSION(KSIZE) :: ZP_SFV      ! meridian momentum flux                (m/s)
REAL, DIMENSION(KSIZE) :: ZP_SFCO2    ! flux of CO2                           (kg/m2/s)
REAL, DIMENSION(KSIZE,KSV) :: ZP_SFTS     ! flux of scalar
!
REAL, DIMENSION(KSIZE) :: ZP_TRAD     ! radiative temperature                 (K)
REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_ALB  ! direct albedo for each spectral band  (-)
REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_ALB  ! diffuse albedo for each spectral band (-)
REAL, DIMENSION(KSIZE) :: ZP_EMIS     ! emissivity   
!
REAL, DIMENSION(KSIZE) :: ZP_TSURF    ! surface effective temperature (K)
REAL, DIMENSION(KSIZE) :: ZP_Z0       ! roughness length for momentum (m)
REAL, DIMENSION(KSIZE) :: ZP_Z0H      ! roughness length for heat     (m)
REAL, DIMENSION(KSIZE) :: ZP_QSURF    ! specific humidity at surface  (kg/kg)
!
REAL, DIMENSION(KSIZE) :: ZP_PEW_A_COEF ! implicit coefficients
REAL, DIMENSION(KSIZE) :: ZP_PEW_B_COEF ! needed if HCOUPLING='I'
REAL, DIMENSION(KSIZE) :: ZP_PET_A_COEF
REAL, DIMENSION(KSIZE) :: ZP_PEQ_A_COEF
REAL, DIMENSION(KSIZE) :: ZP_PET_B_COEF
REAL, DIMENSION(KSIZE) :: ZP_PEQ_B_COEF
INTEGER :: JJ, JK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('COUPLING_SURF_ATM_n:TREAT_SURF',0,zhook_handle)
!
!--------------------------------------------------------------------------------------------
!
!cdir nodep
!cdir unroll=8
DO jj=1,ksize
  ji = kmask(jj)
  zp_tsun(jj)       = ptsun(ji)
  zp_zenith(jj)     = pzenith(ji)
  zp_zenith2(jj)    = pzenith2(ji)
  zp_azim(jj)     = pazim(ji)
  zp_zref(jj)       = pzref(ji)
  zp_uref(jj)       = puref(ji)
  zp_u(jj)          = pu(ji)
  zp_v(jj)          = pv(ji)
  zp_qa(jj)         = pqa(ji)
  zp_ta(jj)         = pta(ji)
  zp_rhoa(jj)       = prhoa(ji)
  zp_co2(jj)        = pco2(ji)
  zp_rain(jj)       = prain(ji)
  zp_snow(jj)       = psnow(ji)
  zp_lw(jj)         = plw(ji)
  zp_ps(jj)         = pps(ji)
  zp_pa(jj)         = ppa(ji)
  zp_zs(jj)         = pzs(ji)
ENDDO
!
!consider decoupling between CO2 emploied for photosynthesis and radiative CO2
!recommended as C4MIP option (XCO2UNCPL in ppmv)
IF(xco2uncpl/=xundef)THEN
  zp_co2(:) = zp_rhoa(:) * xco2uncpl * 1.e-6 * xmco2 / xmd   
ENDIF
!
DO jk=1,SIZE(psv,2)
!cdir nodep
!cdir unroll=8
  DO jj=1,ksize
    ji = kmask(jj) 
    zp_sv(jj,jk)       = psv(ji,jk)
  ENDDO
ENDDO
!
DO jk=1,iswb
!cdir nodep
!cdir unroll=8
  DO jj=1,ksize    
    ji = kmask(jj)
    zp_dir_sw(jj,jk)   = pdir_sw(ji,jk)
    zp_sca_sw(jj,jk)   = psca_sw(ji,jk)
  ENDDO
ENDDO  
!
!cdir nodep
!cdir unroll=8
DO jj=1,ksize
  ji = kmask(jj)
  zp_pew_a_coef(jj) = zpew_a_coef(ji)
  zp_pew_b_coef(jj) = zpew_b_coef(ji)
  zp_pet_a_coef(jj) = zpet_a_coef(ji)
  zp_pet_b_coef(jj) = zpet_b_coef(ji)
  zp_peq_a_coef(jj) = zpeq_a_coef(ji)
  zp_peq_b_coef(jj) = zpeq_b_coef(ji)
ENDDO
!
!--------------------------------------------------------------------------------------------
!
IF (ktile==1) THEN
  !
  CALL coupling_sea_n(ysc%SM, ysc%DLO, ysc%DL, ysc%DLC, ysc%U, ysc%NDST%AL(1), ysc%SLT,      &
                      hprogram, hcoupling, ptimec, ptstep, kyear, kmonth, kday, ptime,       &
                      ysc%U%NSIZE_SEA, ksv, ksw,  zp_tsun, zp_zenith, zp_zenith2,zp_azim,    &
                      zp_zref, zp_uref, zp_zs, zp_u, zp_v, zp_qa, zp_ta, zp_rhoa, zp_sv,     &
                      zp_co2, hsv, zp_rain, zp_snow, zp_lw, zp_dir_sw, zp_sca_sw, psw_bands, &
                      zp_ps, zp_pa, zp_sftq, zp_sfth, zp_sfts, zp_sfco2, zp_sfu, zp_sfv,     &
                      zp_trad, zp_dir_alb, zp_sca_alb, zp_emis, zp_tsurf, zp_z0, zp_z0h,     &
                      zp_qsurf, zp_pew_a_coef, zp_pew_b_coef, zp_pet_a_coef, zp_peq_a_coef,  &
                      zp_pet_b_coef, zp_peq_b_coef, 'OK'        )
  !
ELSEIF (ktile==2) THEN
  !
  CALL coupling_inland_water_n(ysc%FM, ysc%WM, ysc%DLO, ysc%DL, ysc%DLC, ysc%U,              &
                               ysc%NDST%AL(1), ysc%SLT, hprogram, hcoupling, ptimec, ptstep, &
                               kyear, kmonth, kday, ptime, ysc%U%NSIZE_WATER, ksv, ksw,      &
                               zp_tsun, zp_zenith, zp_zenith2, zp_azim, zp_zref, zp_uref,    &
                               zp_zs, zp_u, zp_v, zp_qa, zp_ta, zp_rhoa, zp_sv, zp_co2, hsv, &
                               zp_rain, zp_snow, zp_lw, zp_dir_sw, zp_sca_sw, psw_bands,     &
                               zp_ps, zp_pa, zp_sftq, zp_sfth, zp_sfts, zp_sfco2, zp_sfu,    &
                               zp_sfv, zp_trad, zp_dir_alb, zp_sca_alb, zp_emis, zp_tsurf,   &
                               zp_z0, zp_z0h, zp_qsurf, zp_pew_a_coef, zp_pew_b_coef,        &
                               zp_pet_a_coef, zp_peq_a_coef, zp_pet_b_coef, zp_peq_b_coef,   &
                               'OK'                      )
  !
ELSEIF (ktile==3) THEN
  !
  CALL coupling_nature_n(ysc%DTCO, ysc%UG, ysc%U, ysc%USS, ysc%IM, ysc%DTZ, ysc%DLO, ysc%DL, &
                         ysc%DLC, ysc%NDST, ysc%SLT, hprogram, hcoupling, ptimec, ptstep,     &
                         kyear, kmonth, kday, ptime, ysc%U%NSIZE_NATURE, ksv, ksw, zp_tsun,   &
                         zp_zenith, zp_zenith2, zp_azim, zp_zref, zp_uref, zp_zs, zp_u, zp_v, &
                         zp_qa, zp_ta, zp_rhoa, zp_sv, zp_co2, hsv, zp_rain, zp_snow, zp_lw,  &
                         zp_dir_sw, zp_sca_sw, psw_bands, zp_ps, zp_pa, zp_sftq, zp_sfth,     &
                         zp_sfts, zp_sfco2, zp_sfu, zp_sfv, zp_trad, zp_dir_alb, zp_sca_alb,  &
                         zp_emis, zp_tsurf, zp_z0, zp_z0h, zp_qsurf, zp_pew_a_coef,           &
                         zp_pew_b_coef, zp_pet_a_coef, zp_peq_a_coef, zp_pet_b_coef,          &
                         zp_peq_b_coef, 'OK'        )
  !
ELSEIF (ktile==4) THEN
  !
  CALL coupling_town_n(ysc%DTCO, ysc%U, ysc%DLO, ysc%DL, ysc%DLC, ysc%NDST%AL(1), ysc%SLT, ysc%TM, &
                       ysc%GDM, ysc%GRM, hprogram, hcoupling, ptimec, ptstep, kyear, kmonth,  &
                       kday, ptime, ysc%U%NSIZE_TOWN, ksv, ksw, zp_tsun, zp_zenith, zp_azim,  &
                       zp_zref, zp_uref, zp_zs, zp_u, zp_v, zp_qa, zp_ta, zp_rhoa, zp_sv,     &
                       zp_co2, hsv, zp_rain, zp_snow, zp_lw, zp_dir_sw, zp_sca_sw, psw_bands, &
                       zp_ps, zp_pa, zp_sftq, zp_sfth, zp_sfts, zp_sfco2, zp_sfu, zp_sfv,     &
                       zp_trad, zp_dir_alb, zp_sca_alb, zp_emis, zp_tsurf, zp_z0, zp_z0h,     &
                       zp_qsurf, zp_pew_a_coef, zp_pew_b_coef, zp_pet_a_coef, zp_peq_a_coef,  &
                       zp_pet_b_coef, zp_peq_b_coef, 'OK'            )
  !
ENDIF
!
!----------------------------------------------------------------------------------------------
!
!cdir nodep
!cdir unroll=8
DO jj=1,ksize
   ji=kmask(jj) 
   zsftq_tile(ji,ktile)  = zp_sftq(jj)
   zsfth_tile(ji,ktile)  = zp_sfth(jj)
   zsfco2_tile(ji,ktile)  = zp_sfco2(jj)
   zsfu_tile(ji,ktile)  = zp_sfu(jj)
   zsfv_tile(ji,ktile)  = zp_sfv(jj)
   ztrad_tile(ji,ktile)  = zp_trad(jj)
   zemis_tile(ji,ktile)  = zp_emis(jj)
   ztsurf_tile(ji,ktile)  = zp_tsurf(jj)
   zz0_tile(ji,ktile)  = zp_z0(jj)
   zz0h_tile(ji,ktile)  = zp_z0h(jj)
   zqsurf_tile(ji,ktile)  = zp_qsurf(jj)
ENDDO
!
DO ji=1,SIZE(zp_sfts,2)
!cdir nodep
!cdir unroll=8
  DO jj=1,ksize    
    zsfts_tile(kmask(jj),ji,ktile)= zp_sfts(jj,ji)
  ENDDO
ENDDO
!
DO ji=1,SIZE(zp_dir_alb,2)
!cdir nodep
!cdir unroll=8
  DO jj=1,ksize   
    zdir_alb_tile(kmask(jj),ji,ktile)= zp_dir_alb(jj,ji)
    zsca_alb_tile(kmask(jj),ji,ktile)= zp_sca_alb(jj,ji)
  ENDDO
ENDDO
!
!----------------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('COUPLING_SURF_ATM_n:TREAT_SURF',1,zhook_handle)
!
END SUBROUTINE treat_surf
!=======================================================================================
END SUBROUTINE coupling_surf_atm_n