|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE COUPLING_TEB_n(HPROGRAM, HCOUPLING, & 00003 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, & 00004 PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, & 00005 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, & 00006 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, & 00007 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, & 00008 PPEW_A_COEF, PPEW_B_COEF, & 00009 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, & 00010 HTEST ) 00011 ! ############################################################################### 00012 ! 00013 !!**** *COUPLING_TEB_n * - Driver for TEB 00014 !! 00015 !! PURPOSE 00016 !! ------- 00017 ! 00018 !!** METHOD 00019 !! ------ 00020 !! 00021 !! REFERENCE 00022 !! --------- 00023 !! 00024 !! 00025 !! AUTHOR 00026 !! ------ 00027 !! V. Masson 00028 !! 00029 !! MODIFICATIONS 00030 !! ------------- 00031 !! Original 01/2004 00032 !! 10/2005 (G.Pigeon) transfer of domestic heating 00033 !! S. Riette 06/2009 Initialisation of XT, XQ, XU and XTKE on canopy levels 00034 !! S. Riette 01/2010 Use of interpol_sbl to compute 10m wind diagnostic 00035 !! G. Pigeon 09/2012 CCH_BEM, ROUGH_WALL, ROUGH_ROOF for building conv. coef 00036 !! G. Pigeon 10/2012 XF_WIN_WIN as arg. of TEB_GARDEN 00037 !! B. Decharme 09/2012 New wind implicitation 00038 !! J. Escobar 09/2012 KI not allowed without-interface , replace by KI 00039 !!--------------------------------------------------------------- 00040 ! 00041 ! 00042 USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XLVTT, XPI, XKARMAN, XG 00043 USE MODD_SURF_PAR, ONLY : XUNDEF 00044 ! 00045 USE MODD_SURF_ATM, ONLY : CIMPLICIT_WIND 00046 ! 00047 USE MODD_TEB_n, ONLY : CBEM, TTIME,LCANOPY,CZ0H,CROAD_DIR,CWALL_OPT, & 00048 XT_CANYON, XQ_CANYON, & 00049 XT_ROOF, XT_ROAD, XT_WALL_A, XT_WALL_B, & 00050 XWS_ROOF, XWS_ROAD, & 00051 TSNOW_ROOF, TSNOW_ROAD, & 00052 XH_TRAFFIC, XLE_TRAFFIC, XH_INDUSTRY, XLE_INDUSTRY, & 00053 XZ0_TOWN, XBLD, XGARDEN, XROAD_DIR, XROAD, XGREENROOF, & 00054 XBLD_HEIGHT, XWALL_O_HOR, XCAN_HW_RATIO, & 00055 XROAD_O_GRND, XGARDEN_O_GRND, XWALL_O_GRND, & 00056 XALB_ROOF, XEMIS_ROOF, XHC_ROOF,XTC_ROOF, XD_ROOF, & 00057 XALB_ROAD, XEMIS_ROAD, XHC_ROAD,XTC_ROAD, XD_ROAD, & 00058 XALB_WALL, XEMIS_WALL, XHC_WALL,XTC_WALL, XD_WALL, & 00059 XSVF_ROAD, XSVF_WALL, & 00060 XSVF_GARDEN, XWALL_O_BLD, & 00061 XQSAT_ROOF, XQSAT_ROAD, XDELT_ROOF, XDELT_ROAD, & 00062 NTEB_PATCH, XTEB_PATCH, CCH_BEM, XROUGH_ROOF, XROUGH_WALL 00063 ! 00064 USE MODD_BEM_n, ONLY : XHC_FLOOR, XTC_FLOOR, XD_FLOOR, XTCOOL_TARGET, & 00065 XTHEAT_TARGET, XF_WASTE_CAN, XEFF_HEAT, XTI_BLD, & 00066 XT_FLOOR, XT_MASS, XQIN, XQIN_FRAD, XSHGC, XSHGC_SH, & 00067 XU_WIN, XGR, XINF, CCOOL_COIL, CHEAT_COIL, & 00068 XF_WATER_COND, XAUX_MAX, XQIN_FLAT, & 00069 XHR_TARGET, XT_WIN2, XQI_BLD, XV_VENT, XCAP_SYS_HEAT, & 00070 XCAP_SYS_RAT, XT_ADP, XM_SYS_RAT, XCOP_RAT, XT_WIN1, & 00071 XALB_WIN, XABS_WIN, XT_SIZE_MAX, XT_SIZE_MIN, XUGG_WIN, & 00072 LSHADE, CNATVENT, LSHAD_DAY, LNATVENT_NIGHT, & 00073 XN_FLOOR, XGLAZ_O_BLD, XMASS_O_BLD, XFLOOR_HW_RATIO, & 00074 XF_FLOOR_MASS, XF_FLOOR_WALL, XF_FLOOR_WIN, & 00075 XF_FLOOR_ROOF, XF_WALL_FLOOR, XF_WALL_MASS, & 00076 XF_WALL_WIN, XF_WIN_FLOOR, XF_WIN_MASS, XF_WIN_WALL, & 00077 XF_MASS_FLOOR, XF_MASS_WALL, XF_MASS_WIN, & 00078 XTRAN_WIN, XF_WIN_WIN 00079 00080 USE MODD_CH_TEB_n, ONLY : CSV, CCH_DRY_DEP, XDEP, NBEQ, NSV_CHSBEG, NSV_CHSEND, & 00081 NSV_DSTBEG, NSV_DSTEND, NAEREQ, NDSTEQ, NSLTEQ, & 00082 NSV_AERBEG, NSV_AEREND, NSV_SLTBEG, NSV_SLTEND 00083 USE MODD_TEB_CANOPY_n, ONLY : XZ, XU, NLVL, XTKE, XT, XQ, & 00084 XLMO, XLM, XLEPS,XZF, XDZ, XDZF, XP 00085 USE MODD_DIAG_TEB_n, ONLY : N2M, XZON10M, XMER10M 00086 USE MODD_DIAG_UTCI_TEB_n, ONLY : LUTCI, XUTCI_IN, XUTCI_OUTSUN, & 00087 XUTCI_OUTSHADE, XTRAD_SUN, XTRAD_SHADE 00088 USE MODD_DST_n, ONLY : XEMISRADIUS_DST, XEMISSIG_DST 00089 USE MODD_SLT_n, ONLY : XEMISRADIUS_SLT, XEMISSIG_SLT 00090 USE MODD_DST_SURF 00091 USE MODD_SLT_SURF 00092 ! 00093 ! 00094 USE MODE_DSLT_SURF 00095 USE MODE_THERMOS 00096 USE MODE_SBLS 00097 ! 00098 USE MODI_AVERAGE_RAD 00099 USE MODI_SM10 00100 USE MODI_ADD_FORECAST_TO_DATE_SURF 00101 USE MODI_DIAG_INLINE_TEB_n 00102 USE MODI_DIAG_MISC_TEB_n 00103 USE MODI_CH_AER_DEP 00104 USE MODI_CH_DEP_TOWN 00105 USE MODI_DSLT_DEP 00106 USE MODI_TEB_GARDEN 00107 USE MODI_TEB_CANOPY 00108 ! 00109 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00110 USE PARKIND1 ,ONLY : JPRB 00111 ! 00112 USE MODI_ABOR1_SFX 00113 USE MODI_CANOPY_EVOL 00114 USE MODI_CANOPY_GRID_UPDATE 00115 USE MODI_UTCI_TEB 00116 USE MODI_CIRCUMSOLAR_RAD 00117 ! 00118 IMPLICIT NONE 00119 ! 00120 !* 0.1 declarations of arguments 00121 ! 00122 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00123 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00124 ! 'E' : explicit 00125 ! 'I' : implicit 00126 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00127 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00128 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00129 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00130 INTEGER, INTENT(IN) :: KI ! number of points 00131 INTEGER, INTENT(IN) :: KSV ! number of scalars 00132 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00133 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00134 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00135 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00136 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00137 ! 00138 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00139 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00140 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00141 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00142 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00143 ! ! 00144 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables 00145 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00146 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00147 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00148 ! ! (W/m2) 00149 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00150 ! ! (W/m2) 00151 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00152 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical) 00153 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) 00154 REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) 00155 ! ! (W/m2) 00156 REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) 00157 REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) 00158 REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) 00159 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) 00160 REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) 00161 REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) 00162 ! 00163 ! 00164 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) 00165 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) 00166 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) 00167 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) 00168 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s) 00169 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) 00170 ! 00171 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) 00172 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) 00173 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) 00174 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) 00175 ! 00176 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients 00177 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' 00178 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF 00179 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF 00180 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF 00181 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF 00182 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00183 ! 00184 ! 00185 !* 0.2 declarations of local variables 00186 ! 00187 INTEGER :: JSWB ! loop counter on shortwave spectral bands 00188 ! 00189 REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/kg) 00190 REAL, DIMENSION(KI) :: ZEXNA ! Exner function at forcing level 00191 REAL, DIMENSION(KI) :: ZEXNS ! Exner function at surface level 00192 REAL, DIMENSION(KI) :: ZWIND ! wind 00193 ! 00194 ! Ouput Diagnostics: 00195 ! 00196 REAL, DIMENSION(KI) :: ZU_CANYON ! wind in canyon 00197 REAL, DIMENSION(KI) :: ZT_CANYON ! temperature in canyon 00198 REAL, DIMENSION(KI) :: ZQ_CANYON ! specific humidity in canyon 00199 REAL, DIMENSION(KI) :: ZT_CAN ! temperature in canyon (evolving in TEB) 00200 REAL, DIMENSION(KI) :: ZQ_CAN ! specific humidity in canyon (evolving in TEB) 00201 ! 00202 REAL, DIMENSION(KI) :: ZRN_ROOF ! net radiation on roof 00203 REAL, DIMENSION(KI) :: ZH_ROOF ! sensible heat flux on roof 00204 REAL, DIMENSION(KI) :: ZLE_ROOF ! latent heat flux on roof 00205 REAL, DIMENSION(KI) :: ZLEW_ROOF ! latent heat flux on snowfree roof 00206 REAL, DIMENSION(KI) :: ZGFLUX_ROOF ! storage flux in roof 00207 REAL, DIMENSION(KI) :: ZRUNOFF_ROOF! water runoff from roof 00208 REAL, DIMENSION(KI) :: ZRN_ROAD ! net radiation on road 00209 REAL, DIMENSION(KI) :: ZH_ROAD ! sensible heat flux on road 00210 REAL, DIMENSION(KI) :: ZLE_ROAD ! latent heat flux on road 00211 REAL, DIMENSION(KI) :: ZLEW_ROAD ! latent heat flux on snowfree road 00212 REAL, DIMENSION(KI) :: ZGFLUX_ROAD ! storage flux in road 00213 REAL, DIMENSION(KI) :: ZRUNOFF_ROAD! water runoff from road 00214 REAL, DIMENSION(KI) :: ZRN_WALL_A ! net radiation on walls 00215 REAL, DIMENSION(KI) :: ZH_WALL_A ! sensible heat flux on walls 00216 REAL, DIMENSION(KI) :: ZLE_WALL_A ! latent heat flux on walls 00217 REAL, DIMENSION(KI) :: ZGFLUX_WALL_A!storage flux in walls 00218 REAL, DIMENSION(KI) :: ZRN_WALL_B ! net radiation on walls 00219 REAL, DIMENSION(KI) :: ZH_WALL_B ! sensible heat flux on walls 00220 REAL, DIMENSION(KI) :: ZLE_WALL_B ! latent heat flux on walls 00221 REAL, DIMENSION(KI) :: ZGFLUX_WALL_B!storage flux in walls 00222 REAL, DIMENSION(KI) :: ZRN_GARDEN ! net radiation on green areas 00223 REAL, DIMENSION(KI) :: ZH_GARDEN ! sensible heat flux on green areas 00224 REAL, DIMENSION(KI) :: ZLE_GARDEN ! latent heat flux on green areas 00225 REAL, DIMENSION(KI) :: ZGFLUX_GARDEN!storage flux in green areas 00226 REAL, DIMENSION(KI) :: ZRN_GREENROOF! net radiation on green roofs 00227 REAL, DIMENSION(KI) :: ZH_GREENROOF ! sensible heat flux on green roofs 00228 REAL, DIMENSION(KI) :: ZLE_GREENROOF! latent heat flux on green roofs 00229 REAL, DIMENSION(KI) :: ZGFLUX_GREENROOF ! storage flux in green roofs 00230 REAL, DIMENSION(KI) :: ZG_GREENROOF_ROOF ! heat flux between base of greenroof 00231 REAL, DIMENSION(KI) :: ZRUNOFF_GREENROOF ! water runoff from green roof 00232 REAL, DIMENSION(KI) :: ZDRAIN_GREENROOF ! water drainage from green roof 00233 REAL, DIMENSION(KI) :: ZRN_STRLROOF ! net radiation on structural roof 00234 REAL, DIMENSION(KI) :: ZH_STRLROOF ! sensible heat flux on structural roof 00235 REAL, DIMENSION(KI) :: ZLE_STRLROOF ! latent heat flux on structural roof 00236 REAL, DIMENSION(KI) :: ZGFLUX_STRLROOF ! storage flux in structural roof 00237 REAL, DIMENSION(KI) :: ZRN_BLT ! net radiation on built surf 00238 REAL, DIMENSION(KI) :: ZH_BLT ! sensible heat flux on built surf 00239 REAL, DIMENSION(KI) :: ZLE_BLT ! latent heat flux on built surf 00240 REAL, DIMENSION(KI) :: ZGFLUX_BLT ! storage flux in built surf 00241 REAL, DIMENSION(KI) :: ZRN_GRND ! net radiation on ground built surf 00242 REAL, DIMENSION(KI) :: ZH_GRND ! sensible heat flux on ground built surf 00243 REAL, DIMENSION(KI) :: ZLE_GRND ! latent heat flux on ground built surf 00244 REAL, DIMENSION(KI) :: ZGFLUX_GRND ! storage flux in ground built surf 00245 REAL, DIMENSION(KI) :: ZRNSNOW_ROOF ! net radiation over snow 00246 REAL, DIMENSION(KI) :: ZHSNOW_ROOF ! sensible heat flux over snow 00247 REAL, DIMENSION(KI) :: ZLESNOW_ROOF ! latent heat flux over snow 00248 REAL, DIMENSION(KI) :: ZGSNOW_ROOF ! flux under the snow 00249 REAL, DIMENSION(KI) :: ZMELT_ROOF ! snow melt 00250 REAL, DIMENSION(KI) :: ZRNSNOW_ROAD ! net radiation over snow 00251 REAL, DIMENSION(KI) :: ZHSNOW_ROAD ! sensible heat flux over snow 00252 REAL, DIMENSION(KI) :: ZLESNOW_ROAD ! latent heat flux over snow 00253 REAL, DIMENSION(KI) :: ZGSNOW_ROAD ! flux under the snow 00254 REAL, DIMENSION(KI) :: ZMELT_ROAD ! snow melt 00255 ! 00256 REAL, DIMENSION(KI) :: ZTRAD ! radiative temperature for current patch 00257 REAL, DIMENSION(KI) :: ZEMIS ! emissivity for current patch 00258 REAL, DIMENSION(KI,NTEB_PATCH) :: ZTRAD_PATCH ! radiative temperature for each patch 00259 REAL, DIMENSION(KI,NTEB_PATCH) :: ZEMIS_PATCH ! emissivity for each patch 00260 REAL, DIMENSION(KI,KSW,NTEB_PATCH) :: ZDIR_ALB_PATCH ! direct albedo per wavelength and patch 00261 REAL, DIMENSION(KI,KSW,NTEB_PATCH) :: ZSCA_ALB_PATCH ! diffuse albedo per wavelength and patch 00262 ! 00263 REAL, DIMENSION(KI) :: ZRN ! net radiation over town 00264 REAL, DIMENSION(KI) :: ZH ! sensible heat flux over town 00265 REAL, DIMENSION(KI) :: ZLE ! latent heat flux over town 00266 REAL, DIMENSION(KI) :: ZGFLUX ! flux through the ground 00267 REAL, DIMENSION(KI) :: ZSFCO2 ! CO2 flux over town 00268 REAL, DIMENSION(KI) :: ZQF_BLD ! domestic heating 00269 REAL, DIMENSION(KI) :: ZFLX_BLD ! flux from bld 00270 REAL, DIMENSION(KI) :: ZDQS_TOWN ! storage inside town materials 00271 REAL, DIMENSION(KI) :: ZQF_TOWN ! total anthropogenic heat 00272 REAL, DIMENSION(KI) :: ZEVAP ! evaporation (km/m2/s) 00273 REAL, DIMENSION(KI) :: ZRUNOFF ! runoff over the ground 00274 REAL, DIMENSION(KI) :: ZCD ! drag coefficient 00275 REAL, DIMENSION(KI) :: ZCDN ! neutral drag coefficient 00276 REAL, DIMENSION(KI) :: ZCH ! heat drag 00277 REAL, DIMENSION(KI) :: ZRI ! Richardson number 00278 REAL, DIMENSION(KI) :: ZUW_GRND ! momentum flux for ground built surf 00279 REAL, DIMENSION(KI) :: ZUW_ROOF ! momentum flux for roofs 00280 REAL, DIMENSION(KI) :: ZDUWDU_GRND ! 00281 REAL, DIMENSION(KI) :: ZDUWDU_ROOF ! 00282 REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity 00283 REAL, DIMENSION(KI) :: ZSFU ! momentum flux for patch (U direction) 00284 REAL, DIMENSION(KI) :: ZSFV ! momentum flux for patch (V direction) 00285 REAL, DIMENSION(KI) :: ZAVG_DIR_ALB ! direct albedo of town 00286 REAL, DIMENSION(KI) :: ZAVG_SCA_ALB ! diffuse albedo of town 00287 REAL, DIMENSION(KI) :: ZAVG_T_CANYON ! temperature in canyon for town 00288 REAL, DIMENSION(KI) :: ZAVG_Q_CANYON ! specific humidity in canyon for town 00289 ! 00290 REAL, DIMENSION(KI) :: ZAVG_CD ! aggregated drag coefficient 00291 REAL, DIMENSION(KI) :: ZAVG_CDN ! aggregated neutral drag coefficient 00292 REAL, DIMENSION(KI) :: ZAVG_RI ! aggregated Richardson number 00293 REAL, DIMENSION(KI) :: ZAVG_CH ! aggregated Heat transfer coefficient 00294 ! 00295 REAL, DIMENSION(KI) :: ZDIR_ALB ! direct albedo of town 00296 REAL, DIMENSION(KI) :: ZSCA_ALB ! diffuse albedo of town 00297 ! 00298 REAL, DIMENSION(KI) :: ZH_TRAFFIC ! anthropogenic sensible 00299 ! ! heat fluxes due to traffic 00300 REAL, DIMENSION(KI) :: ZLE_TRAFFIC ! anthropogenic latent 00301 ! ! heat fluxes due to traffic 00302 REAL, DIMENSION(KI) :: ZRESA_TOWN ! aerodynamical resistance 00303 REAL, DIMENSION(KI) :: ZAC_ROAD ! road aerodynamical conductance 00304 REAL, DIMENSION(KI) :: ZAC_GARDEN ! green area aerodynamical conductance 00305 REAL, DIMENSION(KI) :: ZAC_GRND ! ground built surf aerodynamical conductance 00306 REAL, DIMENSION(KI) :: ZAC_GREENROOF ! green roof aerodynamical conductance 00307 REAL, DIMENSION(KI) :: ZAC_ROAD_WAT ! road water aerodynamical conductance 00308 REAL, DIMENSION(KI) :: ZAC_GARDEN_WAT! green area water aerodynamical conductance 00309 REAL, DIMENSION(KI) :: ZAC_GRND_WAT ! ground built surf water aerodynamical conductance 00310 REAL, DIMENSION(KI) :: ZAC_GREENROOF_WAT! green roof water aerodynamical conductance 00311 REAL, DIMENSION(KI,1):: ZESNOW_GARDEN ! green area snow emissivity 00312 ! 00313 REAL :: ZBEGIN_TRAFFIC_TIME ! start traffic time (solar time, s) 00314 REAL :: ZEND_TRAFFIC_TIME ! end traffic time (solar time, s) 00315 REAL, DIMENSION(KI) :: ZDIR_SW ! total direct SW 00316 REAL, DIMENSION(KI) :: ZSCA_SW ! total diffuse SW 00317 REAL, DIMENSION(KI) :: ZPEW_A_COEF ! implicit coefficients 00318 REAL, DIMENSION(KI) :: ZPEW_B_COEF ! needed if HCOUPLING='I' 00319 00320 !***** CANOPY ***** 00321 REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2) 00322 REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s) 00323 REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s) 00324 REAL, DIMENSION(KI,NLVL) :: ZFORC_U ! tendency due to drag force for wind 00325 REAL, DIMENSION(KI,NLVL) :: ZDFORC_UDU! formal derivative of 00326 ! ! tendency due to drag force for wind 00327 REAL, DIMENSION(KI,NLVL) :: ZFORC_E ! tendency due to drag force for TKE 00328 REAL, DIMENSION(KI,NLVL) :: ZDFORC_EDE! formal derivative of 00329 ! ! tendency due to drag force for TKE 00330 REAL, DIMENSION(KI,NLVL) :: ZFORC_T ! tendency due to drag force for Temp 00331 REAL, DIMENSION(KI,NLVL) :: ZDFORC_TDT! formal derivative of 00332 ! ! tendency due to drag force for Temp 00333 REAL, DIMENSION(KI,NLVL) :: ZFORC_Q ! tendency due to drag force for hum 00334 REAL, DIMENSION(KI,NLVL) :: ZDFORC_QDQ! formal derivative of 00335 ! ! tendency due to drag force for hum. 00336 00337 REAL, DIMENSION(KI) :: ZAVG_UW_GRND 00338 REAL, DIMENSION(KI) :: ZAVG_DUWDU_GRND 00339 REAL, DIMENSION(KI) :: ZAVG_UW_ROOF 00340 REAL, DIMENSION(KI) :: ZAVG_DUWDU_ROOF 00341 REAL, DIMENSION(KI) :: ZAVG_H_GRND 00342 REAL, DIMENSION(KI) :: ZAVG_H_WALL 00343 REAL, DIMENSION(KI) :: ZAVG_H_ROOF 00344 REAL, DIMENSION(KI) :: ZAVG_E_GRND 00345 REAL, DIMENSION(KI) :: ZAVG_E_ROOF 00346 REAL, DIMENSION(KI) :: ZAVG_AC_GRND 00347 REAL, DIMENSION(KI) :: ZAVG_AC_GRND_WAT 00348 REAL, DIMENSION(KI) :: ZAVG_Z0_TOWN 00349 REAL, DIMENSION(KI) :: ZAVG_RESA_TOWN 00350 REAL, DIMENSION(KI) :: ZAVG_USTAR ! town avegared Ustar 00351 REAL, DIMENSION(KI) :: ZAVG_BLD ! town averaged building fraction 00352 REAL, DIMENSION(KI) :: ZAVG_BLD_HEIGHT ! town averaged building height 00353 REAL, DIMENSION(KI) :: ZAVG_WALL_O_HOR ! town averaged Wall/hor ratio 00354 REAL, DIMENSION(KI) :: ZAVG_CAN_HW_RATIO ! town averaged road aspect ratio 00355 REAL, DIMENSION(KI) :: ZAVG_H 00356 REAL, DIMENSION(KI) :: ZAVG_LE 00357 REAL, DIMENSION(KI) :: ZAVG_RN 00358 REAL, DIMENSION(KI) :: ZAVG_GFLUX 00359 REAL, DIMENSION(KI) :: ZAVG_REF_SW_GRND 00360 REAL, DIMENSION(KI) :: ZAVG_REF_SW_FAC 00361 REAL, DIMENSION(KI) :: ZAVG_SCA_SW 00362 REAL, DIMENSION(KI) :: ZAVG_DIR_SW 00363 REAL, DIMENSION(KI) :: ZAVG_EMIT_LW_FAC 00364 REAL, DIMENSION(KI) :: ZAVG_EMIT_LW_GRND 00365 REAL, DIMENSION(KI) :: ZAVG_T_RAD_IND 00366 REAL, DIMENSION(KI) :: ZT_LOWCAN ! temperature at lowest canyon level (K) 00367 REAL, DIMENSION(KI) :: ZQ_LOWCAN ! humidity at lowest canyon level (kg/kg) 00368 REAL, DIMENSION(KI) :: ZU_LOWCAN ! wind at lowest canyon level (m/s) 00369 REAL, DIMENSION(KI) :: ZZ_LOWCAN ! height of lowest canyon level (m) 00370 REAL, DIMENSION(KI) :: ZPEW_A_COEF_LOWCAN ! implicit coefficients for wind coupling 00371 REAL, DIMENSION(KI) :: ZPEW_B_COEF_LOWCAN ! between first canopy level and road 00372 REAL, DIMENSION(KI) :: ZTA ! temperature at canyon level just above roof (K) 00373 REAL, DIMENSION(KI) :: ZPA ! pressure at canyon level just above roof (K) 00374 REAL, DIMENSION(KI) :: ZUA ! wind at canyon level just above roof (m/s) 00375 REAL, DIMENSION(KI) :: ZUREF ! height of canyon level just above roof (m) 00376 REAL, DIMENSION(KI) :: ZZREF ! height of canyon level just above roof (m) 00377 REAL, DIMENSION(KI) :: ZLAMBDA_F ! frontal density (-) 00378 REAL, DIMENSION(KI) :: ZLMO ! Monin-Obukhov length at canopy height (m) 00379 REAL, DIMENSION(KI,NLVL) :: ZL ! Mixing length generic profile at mid levels 00380 ! 00381 ! absorbed solar and infra-red radiation by road, wall and roof 00382 ! 00383 REAL, DIMENSION(KI) :: ZABS_SW_ROAD 00384 REAL, DIMENSION(KI) :: ZABS_SW_WALL_A 00385 REAL, DIMENSION(KI) :: ZABS_SW_WALL_B 00386 REAL, DIMENSION(KI) :: ZABS_SW_ROOF 00387 REAL, DIMENSION(KI) :: ZABS_SW_GARDEN 00388 REAL, DIMENSION(KI) :: ZABS_SW_GREENROOF 00389 REAL, DIMENSION(KI) :: ZABS_SW_SNOW_ROAD 00390 REAL, DIMENSION(KI) :: ZABS_SW_SNOW_ROOF 00391 REAL, DIMENSION(KI) :: ZABS_LW_SNOW_ROAD 00392 REAL, DIMENSION(KI) :: ZABS_LW_SNOW_ROOF 00393 REAL, DIMENSION(KI) :: ZABS_LW_ROAD 00394 REAL, DIMENSION(KI) :: ZABS_LW_WALL_A 00395 REAL, DIMENSION(KI) :: ZABS_LW_WALL_B 00396 REAL, DIMENSION(KI) :: ZABS_LW_ROOF 00397 REAL, DIMENSION(KI) :: ZABS_LW_GARDEN 00398 REAL, DIMENSION(KI) :: ZABS_LW_GREENROOF 00399 ! 00400 REAL, DIMENSION(KI) :: ZU_UTCI ! wind speed for the UTCI calculation (m/s) 00401 00402 REAL, DIMENSION(KI) :: ZALFAU ! V+(1) = alfa u'w'(1) + beta 00403 REAL, DIMENSION(KI) :: ZBETAU ! V+(1) = alfa u'w'(1) + beta 00404 REAL, DIMENSION(KI) :: ZALFAT ! Th+(1) = alfa w'th'(1) + beta 00405 REAL, DIMENSION(KI) :: ZBETAT ! Th+(1) = alfa w'th'(1) + beta 00406 REAL, DIMENSION(KI) :: ZALFAQ ! Q+(1) = alfa w'q'(1) + beta 00407 REAL, DIMENSION(KI) :: ZBETAQ ! Q+(1) = alfa w'q'(1) + beta 00408 !***** CANOPY ***** 00409 REAL, DIMENSION(KI) :: ZWAKE ! reduction of average wind speed 00410 ! ! in canyon due to direction average. 00411 ! new local variables after BEM 00412 ! 00413 REAL, DIMENSION(KI) :: ZCAP_SYS 00414 REAL, DIMENSION(KI) :: ZM_SYS 00415 REAL, DIMENSION(KI) :: ZCOP 00416 REAL, DIMENSION(KI) :: ZQ_SYS 00417 REAL, DIMENSION(KI) :: ZT_SYS 00418 REAL, DIMENSION(KI) :: ZTR_SW_WIN 00419 REAL, DIMENSION(KI) :: ZFAN_POWER 00420 REAL, DIMENSION(KI) :: ZABS_SW_WIN 00421 REAL, DIMENSION(KI) :: ZABS_LW_WIN 00422 REAL, DIMENSION(KI) :: ZH_BLD_COOL 00423 REAL, DIMENSION(KI) :: ZT_BLD_COOL 00424 REAL, DIMENSION(KI) :: ZH_BLD_HEAT 00425 REAL, DIMENSION(KI) :: ZLE_BLD_COOL 00426 REAL, DIMENSION(KI) :: ZLE_BLD_HEAT 00427 REAL, DIMENSION(KI) :: ZH_WASTE 00428 REAL, DIMENSION(KI) :: ZLE_WASTE 00429 REAL, DIMENSION(KI) :: ZHVAC_COOL 00430 REAL, DIMENSION(KI) :: ZHVAC_HEAT 00431 00432 !new local variables for UTCI calculation 00433 REAL, DIMENSION(KI) :: ZEMIT_LW_GRND 00434 REAL, DIMENSION(KI) :: ZEMIT_LW_FAC 00435 REAL, DIMENSION(KI) :: ZT_RAD_IND ! Indoor mean radiant temperature [K] 00436 REAL, DIMENSION(KI) :: ZREF_SW_GRND ! total solar rad reflected from ground 00437 REAL, DIMENSION(KI) :: ZREF_SW_FAC ! total solar rad reflected from facade 00438 REAL, DIMENSION(KI) :: ZHU_BLD 00439 REAL, DIMENSION(KI) :: ZAVG_TI_BLD 00440 REAL, DIMENSION(KI) :: ZAVG_QI_BLD 00441 REAL, DIMENSION(KI) :: ZF1_o_B 00442 REAL, DIMENSION(KI,SIZE(PDIR_SW,2)) :: ZDIR_SWB ! total direct SW per band 00443 REAL, DIMENSION(KI,SIZE(PSCA_SW,2)) :: ZSCA_SWB ! total diffuse SW per band 00444 ! 00445 REAL, DIMENSION(KI) :: ZCOEF 00446 ! 00447 REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST 00448 REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST 00449 REAL :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST 00450 ! 00451 INTEGER :: JI 00452 INTEGER :: JLAYER 00453 INTEGER :: JJ 00454 ! 00455 ! number of TEB patches 00456 ! 00457 INTEGER :: JTEB_PATCH ! loop counter 00458 ! 00459 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00460 ! 00461 !------------------------------------------------------------------------------------- 00462 ! Preliminaries: 00463 !------------------------------------------------------------------------------------- 00464 IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_N',0,ZHOOK_HANDLE) 00465 IF (HTEST/='OK') THEN 00466 CALL ABOR1_SFX('COUPLING_TEBN: FATAL ERROR DURING ARGUMENT TRANSFER') 00467 END IF 00468 00469 !------------------------------------------------------------------------------------- 00470 ! 00471 ! scalar fluxes 00472 ! 00473 PSFTS(:,:) = 0. 00474 ! 00475 ! broadband radiative fluxes 00476 ! 00477 ZDIR_SW(:) = 0. 00478 ZSCA_SW(:) = 0. 00479 DO JSWB=1,KSW 00480 !add directionnal contrib from scattered radiation 00481 CALL CIRCUMSOLAR_RAD(PDIR_SW(:,JSWB), PSCA_SW(:,JSWB), PZENITH, ZF1_o_B) 00482 ZDIR_SWB(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB) * ZF1_o_B 00483 ZSCA_SWB(:,JSWB) = PSCA_SW(:,JSWB) * (1. - ZF1_o_B) 00484 !add directionnal contrib from scattered radiation 00485 DO JJ=1,SIZE(PDIR_SW,1) 00486 ZDIR_SW(JJ) = ZDIR_SW(JJ) + ZDIR_SWB(JJ,JSWB) 00487 ZSCA_SW(JJ) = ZSCA_SW(JJ) + ZSCA_SWB(JJ,JSWB) 00488 ENDDO 00489 END DO 00490 ! 00491 DO JJ=1,KI 00492 ! specific humidity (conversion from kg/m3 to kg/kg) 00493 ! 00494 ZQA(JJ) = PQA(JJ) / PRHOA(JJ) 00495 ! 00496 ! wind 00497 ! 00498 ZWIND(JJ) = SQRT(PU(JJ)**2+PV(JJ)**2) 00499 ! 00500 ENDDO 00501 ! method of wind coupling 00502 ! 00503 IF (HCOUPLING=='I') THEN 00504 ZPEW_A_COEF = PPEW_A_COEF 00505 ZPEW_B_COEF = PPEW_B_COEF 00506 ELSE 00507 ZPEW_A_COEF = 0. 00508 ZPEW_B_COEF = ZWIND 00509 END IF 00510 ! 00511 ! 00512 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00513 ! Time evolution 00514 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00515 ! 00516 TTIME%TIME = TTIME%TIME + PTSTEP 00517 CALL ADD_FORECAST_TO_DATE_SURF(TTIME%TDATE%YEAR,TTIME%TDATE%MONTH,TTIME%TDATE%DAY,TTIME%TIME) 00518 ! 00519 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00520 ! Anthropogenic fluxes (except building heating) 00521 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00522 ! 00523 ZBEGIN_TRAFFIC_TIME = 21600. 00524 ZEND_TRAFFIC_TIME = 64800. 00525 ! 00526 WHERE( PTSUN>ZBEGIN_TRAFFIC_TIME & 00527 .AND. PTSUN<ZEND_TRAFFIC_TIME ) 00528 ZH_TRAFFIC (:) = XH_TRAFFIC (:) 00529 ZLE_TRAFFIC (:) = XLE_TRAFFIC (:) 00530 ELSEWHERE 00531 ZH_TRAFFIC (:) = 0. 00532 ZLE_TRAFFIC (:) = 0. 00533 END WHERE 00534 ! 00535 !-------------------------------------------------------------------------------------- 00536 ! Canyon forcing for TEB 00537 !-------------------------------------------------------------------------------------- 00538 !------------------------------------------------------------------------------------- 00539 ! Town averaged quantities to force canopy atmospheric layers 00540 !------------------------------------------------------------------------------------- 00541 00542 DO JTEB_PATCH=1,NTEB_PATCH 00543 CALL GOTO_TEB(JTEB_PATCH) 00544 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_BLD, XBLD ) 00545 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_BLD_HEIGHT, XBLD_HEIGHT ) 00546 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_WALL_O_HOR, XWALL_O_HOR ) 00547 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_CAN_HW_RATIO,XCAN_HW_RATIO) 00548 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_Z0_TOWN, XZ0_TOWN ) 00549 END DO 00550 ! 00551 IF (LCANOPY) THEN 00552 !------------------------------------------------------------------------------------- 00553 ! Updates canopy vertical grid as a function of forcing height 00554 !------------------------------------------------------------------------------------- 00555 ! 00556 !* determines where is the forcing level and modifies the upper levels of the canopy grid 00557 ! 00558 CALL CANOPY_GRID_UPDATE(KI,NLVL,ZAVG_BLD_HEIGHT,ZAVG_BLD_HEIGHT+PUREF,XZ,XZF,XDZ,XDZF) 00559 ! 00560 !* Initialisations of T, Q, TKE and wind at first time step 00561 ! 00562 00563 IF(ANY(XT(:,:) == XUNDEF)) THEN 00564 DO JLAYER=1,NLVL 00565 XT(:,JLAYER) = PTA(:) 00566 XQ(:,JLAYER) = PQA(:) 00567 XU(:,JLAYER) = 2./XPI * ZWIND(:) & 00568 * LOG( ( 2.* XBLD_HEIGHT(:)/3.) / XZ0_TOWN(:)) & 00569 / LOG( (PUREF(:)+ 2.* XBLD_HEIGHT(:)/3.) / XZ0_TOWN(:)) 00570 END DO 00571 XTKE(:,:) = 1. 00572 ENDIF 00573 ! 00574 !* default forcing above roof: forcing level 00575 ZUREF(:) = PUREF(:) 00576 ZZREF(:) = PZREF(:) 00577 ZUA(:) = XU(:,NLVL) 00578 ZTA(:) = XT(:,NLVL) 00579 ZQA(:) = XQ(:,NLVL)/PRHOA(:) 00580 ZPA(:) = XP(:,NLVL) 00581 !* for the time being, only one value is kept for wall in-canyon forcing, in the middle of the canyon 00582 ZU_CANYON(:) = ZUA(:) 00583 ZT_CANYON(:) = ZTA(:) 00584 ZQ_CANYON(:) = ZQA(:) 00585 DO JLAYER=1,NLVL-1 00586 DO JI=1,KI 00587 !* finds middle canyon layer 00588 IF (XZ(JI,JLAYER)<ZAVG_BLD_HEIGHT(JI)/2. .AND. XZ(JI,JLAYER+1)>=ZAVG_BLD_HEIGHT(JI)/2.) THEN 00589 ZCOEF(JI) = (ZAVG_BLD_HEIGHT(JI)/2.-XZ(JI,JLAYER))/(XZ(JI,JLAYER+1)-XZ(JI,JLAYER)) 00590 ZU_CANYON(JI) = XU(JI,JLAYER) + ZCOEF(JI) * (XU(JI,JLAYER+1)-XU(JI,JLAYER)) 00591 ZT_CANYON(JI) = XT(JI,JLAYER) + ZCOEF(JI) * (XT(JI,JLAYER+1)-XT(JI,JLAYER)) 00592 ZQ_CANYON(JI) =(XQ(JI,JLAYER) + ZCOEF(JI) * (XQ(JI,JLAYER+1)-XQ(JI,JLAYER)))/PRHOA(JI) 00593 END IF 00594 !* finds layer just above roof (at least 1m above roof) 00595 IF (XZ(JI,JLAYER)<ZAVG_BLD_HEIGHT(JI)+1. .AND. XZ(JI,JLAYER+1)>=ZAVG_BLD_HEIGHT(JI)+1.) THEN 00596 ZUREF(JI) = XZ(JI,JLAYER+1) - ZAVG_BLD_HEIGHT(JI) 00597 ZZREF(JI) = XZ(JI,JLAYER+1) - ZAVG_BLD_HEIGHT(JI) 00598 ZTA (JI) = XT(JI,JLAYER+1) 00599 ZQA (JI) = XQ(JI,JLAYER+1)/PRHOA(JI) 00600 !ZUA (JI) = XU(JI,JLAYER+1) 00601 ZUA (JI) = MAX(XU(JI,JLAYER+1) - 2.*SQRT(XTKE(JI,JLAYER+1)) , XU(JI,JLAYER+1)/3.) 00602 ZPA (JI) = XP(JI,JLAYER+1) 00603 ZLMO (JI) = XLMO(JI,JLAYER+1) 00604 END IF 00605 END DO 00606 END DO 00607 ZU_CANYON= MAX(ZU_CANYON,0.2) 00608 ZU_LOWCAN=XU(:,1) 00609 ZT_LOWCAN=XT(:,1) 00610 ZQ_LOWCAN=XQ(:,1) / PRHOA(:) 00611 ZZ_LOWCAN=XZ(:,1) 00612 WHERE(ZPA==XUNDEF) ZPA = PPA ! security for first time step 00613 ! 00614 !------------------------------------------------------------------------------------- 00615 ! determine the vertical profile for mixing and dissipative lengths (at full levels) 00616 !------------------------------------------------------------------------------------- 00617 ! 00618 ! frontal density 00619 ZLAMBDA_F(:) = ZAVG_CAN_HW_RATIO*ZAVG_BLD / (0.5*XPI) 00620 ! 00621 CALL SM10(XZ,ZAVG_BLD_HEIGHT,ZLAMBDA_F,ZL) 00622 ! 00623 !------------------------------------------------------------------------------------- 00624 ! computes coefficients for implicitation 00625 !------------------------------------------------------------------------------------- 00626 ! 00627 ZAVG_UW_GRND(:) = 0. 00628 ZAVG_DUWDU_GRND(:) = 0. 00629 ZAVG_UW_ROOF(:) = 0. 00630 ZAVG_DUWDU_ROOF(:) = 0. 00631 ZAVG_H_GRND(:) = 0. 00632 ZAVG_H_WALL(:) = 0. 00633 ZAVG_H_ROOF(:) = 0. 00634 ZAVG_E_GRND(:) = 0. 00635 ZAVG_E_ROOF(:) = 0. 00636 ZAVG_AC_GRND(:) = 0. 00637 ZAVG_AC_GRND_WAT(:) = 0. 00638 ZSFLUX_U(:) = 0. 00639 ZSFLUX_T(:) = 0. 00640 ZSFLUX_Q(:) = 0. 00641 ! 00642 DO JLAYER=1,NLVL-1 00643 !* Monin-Obuhkov theory not used inside the urban canopy 00644 ! => neutral mixing if layer is below : (roof level +1 meter) 00645 WHERE (XZ(:,JLAYER)<=ZAVG_BLD_HEIGHT(:)+1.) XLMO(:,JLAYER) = XUNDEF 00646 ENDDO 00647 ! 00648 ! 00649 !* computes tendencies on wind and Tke due to canopy 00650 CALL TEB_CANOPY(KI,NLVL,XZ,XZF,XDZ,XDZF,ZAVG_BLD,ZAVG_BLD_HEIGHT,ZAVG_WALL_O_HOR, & 00651 PPA,PRHOA,XU, & 00652 ZAVG_DUWDU_GRND, ZAVG_UW_ROOF, ZAVG_DUWDU_ROOF, & 00653 ZAVG_H_WALL,ZAVG_H_ROOF,ZAVG_E_ROOF,ZAVG_AC_GRND,ZAVG_AC_GRND_WAT, & 00654 ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE,ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ) 00655 ! 00656 !* computes coefficients for implicitation 00657 CALL CANOPY_EVOL(KI,NLVL,PTSTEP,1, & 00658 ZL,ZWIND,PTA,PQA,PPA,PRHOA, & 00659 ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, & 00660 ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, & 00661 ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, & 00662 XZ,XZF,XDZ,XDZF,XU,XTKE,XT,XQ,XLMO, & 00663 XLM,XLEPS,XP,ZAVG_USTAR, & 00664 ZALFAU,ZBETAU,ZALFAT,ZBETAT,ZALFAQ,ZBETAQ) 00665 ! 00666 ZPEW_A_COEF_LOWCAN = - ZALFAU / PRHOA 00667 ZPEW_B_COEF_LOWCAN = ZBETAU 00668 ! 00669 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00670 ELSE ! no canopy case 00671 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00672 DO JI=1,KI 00673 !* skimming flow for h/w>1 (maximum effect of direction on wind in the canyon); 00674 !* isolated flow for h/w<0.5 (wind is the same in large streets for all dir.) 00675 !* wake flow between. 00676 ! 00677 ZWAKE(JI)= 1. + (2./XPI-1.) * 2. * (ZAVG_CAN_HW_RATIO(JI)-0.5) 00678 ZWAKE(JI)= MAX(MIN(ZWAKE(JI),1.),2./XPI) 00679 ! 00680 !* Estimation of canyon wind speed from wind just above roof level 00681 ! (at 1.33h). Wind at 1.33h is estimated using the log law. 00682 ! 00683 IF (ZAVG_BLD_HEIGHT(JI) .GT. 0.) THEN 00684 ZU_CANYON(JI) = ZWAKE(JI) * EXP(-ZAVG_CAN_HW_RATIO(JI)/4.) * ZWIND(JI) & 00685 * LOG( ( 2.* ZAVG_BLD_HEIGHT(JI)/3.) / ZAVG_Z0_TOWN(JI)) & 00686 / LOG( (PUREF(JI)+ 2.* ZAVG_BLD_HEIGHT(JI)/3.) / ZAVG_Z0_TOWN(JI)) 00687 ZZ_LOWCAN(JI) = ZAVG_BLD_HEIGHT(JI) / 2. 00688 ELSE 00689 ZU_CANYON(JI) = ZWIND(JI) 00690 ZZ_LOWCAN(JI) = PZREF(JI) 00691 ENDIF 00692 END DO 00693 ! 00694 !* Without SBL scheme, canyon air is assumed at mid height 00695 ZU_LOWCAN=ZU_CANYON 00696 ZT_LOWCAN=XT_CANYON 00697 ZQ_LOWCAN=XQ_CANYON 00698 ZT_CANYON=XT_CANYON 00699 ZQ_CANYON=XQ_CANYON 00700 ZUREF =PUREF 00701 ZZREF =PZREF 00702 ZTA =PTA 00703 ZUA =ZWIND 00704 ZPA =PPA 00705 ZPEW_A_COEF_LOWCAN = 0. 00706 ZPEW_B_COEF_LOWCAN = ZU_CANYON 00707 END IF 00708 ! 00709 ! Exner functions 00710 ! 00711 ZEXNS (:) = (PPS(:)/XP00)**(XRD/XCPD) 00712 ZEXNA (:) = (ZPA(:)/XP00)**(XRD/XCPD) 00713 00714 !-------------------------------------------------------------------------------------- 00715 ! Over Urban surfaces/towns: 00716 !-------------------------------------------------------------------------------------- 00717 ! 00718 DO JTEB_PATCH=1,NTEB_PATCH 00719 CALL GOTO_TEB(JTEB_PATCH) 00720 ! 00721 ZT_CAN=ZT_CANYON 00722 ZQ_CAN=ZQ_CANYON 00723 ! 00724 IF (LCANOPY) THEN 00725 XT_CANYON(:) = ZT_CANYON(:) 00726 XQ_CANYON(:) = ZQ_CANYON(:) 00727 END IF 00728 ! 00729 ZLESNOW_ROOF(:) = 0. 00730 ZLESNOW_ROAD(:) = 0. 00731 ZG_GREENROOF_ROOF(:) = 0. 00732 ! 00733 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00734 ! Reinitialize shading of windows when changing day 00735 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00736 ! 00737 IF (CBEM=='BEM') & 00738 WHERE (PTSUN .LT. PTSTEP + 1E-3) LSHAD_DAY(:) = .FALSE. 00739 ! 00740 ! 00741 CALL TEB_GARDEN (CZ0H, CIMPLICIT_WIND, CROAD_DIR, CWALL_OPT, & 00742 TTIME, PTSUN, ZT_CAN, ZQ_CAN, ZU_CANYON, & 00743 ZT_LOWCAN, ZQ_LOWCAN, ZU_LOWCAN, ZZ_LOWCAN, & 00744 XTI_BLD, & 00745 XT_ROOF, XT_ROAD, XT_WALL_A, XT_WALL_B, XWS_ROOF,XWS_ROAD, & 00746 TSNOW_ROOF%SCHEME, & 00747 TSNOW_ROOF%WSNOW(:,:,1), TSNOW_ROOF%T(:,:,1), & 00748 TSNOW_ROOF%RHO(:,:,1), TSNOW_ROOF%ALB(:,1), & 00749 TSNOW_ROOF%TS(:,1), TSNOW_ROOF%EMIS(:,1), & 00750 TSNOW_ROAD%SCHEME, & 00751 TSNOW_ROAD%WSNOW(:,:,1), TSNOW_ROAD%T(:,:,1), & 00752 TSNOW_ROAD%RHO(:,:,1), TSNOW_ROAD%ALB(:,1), & 00753 TSNOW_ROAD%TS(:,1), TSNOW_ROAD%EMIS(:,1), & 00754 ZPEW_A_COEF, ZPEW_B_COEF, & 00755 ZPEW_A_COEF_LOWCAN, ZPEW_B_COEF_LOWCAN, & 00756 PPS, ZPA, ZEXNS, ZEXNA, ZTA, ZQA, PRHOA, PCO2, & 00757 PLW, ZDIR_SWB, ZSCA_SWB, PSW_BANDS, KSW, PZENITH, PAZIM, & 00758 PRAIN, PSNOW, ZZREF, ZUREF, ZUA, & 00759 ZH_TRAFFIC, ZLE_TRAFFIC, XH_INDUSTRY, XLE_INDUSTRY, & 00760 PTSTEP, & 00761 XZ0_TOWN, & 00762 XBLD, XGARDEN, XROAD_DIR, XROAD, XGREENROOF, & 00763 XBLD_HEIGHT, XWALL_O_HOR, XCAN_HW_RATIO, & 00764 XROAD_O_GRND, XGARDEN_O_GRND, XWALL_O_GRND, & 00765 XALB_ROOF, XEMIS_ROOF, & 00766 XHC_ROOF,XTC_ROOF,XD_ROOF, & 00767 XALB_ROAD, XEMIS_ROAD, XSVF_ROAD, & 00768 XHC_ROAD,XTC_ROAD,XD_ROAD, & 00769 XALB_WALL, XEMIS_WALL, XSVF_WALL, & 00770 XSVF_GARDEN, & 00771 XHC_WALL,XTC_WALL,XD_WALL, & 00772 ZRN_ROOF, ZH_ROOF, ZLE_ROOF, ZLEW_ROOF, ZGFLUX_ROOF, & 00773 ZRUNOFF_ROOF, & 00774 ZRN_ROAD, ZH_ROAD, ZLE_ROAD, ZLEW_ROAD, ZGFLUX_ROAD, & 00775 ZRUNOFF_ROAD, & 00776 ZRN_WALL_A, ZH_WALL_A, ZLE_WALL_A, ZGFLUX_WALL_A, & 00777 ZRN_WALL_B, ZH_WALL_B, ZLE_WALL_B, ZGFLUX_WALL_B, & 00778 ZRN_GARDEN,ZH_GARDEN,ZLE_GARDEN,ZGFLUX_GARDEN, & 00779 ZRN_GREENROOF,ZH_GREENROOF,ZLE_GREENROOF,ZGFLUX_GREENROOF, & 00780 ZRN_STRLROOF,ZH_STRLROOF,ZLE_STRLROOF,ZGFLUX_STRLROOF, & 00781 ZRN_BLT,ZH_BLT,ZLE_BLT,ZGFLUX_BLT, & 00782 ZRNSNOW_ROOF, ZHSNOW_ROOF, ZLESNOW_ROOF, ZGSNOW_ROOF, & 00783 ZMELT_ROOF, & 00784 ZRNSNOW_ROAD, ZHSNOW_ROAD, ZLESNOW_ROAD, ZGSNOW_ROAD, & 00785 ZMELT_ROAD, & 00786 ZRN_GRND, ZH_GRND, ZLE_GRND, ZGFLUX_GRND, & 00787 ZRN, ZH, ZLE, ZGFLUX, ZEVAP, ZRUNOFF, ZSFCO2, & 00788 ZUW_GRND, ZUW_ROOF, ZDUWDU_GRND, ZDUWDU_ROOF, & 00789 ZUSTAR, ZCD, ZCDN, ZCH, ZRI, & 00790 ZTRAD, ZEMIS, ZDIR_ALB, ZSCA_ALB, ZRESA_TOWN, ZDQS_TOWN, & 00791 ZQF_TOWN, ZQF_BLD, & 00792 ZFLX_BLD, ZAC_ROAD, ZAC_GARDEN, ZAC_GREENROOF, & 00793 ZAC_ROAD_WAT, ZAC_GARDEN_WAT, ZAC_GREENROOF_WAT, & 00794 ZABS_SW_ROOF,ZABS_LW_ROOF, & 00795 ZABS_SW_SNOW_ROOF,ZABS_LW_SNOW_ROOF, & 00796 ZABS_SW_ROAD,ZABS_LW_ROAD, & 00797 ZABS_SW_SNOW_ROAD,ZABS_LW_SNOW_ROAD, & 00798 ZABS_SW_WALL_A, ZABS_LW_WALL_A, & 00799 ZABS_SW_WALL_B, ZABS_LW_WALL_B, & 00800 ZABS_SW_GARDEN,ZABS_LW_GARDEN, & 00801 ZABS_SW_GREENROOF,ZABS_LW_GREENROOF, ZG_GREENROOF_ROOF, & 00802 ZRUNOFF_GREENROOF, ZDRAIN_GREENROOF, & 00803 CCOOL_COIL, XF_WATER_COND, CHEAT_COIL, CNATVENT, & 00804 KDAY, XAUX_MAX, XT_FLOOR, XT_MASS, ZH_BLD_COOL, & 00805 ZT_BLD_COOL, ZH_BLD_HEAT, ZLE_BLD_COOL, ZLE_BLD_HEAT, ZH_WASTE, & 00806 ZLE_WASTE, XF_WASTE_CAN, ZHVAC_COOL, ZHVAC_HEAT, XQIN, XQIN_FRAD,& 00807 XQIN_FLAT, XGR, XEFF_HEAT, XINF, XTCOOL_TARGET, & 00808 XTHEAT_TARGET, XHR_TARGET, XT_WIN2, XQI_BLD, XV_VENT, & 00809 XCAP_SYS_HEAT, XCAP_SYS_RAT, XT_ADP, XM_SYS_RAT, XCOP_RAT, & 00810 ZCAP_SYS, ZM_SYS, ZCOP, ZQ_SYS, ZT_SYS, ZTR_SW_WIN, ZFAN_POWER, & 00811 XHC_FLOOR, XTC_FLOOR, XD_FLOOR, XT_WIN1, ZABS_SW_WIN, & 00812 ZABS_LW_WIN, XSHGC, XSHGC_SH, XUGG_WIN, XALB_WIN, XABS_WIN, & 00813 ZEMIT_LW_FAC, ZEMIT_LW_GRND, ZT_RAD_IND, ZREF_SW_GRND, & 00814 ZREF_SW_FAC, ZHU_BLD, PTIME, LSHADE, LSHAD_DAY, LNATVENT_NIGHT, & 00815 CBEM, XN_FLOOR, XWALL_O_BLD, XGLAZ_O_BLD, XMASS_O_BLD, & 00816 XFLOOR_HW_RATIO, & 00817 XF_FLOOR_MASS, XF_FLOOR_WALL, XF_FLOOR_WIN, & 00818 XF_FLOOR_ROOF, XF_WALL_FLOOR, XF_WALL_MASS, & 00819 XF_WALL_WIN, XF_WIN_FLOOR, XF_WIN_MASS, XF_WIN_WALL, & 00820 XF_MASS_FLOOR, XF_MASS_WALL, XF_MASS_WIN, LCANOPY, XTRAN_WIN, & 00821 CCH_BEM, XROUGH_ROOF, XROUGH_WALL, XF_WIN_WIN ) 00822 00823 00824 ! 00825 IF (.NOT. LCANOPY) THEN 00826 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_T_CANYON,ZT_CAN) 00827 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_Q_CANYON,ZQ_CAN) 00828 ! 00829 ! Momentum fluxes 00830 ! 00831 ZSFU = 0. 00832 ZSFV = 0. 00833 DO JJ=1,SIZE(PU) 00834 IF (ZWIND(JJ)>0.) THEN 00835 ZCOEF(JJ) = - PRHOA(JJ) * ZUSTAR(JJ)**2 / ZWIND(JJ) 00836 ZSFU(JJ) = ZCOEF(JJ) * PU(JJ) 00837 ZSFV(JJ) = ZCOEF(JJ) * PV(JJ) 00838 ENDIF 00839 ENDDO 00840 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFU,ZSFU) 00841 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFV,ZSFV) 00842 ! 00843 ENDIF 00844 ! 00845 !------------------------------------------------------------------------------------- 00846 ! Outputs: 00847 !------------------------------------------------------------------------------------- 00848 ! 00849 ! Grid box average fluxes/properties: Arguments and standard diagnostics 00850 ! 00851 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFTH,ZH) 00852 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFTQ,ZEVAP) 00853 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFCO2,ZSFCO2) 00854 ! 00855 ! 00856 ! Albedo for each wavelength and patch 00857 ! 00858 DO JSWB=1,SIZE(PSW_BANDS) 00859 DO JJ=1,SIZE(ZDIR_ALB) 00860 ZDIR_ALB_PATCH(JJ,JSWB,JTEB_PATCH) = ZDIR_ALB(JJ) 00861 ZSCA_ALB_PATCH(JJ,JSWB,JTEB_PATCH) = ZSCA_ALB(JJ) 00862 ENDDO 00863 END DO 00864 ! 00865 ! emissivity and radiative temperature 00866 ! 00867 ZEMIS_PATCH(:,JTEB_PATCH) = ZEMIS 00868 ZTRAD_PATCH(:,JTEB_PATCH) = ZTRAD 00869 ! 00870 ! computes some aggregated diagnostics 00871 ! 00872 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_CD ,ZCD ) 00873 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_CDN,ZCDN) 00874 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_RI ,ZRI ) 00875 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_CH ,ZCH ) 00876 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_RN ,ZRN ) 00877 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_H ,ZH ) 00878 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_LE ,ZLE ) 00879 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_GFLUX ,ZGFLUX ) 00880 ! 00881 !* warning: aerodynamical resistance does not yet take into account gardens 00882 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_RESA_TOWN,1./ZRESA_TOWN) 00883 IF (JTEB_PATCH==NTEB_PATCH) ZAVG_RESA_TOWN = 1./ZAVG_RESA_TOWN 00884 ! 00885 !------------------------------------------------------------------------------------- 00886 ! Diagnostics on each patch 00887 !------------------------------------------------------------------------------------- 00888 ! 00889 CALL DIAG_MISC_TEB_n(PTSTEP, ZDQS_TOWN, ZQF_BLD, ZQF_TOWN, ZFLX_BLD, & 00890 ZRN_ROAD, ZH_ROAD, ZLE_ROAD, ZGFLUX_ROAD, & 00891 ZRN_WALL_A, ZH_WALL_A, ZGFLUX_WALL_A, & 00892 ZRN_WALL_B, ZH_WALL_B, ZGFLUX_WALL_B, & 00893 ZRN_ROOF, ZH_ROOF, ZLE_ROOF, ZGFLUX_ROOF, ZRUNOFF, & 00894 ZRN_STRLROOF, ZH_STRLROOF, ZLE_STRLROOF, ZGFLUX_STRLROOF, & 00895 ZRN_GREENROOF, ZH_GREENROOF, & 00896 ZLE_GREENROOF, ZGFLUX_GREENROOF, ZG_GREENROOF_ROOF, & 00897 ZRUNOFF_GREENROOF, ZDRAIN_GREENROOF, & 00898 ZRN_GARDEN,ZH_GARDEN,ZLE_GARDEN,ZGFLUX_GARDEN, & 00899 ZRN_BLT,ZH_BLT,ZLE_BLT,ZGFLUX_BLT, & 00900 ZABS_SW_ROOF,ZABS_LW_ROOF, & 00901 ZABS_SW_SNOW_ROOF,ZABS_LW_SNOW_ROOF, & 00902 ZABS_SW_ROAD,ZABS_LW_ROAD, & 00903 ZABS_SW_SNOW_ROAD,ZABS_LW_SNOW_ROAD, & 00904 ZABS_SW_WALL_A, ZABS_LW_WALL_A, ZABS_SW_WALL_B, & 00905 ZABS_LW_WALL_B, & 00906 ZABS_SW_GARDEN,ZABS_LW_GARDEN, & 00907 ZABS_SW_GREENROOF,ZABS_LW_GREENROOF, & 00908 ZH_BLD_COOL, ZT_BLD_COOL, & 00909 ZH_BLD_HEAT, ZLE_BLD_COOL, ZLE_BLD_HEAT, & 00910 ZH_WASTE, ZLE_WASTE, ZHVAC_COOL, & 00911 ZHVAC_HEAT, ZCAP_SYS, ZM_SYS, ZCOP, & 00912 ZQ_SYS, ZT_SYS, ZTR_SW_WIN, ZFAN_POWER, & 00913 ZABS_SW_WIN, ZABS_LW_WIN ) 00914 ! 00915 ! 00916 !------------------------------------------------------------------------------------- 00917 ! Computes averaged parameters necessary for UTCI 00918 !------------------------------------------------------------------------------------- 00919 ! 00920 IF (N2M >0 .AND. LUTCI) THEN 00921 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_REF_SW_GRND ,ZREF_SW_GRND ) 00922 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_REF_SW_FAC ,ZREF_SW_FAC ) 00923 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_SCA_SW ,ZSCA_SW ) 00924 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_DIR_SW ,ZDIR_SW ) 00925 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_EMIT_LW_FAC ,ZEMIT_LW_FAC ) 00926 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_EMIT_LW_GRND,ZEMIT_LW_GRND) 00927 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_T_RAD_IND ,ZT_RAD_IND ) 00928 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_TI_BLD ,XTI_BLD ) 00929 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_QI_BLD ,XQI_BLD ) 00930 END IF 00931 ! 00932 !------------------------------------------------------------------------------------- 00933 ! Use of the canopy version of TEB 00934 !------------------------------------------------------------------------------------- 00935 ! 00936 IF (LCANOPY) THEN 00937 !------------------------------------------------------------------------------------- 00938 ! Town averaged quantities to force canopy atmospheric layers 00939 !------------------------------------------------------------------------------------- 00940 00941 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_DUWDU_GRND ,ZDUWDU_GRND ) 00942 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_UW_ROOF ,ZUW_ROOF) 00943 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_DUWDU_ROOF ,ZDUWDU_ROOF) 00944 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_H_WALL ,0.5*(ZH_WALL_A+ZH_WALL_B)) 00945 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_H_ROOF ,(ZH_ROOF+XH_INDUSTRY)) 00946 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_E_ROOF ,(ZLE_ROOF+XLE_INDUSTRY)/XLVTT) 00947 ! 00948 !------------------------------------------------------------------------------------- 00949 ! Computes the impact of canopy and surfaces on air 00950 !------------------------------------------------------------------------------------- 00951 ! 00952 ZAC_GRND (:) = (XROAD(:)*ZAC_ROAD (:) + XGARDEN(:)*ZAC_GARDEN (:)) / (XROAD(:)+XGARDEN(:)) 00953 ZAC_GRND_WAT(:) = (XROAD(:)*ZAC_ROAD_WAT(:) + XGARDEN(:)*ZAC_GARDEN_WAT(:)) / (XROAD(:)+XGARDEN(:)) 00954 ! 00955 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_AC_GRND ,ZAC_GRND ) 00956 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_AC_GRND_WAT ,ZAC_GRND_WAT) 00957 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZSFLUX_U ,ZUW_GRND * (1.-XBLD)) 00958 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZSFLUX_T ,ZH_GRND * (1.-XBLD)/XCPD/PRHOA) 00959 CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZSFLUX_Q ,ZLE_GRND * (1.-XBLD)/XLVTT) 00960 ! 00961 00962 END IF 00963 ! 00964 !------------------------------------------------------------------------------------- 00965 ! end of loop on TEB patches 00966 END DO 00967 !------------------------------------------------------------------------------------- 00968 ! 00969 !------------------------------------------------------------------------------------- 00970 !* Evolution of canopy air if canopy option is active 00971 !------------------------------------------------------------------------------------- 00972 ! 00973 IF (LCANOPY) THEN 00974 ! 00975 !------------------------------------------------------------------------------------- 00976 !* Impact of TEB fluxes on the air 00977 !------------------------------------------------------------------------------------- 00978 ! 00979 CALL TEB_CANOPY(KI,NLVL,XZ,XZF,XDZ,XDZF,ZAVG_BLD,ZAVG_BLD_HEIGHT,ZAVG_WALL_O_HOR, & 00980 PPA,PRHOA,XU, & 00981 ZAVG_DUWDU_GRND, ZAVG_UW_ROOF, ZAVG_DUWDU_ROOF, & 00982 ZAVG_H_WALL,ZAVG_H_ROOF,ZAVG_E_ROOF,ZAVG_AC_GRND,ZAVG_AC_GRND_WAT, & 00983 ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE,ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ) 00984 ! 00985 !------------------------------------------------------------------------------------- 00986 !* Evolution of canopy air due to these impacts 00987 !------------------------------------------------------------------------------------- 00988 ! 00989 CALL CANOPY_EVOL(KI,NLVL,PTSTEP,2, & 00990 ZL,ZWIND,PTA,PQA,PPA,PRHOA, & 00991 ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, & 00992 ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, & 00993 ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, & 00994 XZ,XZF,XDZ,XDZF,XU,XTKE,XT,XQ,XLMO,XLM,XLEPS,XP, & 00995 ZAVG_USTAR, & 00996 ZALFAU,ZBETAU,ZALFAT,ZBETAT,ZALFAQ,ZBETAQ ) 00997 ! 00998 ! 00999 !------------------------------------------------------------------------------------- 01000 ! Momentum fluxes in the case canopy is active 01001 !------------------------------------------------------------------------------------- 01002 ! 01003 PSFU=0. 01004 PSFV=0. 01005 ZAVG_Z0_TOWN(:) = MIN(ZAVG_Z0_TOWN(:),PUREF(:)*0.5) 01006 ZAVG_CDN=(XKARMAN/LOG(PUREF(:)/ZAVG_Z0_TOWN(:)))**2 01007 ZAVG_CD = ZAVG_CDN 01008 ZAVG_RI = 0. 01009 DO JJ=1,SIZE(PU) 01010 IF (ZWIND(JJ)>0.) THEN 01011 ZCOEF(JJ) = - PRHOA(JJ) * ZAVG_USTAR(JJ)**2 / ZWIND(JJ) 01012 PSFU(JJ) = ZCOEF(JJ) * PU(JJ) 01013 PSFV(JJ) = ZCOEF(JJ) * PV(JJ) 01014 ZAVG_CD(JJ) = ZAVG_USTAR(JJ)**2 / ZWIND(JJ)**2 01015 ZAVG_RI(JJ) = -XG/PTA(JJ)*ZSFLUX_T(JJ)/ZAVG_USTAR(JJ)**4 01016 ENDIF 01017 ENDDO 01018 ! 01019 !------------------------------------------------------------------------------------- 01020 ! End of specific case with canopy option 01021 !------------------------------------------------------------------------------------- 01022 ! 01023 END IF 01024 ! 01025 !------------------------------------------------------------------------------------- 01026 ! Outputs: 01027 !------------------------------------------------------------------------------------- 01028 ! 01029 ! Albedo, Emissivity and fraction at time t+1 01030 ! 01031 CALL AVERAGE_RAD(XTEB_PATCH, & 01032 ZDIR_ALB_PATCH, ZSCA_ALB_PATCH, ZEMIS_PATCH, ZTRAD_PATCH,& 01033 PDIR_ALB, PSCA_ALB, PEMIS, PTRAD ) 01034 01035 ! 01036 !------------------------------------------------------------------------------------- 01037 ! Scalar fluxes: 01038 !------------------------------------------------------------------------------------- 01039 ! 01040 ZAVG_USTAR (:) = SQRT(SQRT(PSFU**2+PSFV**2)) 01041 ! 01042 ! 01043 IF (NBEQ>0) THEN 01044 IF (CCH_DRY_DEP == "WES89") THEN 01045 CALL CH_DEP_TOWN(ZAVG_RESA_TOWN, ZAVG_USTAR, PTA, PTRAD, ZAVG_WALL_O_HOR,& 01046 PSV(:,NSV_CHSBEG:NSV_CHSEND), & 01047 CSV(NSV_CHSBEG:NSV_CHSEND), & 01048 XDEP(:,1:NBEQ) ) 01049 01050 DO JI=NSV_CHSBEG,NSV_CHSEND 01051 !cdir nodep 01052 DO JJ=1,SIZE(PSFTS,1) 01053 PSFTS(JJ,JI) = - PSV(JJ,JI) * XDEP(JJ,JI-NSV_CHSBEG+1) 01054 ENDDO 01055 ENDDO 01056 01057 IF (NAEREQ > 0 ) THEN 01058 CALL CH_AER_DEP(PSV(:,NSV_AERBEG:NSV_AEREND),& 01059 PSFTS(:,NSV_AERBEG:NSV_AEREND),& 01060 ZAVG_USTAR,ZAVG_RESA_TOWN,PTA,PRHOA) 01061 END IF 01062 01063 ELSE 01064 DO JI=NSV_CHSBEG,NSV_CHSEND 01065 PSFTS(:,JI) =0. 01066 ENDDO 01067 IF(NSV_AERBEG.LT.NSV_AEREND) THEN 01068 DO JI=NSV_AERBEG,NSV_AEREND 01069 PSFTS(:,JI) =0. 01070 ENDDO 01071 ENDIF 01072 ENDIF 01073 ENDIF 01074 01075 IF (NDSTEQ>0) THEN 01076 CALL DSLT_DEP(PSV(:,NSV_DSTBEG:NSV_DSTEND), PSFTS(:,NSV_DSTBEG:NSV_DSTEND), & 01077 ZUSTAR, ZRESA_TOWN, PTA, PRHOA, XEMISSIG_DST, XEMISRADIUS_DST, & 01078 JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, & 01079 ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, & 01080 CVERMOD ) 01081 01082 CALL MASSFLUX2MOMENTFLUX( & 01083 PSFTS(:,NSV_DSTBEG:NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments 01084 PRHOA, & !I [kg/m3] air density 01085 XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3) 01086 XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3) 01087 NDSTMDE, & 01088 ZCONVERTFACM0_DST, & 01089 ZCONVERTFACM6_DST, & 01090 ZCONVERTFACM3_DST, & 01091 LVARSIG_DST, LRGFIX_DST ) 01092 ENDIF 01093 IF (NSLTEQ>0) THEN 01094 CALL DSLT_DEP(PSV(:,NSV_SLTBEG:NSV_SLTEND), PSFTS(:,NSV_SLTBEG:NSV_SLTEND), & 01095 ZUSTAR, ZRESA_TOWN, PTA, PRHOA, XEMISSIG_SLT, XEMISRADIUS_SLT, & 01096 JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, & 01097 ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, & 01098 CVERMOD ) 01099 01100 CALL MASSFLUX2MOMENTFLUX( & 01101 PSFTS(:,NSV_SLTBEG:NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments 01102 PRHOA, & !I [kg/m3] air density 01103 XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3) 01104 XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3) 01105 NSLTMDE, & 01106 ZCONVERTFACM0_SLT, & 01107 ZCONVERTFACM6_SLT, & 01108 ZCONVERTFACM3_SLT, & 01109 LVARSIG_SLT, LRGFIX_SLT ) 01110 ENDIF 01111 ! 01112 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01113 ! Inline diagnostics 01114 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01115 ! 01116 CALL DIAG_INLINE_TEB_n(LCANOPY, PTA, PTRAD, ZQA, PPA, PPS, PRHOA, & 01117 PU, PV, ZWIND, PZREF, PUREF, & 01118 ZAVG_CD, ZAVG_CDN, ZAVG_RI, ZAVG_CH, ZAVG_Z0_TOWN, & 01119 PTRAD, PEMIS, PDIR_ALB, PSCA_ALB, & 01120 PLW, ZDIR_SWB, ZSCA_SWB, & 01121 PSFTH, PSFTQ, PSFU, PSFV, PSFCO2, & 01122 ZAVG_RN, ZAVG_H, ZAVG_LE, ZAVG_GFLUX ) 01123 ! 01124 !------------------------------------------------------------------------------------- 01125 ! Stores Canyon air and humidity if historical option of TEB is active 01126 !------------------------------------------------------------------------------------- 01127 ! 01128 IF (.NOT. LCANOPY) THEN 01129 DO JTEB_PATCH=1,NTEB_PATCH 01130 CALL GOTO_TEB(JTEB_PATCH) 01131 XT_CANYON(:) = ZAVG_T_CANYON(:) 01132 XQ_CANYON(:) = ZAVG_Q_CANYON(:) 01133 END DO 01134 END IF 01135 ! 01136 !------------------------------------------------------------------------------------- 01137 ! Thermal confort index 01138 !------------------------------------------------------------------------------------- 01139 ! 01140 IF (LUTCI .AND. N2M >0) THEN 01141 DO JJ=1,KI 01142 IF (XZON10M(JJ)/=XUNDEF) THEN 01143 ZU_UTCI(JJ) = SQRT(XZON10M(JJ)**2+XMER10M(JJ)**2) 01144 ELSE 01145 ZU_UTCI(JJ) = ZWIND(JJ) 01146 ENDIF 01147 ENDDO 01148 CALL UTCI_TEB(XT_CANYON, XQ_CANYON, ZAVG_TI_BLD, ZAVG_QI_BLD, ZU_UTCI, PPS, ZAVG_REF_SW_GRND,& 01149 ZAVG_REF_SW_FAC, ZAVG_SCA_SW, ZAVG_DIR_SW, PZENITH, ZAVG_EMIT_LW_FAC, ZAVG_EMIT_LW_GRND, PLW, & 01150 ZAVG_T_RAD_IND, XBLD, XBLD_HEIGHT, XWALL_O_HOR, XUTCI_IN, XUTCI_OUTSUN, & 01151 XUTCI_OUTSHADE, XTRAD_SUN, XTRAD_SHADE ) 01152 ELSE IF (LUTCI) THEN 01153 XUTCI_IN(:) = XUNDEF 01154 XUTCI_OUTSUN(:) = XUNDEF 01155 XUTCI_OUTSHADE(:) = XUNDEF 01156 XTRAD_SUN(:) = XUNDEF 01157 XTRAD_SHADE(:) = XUNDEF 01158 ENDIF 01159 01160 ! 01161 IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_N',1,ZHOOK_HANDLE) 01162 ! 01163 !------------------------------------------------------------------------------------- 01164 CONTAINS 01165 SUBROUTINE ADD_PATCH_CONTRIB(JP,PAVG,PFIELD) 01166 INTEGER, INTENT(IN) :: JP 01167 REAL, DIMENSION(:), INTENT(INOUT) :: PAVG 01168 REAL, DIMENSION(:), INTENT(IN) :: PFIELD 01169 ! 01170 IF (JTEB_PATCH==1) PAVG = 0. 01171 PAVG = PAVG + XTEB_PATCH(:,JP) * PFIELD(:) 01172 ! 01173 END SUBROUTINE ADD_PATCH_CONTRIB 01174 !------------------------------------------------------------------------------------- 01175 ! 01176 END SUBROUTINE COUPLING_TEB_n 01177 01178
1.8.0
