coupling_isba_svatn.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_isba_svat_n (DTCO, UG, U, USS, IM, NDST, 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_ISBA_SVAT_n * - Chooses the time method (explicit, 
!!        implicit, time-spliting) for ISBA scheme   
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!     A. Bogatchev 09/2005 EBA snow option
!!     A. Boone     11/2009 Exner correction for Offline T-B coef
!!     B. Decharme  11/2009 Implicit coupling ok with all snow scheme
!!     B. Decharme  04/2013 new coupling variables and init local variables
!!-------------------------------------------------------------------
!
!
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_sso_n, ONLY : sso_t
USE modd_dst_n, ONLY : dst_np_t
USE modd_slt_n, ONLY : slt_t
!
USE modd_surf_par,   ONLY : xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_coupling_isba_orography_n
!
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(sso_t), INTENT(INOUT) :: USS
TYPE(dst_np_t), INTENT(INOUT) :: NDST
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)     :: ZSFTH   ! surface temperature flux 
REAL, DIMENSION(KI)     :: ZSFTQ   ! surface water vapor flux 
REAL, DIMENSION(KI)     :: ZSFCO2  ! surface CO2 flux 
REAL, DIMENSION(KI,KSV) :: ZSFTS   ! surface scalar flux   
REAL, DIMENSION(KI)     :: ZSFU    ! zonal momentum flux
REAL, DIMENSION(KI)     :: ZSFV    ! meridian momentum flux
REAL, DIMENSION(KI)     :: ZTRAD   ! surface radiative temperature
REAL, DIMENSION(KI)     :: ZEMIS   ! surface emissivity
REAL, DIMENSION(KI,KSW) :: ZDIR_ALB! direct surface albedo
REAL, DIMENSION(KI,KSW) :: ZSCA_ALB! diffuse surface albedo
REAL, DIMENSION(KI)     :: ZTSURF  ! surface effective temperature         (K)
REAL, DIMENSION(KI)     :: ZZ0     ! roughness length for momentum         (m)
REAL, DIMENSION(KI)     :: ZZ0H    ! roughness length for heat             (m)
REAL, DIMENSION(KI)     :: ZQSURF  ! specific humidity at surface          (kg/kg)
!
REAL, DIMENSION(KI)     :: ZWORK_LW  ! work array for mean upward longwave surface flux
REAL, DIMENSION(KI)     :: ZWORK_Z0  ! work array for mean roughness length for momentum
REAL, DIMENSION(KI)     :: ZWORK_Z0H ! work array for mean roughness length for heat
!
INTEGER :: JT      ! time loop counter
INTEGER :: IT      ! total number of surface timesteps in one atmospheric timestep
REAL    :: ZT      ! total number of surface timesteps in one atmospheric timestep
REAL    :: ZTSTEP  ! surface time step
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
!*      1.     number of time-steps
!              --------------------
!
!* only one timestep in Implicit coupling
IF (lhook) CALL dr_hook('COUPLING_ISBA_SVAT_N',0,zhook_handle)
IF (hcoupling=='I') THEN
  it=1
  zt=1.
  ztstep=ptstep
!
!* same timestep as atmospheric timestep as default
ELSE IF (im%O%XTSTEP==xundef) THEN
  it=1
  zt=1.
  ztstep=ptstep
!
!* case of specified SVAT time-step
ELSE
  it=max(nint(ptstep/im%O%XTSTEP),1)
  zt=float(it)
  ztstep=ptstep/zt
ENDIF
!
!*      3.     initialization of outputs
!              -------------------------
!
psftq   = 0.0
psfth   = 0.0
psfts   = 0.0
psfco2  = 0.0
psfu    = 0.0
psfv    = 0.0
ptrad   = 0.0
pdir_alb= 0.0
psca_alb= 0.0
pemis   = 0.0
ptsurf  = 0.0
pz0     = 0.0
pz0h    = 0.0
pqsurf  = 0.0
!
zsfth   = 0.0  ! surface temperature flux 
zsftq   = 0.0  ! surface water vapor flux 
zsfco2  = 0.0  ! surface CO2 flux 
zsfts   = 0.0  ! surface scalar flux   
zsfu    = 0.0  ! zonal momentum flux
zsfv    = 0.0  ! meridian momentum flux
ztrad   = 0.0  ! surface radiative temperature
zemis   = 0.0  ! surface emissivity
zdir_alb= 0.0  ! direct surface albedo
zsca_alb= 0.0  ! diffuse surface albedo
ztsurf  = 0.0  ! surface effective temperature         (K)
zz0     = 0.0  ! roughness length for momentum         (m)
zz0h    = 0.0  ! roughness length for heat             (m)
zqsurf  = 0.0  ! specific humidity at surface
!
zwork_lw = 0.0 ! work array for mean upward longwave surface flux
zwork_z0 = 0.0 ! work array for mean roughness length for momentum
zwork_z0h= 0.0 ! work array for mean roughness length for heat
!
!*      4.     loop on surface time-step
!              -------------------------
!
DO jt=1,it
!
  CALL coupling_isba_orography_n(dtco, ug, u, uss, im%SB, im%NAG, im%CHI, im%NCHI, im%DTV,     &
                                 im%ID, im%NGB, im%GB, im%ISS, im%NISS, im%G, im%NG, im%O,     &
                                 im%S, im%K, im%NK, im%NP, im%NPE, ndst, slt,                  &
                                 hprogram, hcoupling, ztstep, 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, zsftq, zsfth, zsfts,   &
                                 zsfco2, zsfu, zsfv, ztrad, zdir_alb, zsca_alb, zemis, ztsurf, &
                                 zz0, zz0h, zqsurf, ppew_a_coef, ppew_b_coef, ppet_a_coef,     &
                                 ppeq_a_coef, ppet_b_coef, ppeq_b_coef, 'OK'    ) 
!
  psftq    = psftq    + zsftq    / zt
  psfth    = psfth    + zsfth    / zt
  psfts    = psfts    + zsfts    / zt
  psfco2   = psfco2   + zsfco2   / zt
  psfu     = psfu     + zsfu     / zt
  psfv     = psfv     + zsfv     / zt
  pemis    = pemis    + zemis    / zt
  pdir_alb = pdir_alb + zdir_alb / zt
  psca_alb = psca_alb + zsca_alb / zt
  ptsurf   = ptsurf   + ztsurf   / zt
  pqsurf   = pqsurf   + zqsurf   / zt
!  
  zwork_lw  = zwork_lw  + zemis*ztrad**4 / zt
  zwork_z0  = zwork_z0  + (1.0/(log(puref(:)/zz0 ))**2) / zt
  zwork_z0h = zwork_z0h + (1.0/(log(pzref(:)/zz0h))**2) / zt
!  
END DO
!
!* radiative temperature retrieved from upward longwave flux
!
ptrad = (zwork_lw/pemis)**(0.25)
!
!* roughness length for momentum and heat
!
pz0  = puref(:) * exp( - sqrt(1./zwork_z0(:)) )
pz0h = pzref(:) * exp( - sqrt(1./zwork_z0h(:)) )
!
IF (lhook) CALL dr_hook('COUPLING_ISBA_SVAT_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE coupling_isba_svat_n