coupling_tsz0n.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_tsz0_n (DTCO, UG, U, USS, IM, DTZ, DTGD, DTGR, TGRO, DST, SLT,  &
                            hprogram, hcoupling,                                              &
                 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_TSZ0_n * - Call of fluxes from vegetation scheme ISBA but 
!!        without temporal evolution of the soil/vegetation.
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      Modified    09/2012 : J. Escobar , SIZE(PTA) not allowed without-interface , replace by KI
!!      B. Decharme 04/2013 new coupling variables
!!      P. LeMoigne 12/2014 bug in "implicit" coefficients 
!!------------------------------------------------------------------
!
!
USE modd_surfex_n, ONLY : isba_model_t
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
USE modd_data_tsz0_n, ONLY : data_tsz0_t
USE modd_data_teb_garden_n, ONLY : data_teb_garden_t
USE modd_data_teb_greenroof_n, ONLY : data_teb_greenroof_t
USE modd_teb_greenroof_option_n, ONLY : teb_greenroof_options_t
USE modd_dst_n, ONLY : dst_t
USE modd_slt_n, ONLY : slt_t
!
!
USE modd_surf_par, ONLY : xundef
USE modd_csts,   ONLY : xp00, xrd, xcpd
!
USE modi_tsz0
USE modi_coupling_isba_orography_n
! 
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(isba_model_t), INTENT(INOUT) :: im
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
TYPE(data_tsz0_t), INTENT(INOUT) :: dtz
TYPE(data_teb_garden_t), INTENT(INOUT) :: dtgd
TYPE(data_teb_greenroof_t), INTENT(INOUT) :: dtgr
TYPE(teb_greenroof_options_t), INTENT(INOUT) :: tgro
TYPE(dst_t), INTENT(INOUT) :: dst
TYPE(slt_t), INTENT(INOUT) :: slt
!
 CHARACTER(LEN=6),    INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=1),    INTENT(IN)  :: hcoupling ! type of coupling
                                              ! 'E' : explicit
                                              ! 'I' : implicit
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(OUT) :: 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(OUT) :: pemis     ! emissivity                            (-)
!
REAL, DIMENSION(KI), INTENT(OUT) :: ptsurf    ! surface effective temperature         (K)
REAL, DIMENSION(KI), INTENT(OUT) :: pz0       ! roughness length for momentum         (m)
REAL, DIMENSION(KI), INTENT(OUT) :: pz0h      ! roughness length for heat             (m)
REAL, DIMENSION(KI), INTENT(OUT) :: 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
!
!
REAL, DIMENSION(KI,IM%I%NGROUND_LAYER,IM%I%NPATCH) :: ztg   ! soil temperature
REAL, DIMENSION(KI,IM%I%NGROUND_LAYER,IM%I%NPATCH) :: zwg   ! soil water content
REAL, DIMENSION(KI,IM%I%NGROUND_LAYER,IM%I%NPATCH) :: zwgi  ! soil ice content
REAL, DIMENSION(KI,IM%I%NPATCH) :: zwr   ! interception reservoir
REAL, DIMENSION(KI,IM%I%NPATCH) :: zresa ! aerodynamical resistance
REAL, DIMENSION(KI,IM%I%TSNOW%NLAYER,IM%I%NPATCH) :: zwsnow! snow reservoir
REAL, DIMENSION(KI,IM%I%TSNOW%NLAYER,IM%I%NPATCH) :: zrhosn! snow density
REAL, DIMENSION(KI,IM%I%TSNOW%NLAYER,IM%I%NPATCH) :: zheasn! snow heat content
REAL, DIMENSION(KI,IM%I%NPATCH) :: zalbsn! snow albedo
REAL, DIMENSION(KI,IM%I%NPATCH) :: zemisn! snow emissivity
!
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
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('COUPLING_TSZ0_N',0,zhook_handle)
!
!*      1.     Specified evolution of ISBA prognostic variables
!              ------------------------------------------------
!
 CALL tsz0(dtz, &
           ptime, ptstep, im%I%XWFC, im%I%XTG, im%I%XWG)
!
!
!*      2.     Saves the prognostic variables
!              ------------------------------
!
ztg(:,:,:) = im%I%XTG        (:,:,:)
zwg(:,:,:) = im%I%XWG        (:,:,:)
zwgi(:,:,:) = im%I%XWGI       (:,:,:)
zwr(:,:)   = im%I%XWR        (:,:)
zresa(:,:)   = im%I%XRESA      (:,:)
zwsnow(:,:,:)= im%I%TSNOW%WSNOW(:,:,:)
zrhosn(:,:,:)= im%I%TSNOW%RHO  (:,:,:)
zalbsn(:,:)  = im%I%TSNOW%ALB  (:,:)
IF (im%I%TSNOW%SCHEME=='3-L' .OR. im%I%TSNOW%SCHEME=='CRO') THEN
  zheasn(:,:,:)= im%I%TSNOW%HEAT (:,:,:)
  zemisn(:,:)  = im%I%TSNOW%EMIS (:,:)
END IF
!
!
!*      3.     Call to surface scheme
!              ----------------------
!
 CALL coupling_isba_orography_n(dtco, ug, u, uss, im, dtgd, dtgr, tgro, dst, slt,   &
                                hprogram, 'E',                                              &
                 0.001, 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,                         &
                 'OK'                                                                        )  
!
!
!*      4.     Removes temporal evolution of ISBA variables
!              --------------------------------------------
!
!
im%I%XTG  (:,:,:) = ztg
im%I%XWG  (:,:,:) = zwg
im%I%XWGI (:,:,:) = zwgi
im%I%XWR  (:,:)   = zwr
im%I%XRESA(:,:)   = zresa
im%I%TSNOW%WSNOW(:,:,:) = zwsnow
im%I%TSNOW%RHO  (:,:,:) = zrhosn
im%I%TSNOW%ALB  (:,:)   = zalbsn
IF (im%I%TSNOW%SCHEME=='3-L' .OR. im%I%TSNOW%SCHEME=='CRO') THEN
  im%I%TSNOW%HEAT (:,:,:) = zheasn
  im%I%TSNOW%EMIS (:,:)   = zemisn
END IF
!
IF (lhook) CALL dr_hook('COUPLING_TSZ0_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE coupling_tsz0_n