Newer
Older
!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_TOWN_n (DTCO, U, DGO, DL, DLC, DST, SLT, TM, GDM, GRM, HM, HPROGRAM, &
HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, &
KSV, KSW, KLEV, PTSUN, PZENITH, PAZIM, PZREF, PUREF, PZS, PU, &
PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PTKE, PSFTQ, &
PSFTQ_SURF, PSFTQ_WALL, PSFTQ_ROOF, PSFTH, PSFTH_SURF, &
PSFTH_WALL, PSFTH_ROOF, PCD_ROOF, 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_TOWN_n * - Chooses the surface schemes for towns
!!
!! PURPOSE
!! -------
!
!!** METHOD
!! ------
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! V. Masson
!!
!! MODIFICATIONS
!! -------------
!! Original 01/2004
!! B. Decharme 04/2013 new coupling variables
!!------------------------------------------------------------------
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
USE MODD_SURFEX_n, ONLY : TEB_MODEL_t, TEB_HYDRO_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
USE MODD_CSTS, ONLY : XTT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_COUPLING_IDEAL_FLUX
!
USE MODI_COUPLING_TEB_OROGRAPHY_n
USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
TYPE(DIAG_t), INTENT(INOUT) :: DL
TYPE(DIAG_t), INTENT(INOUT) :: DLC
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
TYPE(TEB_HYDRO_MODEL_t), INTENT(INOUT) :: HM
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
!
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
INTEGER, INTENT(IN) :: KLEV ! number of levels to couple
REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight)
REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
REAL, DIMENSION(KI,KLEV), INTENT(IN) :: PZREF ! height of T,q forcing (m)
REAL, DIMENSION(KI,KLEV), INTENT(IN) :: PUREF ! height of wind forcing (m)
REAL, DIMENSION(KI,KLEV), INTENT(IN) :: PTA ! air temperature forcing (K)
REAL, DIMENSION(KI,KLEV), INTENT(IN) :: PQA ! air humidity forcing (kg/m3)
REAL, DIMENSION(KI,KLEV), 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,KLEV), INTENT(IN) :: PU ! zonal wind (m/s)
REAL, DIMENSION(KI,KLEV), 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 (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,KLEV), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
REAL, DIMENSION(KI,KLEV), INTENT(IN) :: PTKE ! Subgrid turbulent kinetic energy at forcing level (m2/s2)
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 ! Total flux of heat (W/m2)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH_SURF ! Flux of heat at surface (W/m2)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH_WALL ! Flux of heat at walls (W/m2)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH_ROOF ! Flux of heat at roof (W/m2)
REAL, DIMENSION(KI), INTENT(OUT) :: PCD_ROOF
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! Total flux of water vapor (kg/m2/s)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ_SURF ! Flux of water vapor at surface (kg/m2/s)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ_WALL ! Flux of water vapor at wall (kg/m2/s)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ_ROOF ! Flux of water vapor at roof (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(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
!* 0. initialization of implicit coefficients
! ---------------------------------------
!
IF (LHOOK) CALL DR_HOOK('COUPLING_TOWN_N',0,ZHOOK_HANDLE)
!
IF (HTEST/='OK') THEN
CALL ABOR1_SFX('COUPLING_TOWNN: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
IF (U%CTOWN=='TEB ') THEN
!
CALL COUPLING_TEB_OROGRAPHY_n(DTCO, DST, SLT, TM, GDM, GRM, HM, HPROGRAM, HCOUPLING, PTSTEP, &
KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, KLEV, PTSUN, PZENITH, &
PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, &
PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, &
PPS, PPA, PTKE, PSFTQ, PSFTQ_SURF, PSFTQ_WALL, PSFTQ_ROOF, &
PSFTH, PSFTH_SURF, PSFTH_WALL, PSFTH_ROOF, PCD_ROOF, 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' )
!
!
IF (KLEV.NE.1) THEN
CALL ABOR1_SFX("COUPLING_TOWN: IDEAL_FLUX is not compatible with multi level coupling")
ENDIF
!
CALL COUPLING_IDEAL_FLUX(DGO, DL, DLC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, &
KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, &
PZREF(:,1), PUREF(:,1), PZS, PU(:,1), PV(:,1), PQA(:,1), &
PTA(:,1), PRHOA(:,1), PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA(:,1), 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' )
!
PSFTH_SURF = XUNDEF
PSFTH_WALL = XUNDEF
PSFTH_ROOF = XUNDEF
PCD_ROOF = XUNDEF
PSFTQ_SURF = XUNDEF
PSFTQ_WALL = XUNDEF
PSFTQ_ROOF = XUNDEF
!
PSFTH_SURF = 0.
PSFTH_WALL = 0.
PSFTH_ROOF = 0.
PCD_ROOF = 0.
PSFTQ_SURF = 0.
PSFTQ_WALL = 0.
PSFTQ_ROOF = 0.
PSFU = 0.
PSFV = 0.
!
PTRAD = XTT
PDIR_ALB = 0.
PSCA_ALB = 0.
PEMIS = 1.
!
PZ0 = 0.1
PZ0H = 0.001
!
!
IF (LHOOK) CALL DR_HOOK('COUPLING_TOWN_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE COUPLING_TOWN_n