|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE COUPLING_ISBA_CANOPY_n(HPROGRAM, HCOUPLING, & 00003 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, & 00004 PAZIM, 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_ISBA_CANOPY_n * - Adds a SBL into ISBA 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 09/2007 00032 !! S. Riette 06/2009 Initialisation of XT, XQ, XU and XTKE on canopy levels 00033 !! S. Riette 01/2010 Use of interpol_sbl to compute 10m wind diagnostic 00034 !! Modified 09/2012 : J. Escobar , SIZE(PTA) not allowed without-interface , replace by KI 00035 !---------------------------------------------------------------- 00036 ! 00037 USE MODD_CSTS, ONLY : XCPD 00038 USE MODD_ISBA_n, ONLY : LCANOPY, LCANOPY_DRAG, CROUGH, XZ0, XLAI, XPATCH, & 00039 XSSO_STDEV, XSSO_SLOPE, XZ0_O_Z0H, XTG, CISBA, & 00040 TSNOW, CCPSURF, XWFC, XVEG, XGAMMA, XRSMIN, XWR, & 00041 XWRMAX_CF, XRESA, XRGL, XWSAT, XWG, XWGI 00042 USE MODD_ISBA_CANOPY_n, ONLY : XZ, XU, NLVL, XTKE, XT, XQ, XLMO, XZF, XDZ, XDZF, XP 00043 USE MODD_DIAG_ISBA_n, ONLY : N2M, XAVG_T2M, XAVG_Q2M, XAVG_HU2M, & 00044 XAVG_ZON10M, XAVG_MER10M, XAVG_WIND10M, & 00045 XAVG_WIND10M_MAX, XAVG_T2M_MIN, XAVG_T2M_MAX, & 00046 XAVG_HU2M_MIN, XAVG_HU2M_MAX, & 00047 LSURF_BUDGET, XAVG_FMU, XAVG_FMV 00048 USE MODD_SURF_PAR, ONLY : XUNDEF 00049 USE MODD_CANOPY_TURB, ONLY : XALPSBL 00050 ! 00051 USE MODE_COUPLING_CANOPY 00052 ! 00053 USE MODI_INIT_ISBA_SBL 00054 ! 00055 USE MODI_CANOPY_EVOL 00056 USE MODI_CANOPY_GRID_UPDATE 00057 ! 00058 USE MODI_COUPLING_ISBA_n 00059 ! 00060 USE MODI_ISBA_CANOPY 00061 USE MODI_SSO_BELJAARS04 00062 ! 00063 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00064 USE PARKIND1 ,ONLY : JPRB 00065 ! 00066 IMPLICIT NONE 00067 ! 00068 !* 0.1 declarations of arguments 00069 ! 00070 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00071 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00072 ! 'E' : explicit 00073 ! 'I' : implicit 00074 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00075 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00076 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00077 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00078 INTEGER, INTENT(IN) :: KI ! number of points 00079 INTEGER, INTENT(IN) :: KSV ! number of scalars 00080 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00081 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00082 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00083 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00084 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00085 ! 00086 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00087 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00088 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00089 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00090 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00091 ! ! 00092 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables 00093 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00094 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00095 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00096 ! ! (W/m2) 00097 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00098 ! ! (W/m2) 00099 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00100 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) 00101 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1 (radian from the vertical) 00102 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) 00103 REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) 00104 ! ! (W/m2) 00105 REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) 00106 REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) 00107 REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model CANOPY (m) 00108 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) 00109 REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) 00110 REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) 00111 ! 00112 ! 00113 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) 00114 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) 00115 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) 00116 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) 00117 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s) 00118 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) 00119 ! 00120 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) 00121 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) 00122 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) 00123 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) 00124 ! 00125 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients 00126 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' 00127 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF 00128 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF 00129 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF 00130 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF 00131 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00132 ! 00133 !* 0.2 declarations of local variables 00134 ! 00135 !* forcing variables 00136 ! 00137 REAL, DIMENSION(KI) :: ZWIND ! lowest atmospheric level wind speed (m/s) 00138 REAL, DIMENSION(KI) :: ZEXNA ! Exner function at lowest SBL scheme level (-) 00139 REAL, DIMENSION(KI) :: ZTA ! temperature (K) 00140 REAL, DIMENSION(KI) :: ZPA ! pressure (Pa) 00141 REAL, DIMENSION(KI) :: ZZREF ! temperature forcing level (m) 00142 REAL, DIMENSION(KI) :: ZUREF ! wind forcing level (m) 00143 REAL, DIMENSION(KI) :: ZU ! zonal wind (m/s) 00144 REAL, DIMENSION(KI) :: ZV ! meridian wind (m/s) 00145 REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/m3) 00146 REAL, DIMENSION(KI) :: ZPEQ_A_COEF ! specific humidity implicit 00147 REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! coefficients (hum. in kg/kg) 00148 ! 00149 ! 00150 ! canopy turbulence scheme 00151 ! 00152 REAL, DIMENSION(KI) :: ZCANOPY ! height of canopy (m) 00153 REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2) 00154 REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s) 00155 REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s) 00156 REAL, DIMENSION(KI,NLVL) :: ZFORC_U ! tendency due to drag force for wind 00157 REAL, DIMENSION(KI,NLVL) :: ZDFORC_UDU! formal derivative of 00158 ! ! tendency due to drag force for wind 00159 REAL, DIMENSION(KI,NLVL) :: ZFORC_E ! tendency due to drag force for TKE 00160 REAL, DIMENSION(KI,NLVL) :: ZDFORC_EDE! formal derivative of 00161 ! ! tendency due to drag force for TKE 00162 REAL, DIMENSION(KI,NLVL) :: ZFORC_T ! tendency due to drag force for Temp 00163 REAL, DIMENSION(KI,NLVL) :: ZDFORC_TDT! formal derivative of 00164 ! ! tendency due to drag force for Temp 00165 REAL, DIMENSION(KI,NLVL) :: ZFORC_Q ! tendency due to drag force for Temp 00166 REAL, DIMENSION(KI,NLVL) :: ZDFORC_QDQ! formal derivative of 00167 ! ! tendency due to drag force for hum. 00168 REAL, DIMENSION(KI,NLVL) :: ZLMO ! MO length 00169 REAL, DIMENSION(KI,NLVL) :: ZLM ! mixing length 00170 REAL, DIMENSION(KI,NLVL) :: ZLEPS ! dissipative length 00171 REAL, DIMENSION(KI) :: ZH ! canopy height (m) 00172 REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity including drag effect (m/s) 00173 REAL, DIMENSION(KI) :: ZUSTAR_GROUND! friction velocity at ground only (ISBA) (m/s) 00174 ! 00175 REAL, DIMENSION(KI) :: ZPET_A_COEF ! temperature implicit 00176 REAL, DIMENSION(KI) :: ZPET_B_COEF ! coefficients (K) 00177 REAL, DIMENSION(KI) :: ZPEW_A_COEF ! wind implicit 00178 REAL, DIMENSION(KI) :: ZPEW_B_COEF ! coefficients (m/s) 00179 ! 00180 REAL, DIMENSION(KI) :: ZALFAU ! V+(1) = - alfa rho u'w'(1) + beta 00181 REAL, DIMENSION(KI) :: ZBETAU ! V+(1) = - alfa rho u'w'(1) + beta 00182 REAL, DIMENSION(KI) :: ZALFATH ! Th+(1) = - alfa rho w'th'(1) + beta 00183 REAL, DIMENSION(KI) :: ZBETATH ! Th+(1) = - alfa rho w'th'(1) + beta 00184 REAL, DIMENSION(KI) :: ZALFAQ ! Q+(1) = - alfa rho w'q'(1) + beta 00185 REAL, DIMENSION(KI) :: ZBETAQ ! Q+(1) = - alfa rho w'q'(1) + beta 00186 ! 00187 CHARACTER(LEN=1) :: GCOUPLING 00188 ! 00189 REAL, DIMENSION(KI) ::ZCANOPY_DENSITY 00190 REAL, DIMENSION(KI) ::ZUW_GROUND 00191 REAL, DIMENSION(KI) ::ZDUWDU_GROUND 00192 ! 00193 REAL, DIMENSION(KI,NLVL) :: ZZ ! height above displacement height 00194 ! 00195 INTEGER :: JJ 00196 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00197 00198 !------------------------------------------------------------------------------------- 00199 ! 00200 ! 00201 !* 1. Preliminary computations of the SBL scheme 00202 ! ------------------------------------------ 00203 ! 00204 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_CANOPY_N',0,ZHOOK_HANDLE) 00205 IF (LCANOPY) THEN 00206 ! 00207 !* 1.1 Updates canopy vertical grid as a function of forcing height 00208 ! ------------------------------------------------------------ 00209 ! 00210 !* determines where is the forcing level and modifies the upper levels of the canopy grid 00211 ! 00212 ZCANOPY = 0. 00213 CALL CANOPY_GRID_UPDATE(KI,NLVL,ZCANOPY,PUREF,XZ,XZF,XDZ,XDZF) 00214 ! 00215 ! 00216 ! 00217 !* 1.2 Allocations and initialisations 00218 ! ------------------------------- 00219 ! 00220 ! 00221 ! 1.2.1 First time step canopy initialisation 00222 ! 00223 IF(ANY(XT(:,:) == XUNDEF)) THEN 00224 CALL INIT_ISBA_SBL(CISBA, CCPSURF, NLVL, PPA, PPS, PTA, PQA, PRHOA, PU, PV, & 00225 PDIR_SW, PSCA_SW, PSW_BANDS, PRAIN, PSNOW, & 00226 PZREF, PUREF, XTG(:,1,:), XPATCH, XWG(:,1,:), XWGI(:,1,:), & 00227 XZ0, XSSO_SLOPE, XRESA, XVEG, XLAI, XWR, XRGL, XRSMIN, & 00228 XGAMMA, XWRMAX_CF, XZ0_O_Z0H, XWFC, XWSAT, TSNOW, XZ, & 00229 XT, XQ, XU, XTKE, XP) 00230 ENDIF 00231 ! 00232 !* 1.3 Allocations 00233 ! ----------- 00234 ! 00235 CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, & 00236 ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ ) 00237 ! 00238 ZSFLUX_U = 0. 00239 ZSFLUX_T = 0. 00240 ZSFLUX_Q = 0. 00241 ! 00242 ZLMO = SPREAD(XLMO,2,NLVL) 00243 ! 00244 !* default : 00245 !* no canopy in ISBA scheme 00246 ! 00247 ZH = 0. 00248 ! 00249 ! 00250 !* determine for each level the height above displacement height 00251 ! 00252 ZZ(:,:) = XZ(:,:) 00253 ! 00254 !* 1.4 canopy for wind drag only 00255 ! ------------------------- 00256 ! 00257 IF (LCANOPY_DRAG) THEN 00258 !* mean canopy height 00259 ! 00260 !* in ecoclimap, height is set retrieved from roughness length (z0/0.13) 00261 ZH = SUM(XPATCH(:,:)*XZ0(:,:)/0.13,DIM=2) 00262 ZH = MIN(ZH, XZF(:,NLVL)) 00263 WHERE (ZH<=XDZ(:,1)) ZH = 0. 00264 ! 00265 !* canopy for wind drag only 00266 ZCANOPY_DENSITY = SUM(XPATCH(:,:)*XLAI(:,:),DIM=2) 00267 ZUW_GROUND = 0. 00268 ZDUWDU_GROUND = 0. 00269 ! 00270 !* computes tendencies on wind and Tke due to canopy 00271 CALL ISBA_CANOPY(KI,NLVL,XZ,XZF,XDZ,XDZF,ZH,ZCANOPY_DENSITY,XU,XTKE, & 00272 ZUW_GROUND, ZDUWDU_GROUND, & 00273 ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE ) 00274 ! 00275 ENDIF 00276 ! 00277 !* 1.4 Subgrid-scale orographic drag (Beljaars et al 2004) 00278 ! ----------------------------- 00279 ! 00280 IF (CROUGH=='BE04') THEN 00281 ! 00282 !* computes tendencies on wind and Tke due to subgridscale orography 00283 CALL SSO_BELJAARS04(KI,NLVL,XZ,XSSO_STDEV,XU,ZFORC_U,ZDFORC_UDU ) 00284 ! 00285 ENDIF 00286 ! 00287 ! 00288 !* 1.5 Computes coefficients for implicitation 00289 ! --------------------------------------- 00290 ! 00291 ZWIND = SQRT(PU**2+PV**2) 00292 CALL CANOPY_EVOL(KI,NLVL,PTSTEP,1,ZZ,ZWIND,PTA,PQA,PPA,PRHOA, & 00293 ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, & 00294 ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, & 00295 ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, & 00296 XZ,XZF,XDZ,XDZF,XU,XTKE,XT,XQ,ZLMO,ZLM,ZLEPS,XP,ZUSTAR, & 00297 ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ ) 00298 ! 00299 !* 1.6 Goes from atmospheric forcing to canopy forcing height 00300 ! ------------------------------------------------------ 00301 ! 00302 GCOUPLING ='I' 00303 ! 00304 CALL INIT_COUPLING_CANOPY( XP(:,1), PPA, XT(:,1), XQ(:,1), & 00305 PU, PV, XZ(:,1), XU(:,1), & 00306 PRHOA, ZALFAU, ZBETAU, ZALFATH, & 00307 ZBETATH, ZALFAQ, ZBETAQ, & 00308 ZPA, ZTA, ZQA, ZU, ZV, & 00309 ZUREF, ZZREF, ZEXNA, & 00310 ZPEW_A_COEF, ZPEW_B_COEF, & 00311 ZPET_A_COEF, ZPET_B_COEF, & 00312 ZPEQ_A_COEF, ZPEQ_B_COEF ) 00313 ! 00314 !------------------------------------------------------------------------------------- 00315 ELSE 00316 !------------------------------------------------------------------------------------- 00317 ! 00318 !* 2. If no canopy scheme is used, forcing is not modified 00319 ! ---------------------------------------------------- 00320 ! 00321 GCOUPLING = HCOUPLING 00322 ! 00323 CALL INIT_COUPLING( HCOUPLING, & 00324 PPS, PPA, PTA, PQA, PU, PV, & 00325 PUREF, PZREF, & 00326 PPEW_A_COEF, PPEW_B_COEF, & 00327 PPET_A_COEF, PPET_B_COEF, & 00328 PPEQ_A_COEF, PPEQ_B_COEF, & 00329 ZPA, ZTA, ZQA, ZU, ZV, & 00330 ZUREF, ZZREF, & 00331 ZPEW_A_COEF, ZPEW_B_COEF, & 00332 ZPET_A_COEF, ZPET_B_COEF, & 00333 ZPEQ_A_COEF, ZPEQ_B_COEF ) 00334 ! 00335 END IF 00336 ! 00337 !------------------------------------------------------------------------------------- 00338 ! 00339 !* 2. Call of ISBA 00340 ! ------------ 00341 ! 00342 CALL COUPLING_ISBA_n(HPROGRAM, GCOUPLING, & 00343 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & 00344 KI, KSV, KSW, & 00345 PTSUN, PZENITH, PZENITH2, & 00346 ZZREF, ZUREF, PZS, ZU, ZV, ZQA, ZTA, PRHOA, PSV, PCO2, & 00347 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA, & 00348 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, & 00349 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, & 00350 ZPEW_A_COEF, ZPEW_B_COEF, & 00351 ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, & 00352 'OK' ) 00353 ! 00354 !------------------------------------------------------------------------------------- 00355 ! 00356 !* 3. End if no canopy is used 00357 ! ------------------------ 00358 ! 00359 IF (.NOT. LCANOPY .AND. LHOOK) CALL DR_HOOK('COUPLING_ISBA_CANOPY_N',1,ZHOOK_HANDLE) 00360 IF (.NOT. LCANOPY) RETURN 00361 ! 00362 !------------------------------------------------------------------------------------- 00363 ! 00364 !* 4. Computes the impact of surface on air 00365 ! ------------------------------------- 00366 ! 00367 CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, & 00368 ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ ) 00369 ! 00370 ZSFLUX_U = - SQRT(PSFU(:)**2+PSFV(:)**2) / PRHOA(:) 00371 ZSFLUX_T(:) = PSFTH(:) / XCPD * ZEXNA(:) / PRHOA(:) 00372 ZSFLUX_Q(:) = PSFTQ(:) 00373 ! 00374 !------------------------------------------------------------------------------------- 00375 ! 00376 !* 5. Computes the impact of canopy on air 00377 ! ------------------------------------ 00378 ! 00379 IF (LCANOPY_DRAG) THEN 00380 ! 00381 ZUW_GROUND = -SQRT(PSFU**2+PSFV**2)/ PRHOA(:) 00382 ZDUWDU_GROUND = 0. 00383 WHERE (XU(:,1) /=0.) ZDUWDU_GROUND = 2. * ZUW_GROUND / XU(:,1) 00384 00385 !* computes tendencies on wind and Tke due to canopy and surface 00386 CALL ISBA_CANOPY(KI,NLVL,XZ,XZF,XDZ,XDZF,ZH,ZCANOPY_DENSITY,XU,XTKE, & 00387 ZUW_GROUND, ZDUWDU_GROUND, & 00388 ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE ) 00389 00390 ZSFLUX_U = 0. ! surface friction is incorporated in ZFORC_U by ISBA_CANOPY routine 00391 ! 00392 END IF 00393 ! 00394 ! 00395 IF (CROUGH=='BE04') THEN 00396 ! 00397 !* computes tendencies on wind and Tke due to subgridscale orography 00398 CALL SSO_BELJAARS04(KI,NLVL,XZ,XSSO_STDEV,XU,ZFORC_U,ZDFORC_UDU ) 00399 ! 00400 ENDIF 00401 ! 00402 !------------------------------------------------------------------------------------- 00403 ! 00404 !* 6. Evolution of canopy air due to these impacts 00405 ! -------------------------------------------- 00406 ! 00407 ZWIND = SQRT(PU**2+PV**2) 00408 CALL CANOPY_EVOL(KI,NLVL,PTSTEP,2,ZZ,ZWIND,PTA,PQA,PPA,PRHOA, & 00409 ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, & 00410 ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, & 00411 ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, & 00412 XZ,XZF,XDZ,XDZF,XU,XTKE,XT,XQ,ZLMO,ZLM,ZLEPS,XP,ZUSTAR, & 00413 ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ ) 00414 ! 00415 XLMO(:) = ZLMO(:,NLVL) 00416 ! 00417 ! Momentum fluxes if canopy is used 00418 ! 00419 !* Total friction due to surface averaged friction and averaged canopy drag 00420 IF (LCANOPY_DRAG .OR. CROUGH=='BE04') THEN 00421 ZUSTAR_GROUND=SQRT(SQRT(PSFU**2+PSFV**2)/PRHOA) 00422 WHERE (ZUSTAR_GROUND(:)>0.) 00423 PSFU(:) = PSFU(:) * ZUSTAR**2/ZUSTAR_GROUND**2 00424 PSFV(:) = PSFV(:) * ZUSTAR**2/ZUSTAR_GROUND**2 00425 END WHERE 00426 !* Total friction due to surface averaged friction and averaged canopy drag 00427 IF (LSURF_BUDGET) THEN 00428 XAVG_FMU = PSFU 00429 XAVG_FMV = PSFV 00430 ENDIF 00431 END IF 00432 ! 00433 !------------------------------------------------------------------------------------- 00434 ! 00435 !* 7. 2m and 10m diagnostics if canopy is used 00436 ! ---------------------------------------- 00437 ! 00438 ! 00439 IF (N2M>=1) CALL INIT_2M_10M( XP(:,2), XT(:,2), XQ(:,2), XU, XZ, & 00440 PU, PV, ZWIND, PRHOA, & 00441 XAVG_T2M, XAVG_Q2M, XAVG_HU2M, XAVG_ZON10M, XAVG_MER10M, & 00442 XAVG_WIND10M, XAVG_WIND10M_MAX, XAVG_T2M_MIN, & 00443 XAVG_T2M_MAX, XAVG_HU2M_MIN, XAVG_HU2M_MAX ) 00444 ! 00445 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_CANOPY_N',1,ZHOOK_HANDLE) 00446 ! 00447 !------------------------------------------------------------------------------------- 00448 ! 00449 END SUBROUTINE COUPLING_ISBA_CANOPY_n
1.8.0
