|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE E_BUDGET(HISBA, HSNOW_ISBA, OFLOOD, OTEMP_ARP, HIMPLICIT_WIND, & 00003 PSODELX, PUREF, PPEW_A_COEF, PPEW_B_COEF, & 00004 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, & 00005 PVMOD, PCD, & 00006 PTG, PTSTEP, PSNOWALBM, & 00007 PSW_RAD, PLW_RAD, PTA, PQA, PPS, PRHOA, & 00008 PEXNS, PEXNA, PCPS, PLVTT, PLSTT, & 00009 PVEG, PHUG, PHUI, PHV, & 00010 PLEG_DELTA, PLEGI_DELTA, & 00011 PEMIS, PALB, PRA, & 00012 PCT, PPSN, PPSNV, PPSNG, & 00013 PGRNDFLUX, PSMELTFLUX, PSNOW_THRUFAL, & 00014 PD_G, PDZG, PDZDIF, PSOILCONDZ, PSOILHCAPZ, & 00015 PALBT, PEMIST, PQSAT, PDQSAT, & 00016 PFROZEN1, PTDEEP_A, PTDEEP_B, PGAMMAT, & 00017 PTA_IC, PQA_IC, PUSTAR2_IC, & 00018 PSNOWFREE_ALB_VEG, PPSNV_A,PSNOWFREE_ALB_SOIL, & 00019 PFFG, PFFV, PFF, PFFROZEN, PFALB, PFEMIS, PDELTAT, & 00020 PDEEP_FLUX ) 00021 ! ########################################################################## 00022 ! 00023 !!**** *E_BUDGET* 00024 !! 00025 !! PURPOSE 00026 !! ------- 00027 ! 00028 ! Calculates the evolution of the surface and deep-soil temperature 00029 ! (i.e., Ts and T2), as well as all the surface fluxes. 00030 ! 00031 ! 00032 !!** METHOD 00033 !! ------ 00034 ! 00035 ! 1- find the grid-averaged albedo, emissivity, and roughness length 00036 ! 2- compute the za, zb, and zc terms involved in the numerical 00037 ! resolution of the equations for Ts and T2. 00038 ! 3- find Ts(t) and T2(t). 00039 ! 4- derive the surface fluxes. 00040 ! 00041 !! EXTERNAL 00042 !! -------- 00043 !! 00044 !! none 00045 !! 00046 !! IMPLICIT ARGUMENTS 00047 !! ------------------ 00048 !! 00049 !! 00050 !! 00051 !! REFERENCE 00052 !! --------- 00053 !! 00054 !! Noilhan and Planton (1989) 00055 !! Belair (1995) 00056 !! 00057 !! AUTHOR 00058 !! ------ 00059 !! 00060 !! S. Belair * Meteo-France * 00061 !! 00062 !! MODIFICATIONS 00063 !! ------------- 00064 !! Original 14/03/95 00065 !! (J.Stein) 15/11/95 use the wind components in the flux computation 00066 !! (J.Noilhan) 15/03/96 use the potential temperature instead of the 00067 !! temperature for the heat flux computation 00068 !! (J.Stein) 27/03/96 use only H and LE in the soil scheme 00069 !! (A.Boone, V.Masson) 28/08/98 splits the routine in two for C02 computations 00070 !! (A.Boone) 15/03/99 Soil ice tendencies calculated here: heating/cooling 00071 !! affects surface and deep soil temperatures. 00072 !! (A. Boone, V. Masson) 01/2003 Externalization 00073 !! (E. Martin) 07/05 implicit coupling (coeff ZA,ZB,ZC) 00074 !! (P. Le Moigne) 07/05 dependence on qs for cp 00075 !! (B. Decharme) 05/08 Add floodplains dependencies 00076 !! (B. Decharme) 01/09 optional deep soil temperature as in Arpege 00077 !! (R. Hamdi) 01/09 Cp and L are not constants (As in ALADIN) 00078 !! (B. Decharme) 09/09 When LCPL_ARP, do not calculate x2 each coef 00079 !! (A.Boone) 03/10 Add delta fnctions to force LEG ans LEGI=0 00080 !! when hug(i)Qsat < Qa and Qsat > Qa 00081 !! (B. Decharme) 09/12 new wind implicitation 00082 !! (V. Masson) 01/13 Deep soil flux implicitation 00083 !------------------------------------------------------------------------------- 00084 ! 00085 !* 0. DECLARATIONS 00086 ! ------------ 00087 ! 00088 USE MODD_CSTS, ONLY : XLVTT, XLSTT, XSTEFAN, XCPD, XPI, XDAY, & 00089 XTT, XCL, XCPV, XCI 00090 USE MODD_SURF_PAR, ONLY : XUNDEF 00091 USE MODD_SNOW_PAR, ONLY : XEMISSN, XEMCRIN 00092 ! 00093 USE MODD_SURF_ATM, ONLY : LCPL_ARP, LQVNPLUS 00094 ! 00095 USE MODE_THERMOS 00096 ! 00097 USE MODI_SOIL_HEATDIF 00098 USE MODI_SOIL_TEMP_ARP 00099 ! 00100 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00101 USE PARKIND1 ,ONLY : JPRB 00102 ! 00103 IMPLICIT NONE 00104 ! 00105 !* 0.1 declarations of arguments 00106 ! 00107 ! 00108 ! 00109 CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of soil (Force-Restore OR Diffusion) 00110 ! ! '2-L' 00111 ! ! '3-L' 00112 ! ! 'DIF' ISBA-DF 00113 ! 00114 CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme 00115 ! ! (Douville et al. 1995) 00116 ! ! '3-L' = 3-L snow scheme (option) 00117 ! ! (Boone and Etchevers 2000) 00118 LOGICAL, INTENT(IN) :: OFLOOD ! Activation of the flooding scheme 00119 LOGICAL, INTENT(IN) :: OTEMP_ARP ! True = time-varying force-restore soil temperature (as in ARPEGE) 00120 ! False = No time-varying force-restore soil temperature (Default) 00121 ! 00122 CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option 00123 ! ! 'OLD' = direct 00124 ! ! 'NEW' = Taylor serie, order 1 00125 ! 00126 REAL, DIMENSION(:), INTENT (IN) :: PSODELX ! Pulsation for each layer (Only used if LTEMP_ARP=True) 00127 00128 ! 00129 REAL, DIMENSION(:), INTENT(IN) :: PUREF ! reference height of the wind 00130 REAL, DIMENSION(:), INTENT(IN) :: PSNOWALBM 00131 ! prognostic variables at time 't-dt' 00132 ! PSNOWALBM = albedo of the snow 00133 ! 00134 ! 00135 REAL, INTENT(IN) :: PTSTEP 00136 ! timestep of the integration 00137 ! 00138 REAL, DIMENSION(:), INTENT (IN) :: PSW_RAD, PLW_RAD, PPS, PRHOA, PTA, PQA, PCD, PVMOD 00139 ! PSW_RAD = incoming solar radiation 00140 ! PLW_RAD = atmospheric infrared radiation 00141 ! PRHOA = near-ground air density 00142 ! PPS = surface pressure 00143 ! PTA = near-ground air temperature 00144 ! PQA = near-ground air specific humidity 00145 ! PCD = drag coefficient 00146 ! PVMOD = wind speed 00147 ! 00148 ! implicit atmospheric coupling coefficients: 00149 ! 00150 REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF, PPEW_B_COEF, 00151 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, 00152 PPEQ_B_COEF 00153 ! PPEW_A_COEF = A-wind coefficient (m2s/kg) 00154 ! PPEW_B_COEF = B-wind coefficient (m/s) 00155 ! PPET_A_COEF = A-air temperature coefficient 00156 ! PPET_B_COEF = B-air temperature coefficient 00157 ! PPEQ_A_COEF = A-air specific humidity coefficient 00158 ! PPEQ_B_COEF = B-air specific humidity coefficient 00159 ! 00160 REAL, DIMENSION(:), INTENT(IN) :: PEXNS, PEXNA 00161 REAL, DIMENSION(:), INTENT(IN) :: PVEG, PHUG, PHUI, PHV 00162 REAL, DIMENSION(:), INTENT(IN) :: PEMIS, PALB, PCT, PPSN 00163 REAL, DIMENSION(:), INTENT(IN) :: PPSNV, PPSNG 00164 ! PVEG = fraction of vegetation 00165 ! PHUG = relative humidity of the soil 00166 ! PHV = Halstead coefficient 00167 ! PEMIS = emissivity 00168 ! PALB = albedo 00169 ! PCT = area-averaged heat capacity 00170 ! PPSN = grid fraction covered by snow 00171 ! PPSNV = fraction of the vegetation covered by snow 00172 ! PPSNG = fraction of the ground covered by snow 00173 ! 00174 REAL, DIMENSION(:), INTENT(IN) :: PFROZEN1 00175 ! PFROZEN1 = ice fraction in supurficial soil 00176 ! 00177 REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A, PTDEEP_B, PGAMMAT 00178 ! PTDEEP_A = Deep soil temperature 00179 ! coefficient depending on flux 00180 ! PTDEEP_B = Deep soil temperature (prescribed) 00181 ! which models heating/cooling from 00182 ! below the diurnal wave penetration 00183 ! (surface temperature) depth. If it 00184 ! is FLAGGED as undefined, then the zero 00185 ! flux lower BC is applied. 00186 ! Tdeep = PTDEEP_B + PTDEEP_A * PDEEP_FLUX 00187 ! (with PDEEP_FLUX in W/m2) 00188 ! PGAMMAT = Deep soil heat transfer coefficient: 00189 ! assuming homogeneous soil so that 00190 ! this can be prescribed in units of 00191 ! (1/days): associated time scale with 00192 ! PTDEEP. 00193 ! 00194 REAL, DIMENSION(:), INTENT(IN) :: PGRNDFLUX, PSMELTFLUX, PSNOW_THRUFAL 00195 ! PGRNDFLUX = soil/snow interface flux (W/m2) using 00196 ! ISBA-SNOW3L option 00197 ! PSMELTFLUX= soil/snow interface flux (W/m2) using 00198 ! ISBA-SNOW3L option: when last traces of snow melt 00199 ! PSNOW_THRUFAL = snow runoff/melt leaving pack and available 00200 ! at the surface for runoff or infiltration 00201 ! [kg/(m2 s)] 00202 ! 00203 REAL, DIMENSION(:,:), INTENT(IN) :: PD_G, PSOILCONDZ, PSOILHCAPZ 00204 ! PD_G = Depth of bottom of Soil layers (m) 00205 ! PSOILCONDZ= ISBA-DF Soil conductivity profile [W/(m K)] 00206 ! PSOILHCAPZ=ISBA-DF Soil heat capacity profile [J/(m3 K)] 00207 REAL, DIMENSION(:,:), INTENT(IN) :: PDZG ! soil layers thicknesses (DIF option) (m) 00208 REAL, DIMENSION(:,:), INTENT(IN) :: PDZDIF ! distance between consecuative layer mid-points (DIF option) (m) 00209 ! 00210 ! 00211 REAL, DIMENSION(:), INTENT(IN) :: PSNOWFREE_ALB_VEG !snow free albedo of vegetation for EBA 00212 REAL, DIMENSION(:), INTENT(IN) :: PSNOWFREE_ALB_SOIL !snow free albedo of soil for EBA option 00213 REAL, DIMENSION(:), INTENT(IN) :: PPSNV_A !fraction of the the vegetation covered by snow for EBA scheme 00214 ! 00215 REAL, DIMENSION(:), INTENT(INOUT) :: PLEG_DELTA, PLEGI_DELTA 00216 ! PLEG_DELTA = soil evaporation delta fn 00217 ! PLEGI_DELTA = soil evaporation delta fn 00218 ! 00219 REAL, DIMENSION(:), INTENT (OUT) :: PQA_IC, PTA_IC, PUSTAR2_IC 00220 ! PTA_IC = near-ground air temperature 00221 ! PQA_IC = near-ground air specific humidity 00222 ! PUSTAR2_IC = near-ground wind friction (m2/s2) 00223 ! (modified if implicit coupling with 00224 ! atmosphere used) 00225 ! 00226 REAL, DIMENSION(:), INTENT(IN) :: PRA 00227 ! PRA = aerodynamic surface resistance for 00228 ! heat transfers 00229 ! 00230 REAL, DIMENSION(:,:), INTENT(INOUT):: PTG 00231 ! PTG = soil temperature profile (K) 00232 ! 00233 REAL, DIMENSION(:), INTENT(INOUT) :: PCPS 00234 ! PCPS = heat capacity at surface 00235 ! 00236 REAL, DIMENSION(:), INTENT(OUT) :: PALBT, PEMIST, PDQSAT 00237 ! PALBT = averaged albedo 00238 ! PEMIST = averaged emissivity 00239 ! PDQSAT = saturation vapor humidity derivative 00240 REAL, DIMENSION(:), INTENT(IN) :: PQSAT 00241 ! PQSAT = saturation vapor humidity 00242 ! 00243 REAL, DIMENSION(:), INTENT(IN) :: PFFV, PFF, PFFG, PFALB, PFEMIS, PFFROZEN 00244 ! PFFG = Floodplain fraction over ground 00245 ! PFFV = Floodplain fraction over vegetation 00246 ! PFF = Floodplain fraction at the surface 00247 ! PFALB = Floodplain albedo 00248 ! PFEMIS= Floodplain emis 00249 ! 00250 REAL, DIMENSION(:), INTENT(INOUT) :: PLSTT, PLVTT 00251 ! 00252 REAL, DIMENSION(:,:), INTENT(OUT) :: PDELTAT 00253 ! PDELTAT = change in temperature over the time 00254 ! step before adjustment owing to phase 00255 ! changes (K) 00256 REAL, DIMENSION(:), INTENT(OUT) :: PDEEP_FLUX ! Heat flux at bottom of ISBA (W/m2) 00257 ! 00258 !* 0.2 declarations of local variables 00259 ! 00260 ! 00261 REAL, DIMENSION(SIZE(PALB)) :: ZRORA, 00262 ! rhoa / ra 00263 ! 00264 ZA,ZB,ZC 00265 ! terms for the calculation of Ts(t) 00266 ! 00267 ! ISBA-DF: 00268 ! 00269 REAL, DIMENSION(SIZE(PALB)) :: ZCONDAVG, ZTERM2, ZTERM1 00270 ! 00271 ! implicit atmospheric coupling coefficients: (modified-form) 00272 ! 00273 REAL, DIMENSION(SIZE(PALB)) :: ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, 00274 ZPEQ_B_COEF, Z_CCOEF, ZHUMS, ZHUMA, ZLAVG, 00275 ZHUMSD, ZHUMAD 00276 ! ZPET_A_COEF = A-air temperature coefficient 00277 ! ZPET_B_COEF = B-air temperature coefficient 00278 ! ZPEQ_A_COEF = A-air specific humidity coefficient 00279 ! ZPEQ_B_COEF = B-air specific humidity coefficient 00280 ! Z_CCOEF = C-working variable 00281 ! 00282 REAL, DIMENSION(SIZE(PALB)) :: ZUSTAR2, ZVMOD 00283 ! ZUSTAR2 = friction (m2/s2) 00284 ! ZVMOD = wind modulus (m/s) 00285 REAL, DIMENSION(SIZE(PALB)) :: ZXCPV_XCL_AVG, ZPTG_OLD 00286 REAL, DIMENSION(SIZE(PALB)) :: ZCNHUMA, ZPEQA2, ZDPQB, ZCDQSAT, ZINCR, ZTRAD, 00287 ZCHUMS, ZCHUMA, ZPETA2, ZPETB2,ZTEMP, ZFGNFRZ, 00288 ZFGFRZ, ZFV, ZFG, ZFNFRZ, ZFFRZ, ZFNSNOW, ZCPS, 00289 ZLVTT, ZLSTT 00290 REAL :: ZSNOW 00291 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00292 ! 00293 !------------------------------------------------------------------------------- 00294 ! 00295 !* 0. Initialization: 00296 ! --------------- 00297 ! 00298 ! 00299 IF (LHOOK) CALL DR_HOOK('E_BUDGET',0,ZHOOK_HANDLE) 00300 ZCONDAVG(:) = 0.0 00301 ZTERM2(:) = 0.0 00302 ZTERM1(:) = 0.0 00303 ZPTG_OLD(:) = PTG(:,1) 00304 PDELTAT(:,:) = 0.0 00305 ZHUMSD(:) = 0.0 00306 ZHUMAD(:) = 0.0 00307 ! 00308 !------------------------------------------------------------------------------- 00309 ! 00310 !* 1. COEFFICIENTS FOR THE TIME INTEGRATION OF TS 00311 ! -------------------------------------------- 00312 ! 00313 ! 00314 ! function dqsat(Ts,ps) 00315 ! 00316 PDQSAT(:) = DQSAT(PTG(:,1),PPS(:),PQSAT(:)) 00317 ! function zrsra 00318 ! 00319 ! Modify flux-form implicit coupling coefficients: 00320 ! - wind components: 00321 ! 00322 ZTEMP (:) = PCD(:)*PVMOD(:) 00323 ! 00324 IF(HIMPLICIT_WIND=='OLD')THEN 00325 ! old implicitation (m2/s2) 00326 ZUSTAR2(:) = ZTEMP(:) * PPEW_B_COEF(:) / (1.0- ZTEMP(:)*PRHOA(:)*PPEW_A_COEF(:)) 00327 ELSE 00328 ! new implicitation (m2/s2) 00329 ZUSTAR2(:) = ZTEMP(:) * (2.*PPEW_B_COEF(:)-PVMOD(:)) / (1.0-2.0*ZTEMP(:)*PRHOA(:)*PPEW_A_COEF(:)) 00330 ENDIF 00331 ! 00332 !wind modulus at t+1 (m/s) 00333 ZVMOD(:) = PRHOA(:)*PPEW_A_COEF(:)*ZUSTAR2(:) + PPEW_B_COEF(:) 00334 ZVMOD(:) = MAX(ZVMOD(:),0.) 00335 ! 00336 WHERE(PPEW_A_COEF(:)/= 0.) 00337 ZUSTAR2(:) = MAX( ( ZVMOD(:) - PPEW_B_COEF(:) ) / (PRHOA(:)*PPEW_A_COEF(:)), 0.) 00338 ENDWHERE 00339 ! 00340 ZUSTAR2(:) = MAX(ZUSTAR2(:),0.) 00341 ! 00342 ZRORA(:) = PRHOA(:) / PRA(:) 00343 ! 00344 ! terms za, zb, and zc for the 00345 ! calculation of ts(t) 00346 ! 00347 ! Modify flux-form implicit coupling coefficients: 00348 ! - air temperature: 00349 ! 00350 ZTEMP(:) = PPET_A_COEF(:)*ZRORA(:) 00351 Z_CCOEF(:) = (1.0 - ZTEMP(:))/PEXNA(:) 00352 ! 00353 ZPET_A_COEF(:) = - ZTEMP(:)/PEXNS(:)/Z_CCOEF(:) 00354 ! 00355 ZPET_B_COEF(:) = PPET_B_COEF(:)/Z_CCOEF(:) 00356 ! 00357 !------------------------------------------------------------------------------- 00358 ! 00359 !* 2. AIR AND SOIL SPECIFIC HUMIDITIES 00360 ! -------------------------------- 00361 ! 00362 ! - air specific humidity: 00363 ! 00364 ZFV(:) = PVEG(:) * (1-PPSNV(:)-PFFV(:)) 00365 ZFG(:) = (1.-PVEG(:))*(1.-PPSNG(:)-PFFG(:)) 00366 ZFNFRZ(:) = (1.-PFFROZEN(:))*PFF(:) + ZFV + ZFG(:)*(1.-PFROZEN1(:)) 00367 ZFFRZ(:) = PFFROZEN(:)*PFF(:) + ZFG(:)*PFROZEN1(:) + PPSN(:) 00368 ! 00369 ZSNOW=1. 00370 ZFNSNOW(:)=1. 00371 ZCPS(:)=PCPS(:) 00372 ! 00373 IF (LCPL_ARP) THEN 00374 00375 ! currently this correction not applied for this option, but can be 00376 ! added later after testing...so delta fns set to 1 (turns OFF this correction) 00377 00378 PLEG_DELTA(:) = 1.0 00379 PLEGI_DELTA(:) = 1.0 00380 00381 ZLAVG(:) = PLVTT(:)*ZFNFRZ(:) + PLSTT(:)*ZFFRZ(:) 00382 ZXCPV_XCL_AVG(:)= (XCPV-XCL)*ZFNFRZ(:) + (XCPV-XCI)*ZFFRZ(:) 00383 00384 ZLVTT(:) = ZLAVG(:) 00385 ZLSTT(:) = ZLAVG(:) 00386 00387 ELSE 00388 00389 IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN 00390 ZSNOW = 0. 00391 ZFNSNOW(:) = 1. - PPSN(:) 00392 ZCPS(:)=XCPD 00393 ENDIF 00394 00395 ZLAVG(:) = XLVTT*ZFNFRZ(:) + XLSTT*ZFFRZ(:) 00396 00397 ZLVTT(:) = XLVTT 00398 ZLSTT(:) = XLSTT 00399 00400 ENDIF 00401 ! 00402 ZFGNFRZ(:) = ZFG(:)*(1.-PFROZEN1(:))*PLEG_DELTA(:) 00403 ZFGFRZ(:) = ZFG(:)*PFROZEN1(:)*PLEGI_DELTA(:) 00404 ! 00405 ZHUMA(:) = ZLVTT(:)/ZLAVG(:) * ((1.-PFFROZEN(:))*PFF(:) + ZFV(:)*PHV(:) + ZFGNFRZ(:)) + & 00406 ZLSTT(:)/ZLAVG(:) * (PFFROZEN(:)*PFF(:) + ZFGFRZ(:) + ZSNOW*PPSN(:) ) 00407 ! 00408 ZHUMS(:) = ZLVTT(:)/ZLAVG(:) * ((1.-PFFROZEN(:))*PFF(:) + ZFV(:)*PHV(:) + ZFGNFRZ(:)*PHUG(:)) + & 00409 ZLSTT(:)/ZLAVG(:) * (PFFROZEN(:)*PFF(:) + ZFGFRZ(:)*PHUI(:) + ZSNOW*PPSN(:) ) 00410 ! 00411 IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN 00412 ! 00413 ! humidity considering no snow (done elsewhere) and flooded zones: 00414 ! 00415 ZHUMAD(:) = PFF(:) + ZFV(:)*PHV(:) + ZFGNFRZ(:) + ZFGFRZ(:) 00416 ZHUMSD(:) = PFF(:) + ZFV(:)*PHV(:) + ZFGNFRZ(:)*PHUG(:) + ZFGFRZ(:)*PHUI(:) 00417 ELSE 00418 ZHUMAD(:) = ZHUMA(:) 00419 ZHUMSD(:) = ZHUMS(:) 00420 ENDIF 00421 ! 00422 !------------------------------------------------------------------------------- 00423 ! 00424 !* 3. COEFFICIENTS FOR THE TIME INTEGRATION OF Q 00425 ! ------------------------------------------- 00426 ! 00427 ! implicit q coefficients: 00428 ! 00429 ZTEMP(:) = PPEQ_A_COEF(:)*ZRORA(:) 00430 Z_CCOEF(:) = 1.0 - ZTEMP(:)*ZHUMAD(:) 00431 ! 00432 ZPEQ_A_COEF(:) = - ZTEMP(:)*PDQSAT(:)*ZHUMSD(:)/Z_CCOEF(:) 00433 ! 00434 ZPEQ_B_COEF(:) = ( PPEQ_B_COEF(:) - ZTEMP(:)*ZHUMSD(:)* & 00435 (PQSAT(:) - PDQSAT(:)*PTG(:,1)) )/Z_CCOEF(:) 00436 ! 00437 !------------------------------------------------------------------------------- 00438 ! 00439 !* 4. TOTAL ALBEDO AND EMISSIVITY 00440 ! --------------------------- 00441 ! 00442 ! 00443 IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN 00444 ! 00445 ! NON-SNOW covered Grid averaged albedo and emissivity for explicit 00446 ! snow scheme 00447 ! 00448 IF(.NOT.OFLOOD)THEN 00449 ! 00450 PALBT (:) = PALB (:) 00451 PEMIST(:) = PEMIS(:) 00452 ! 00453 ELSE 00454 ! 00455 ! Taking into account the floodplains with snow grid fractions : 00456 ! PFF 1.-PFF-PPSN PPSN 00457 ! |------------|----|---------------| 00458 ! 00459 WHERE(PPSN(:)<1.0) 00460 PALBT (:) = ((1.-PFF(:)-PPSN(:))*PALB(:) + PFF(:)*PFALB (:))/(1.-PPSN(:)) 00461 PEMIST(:) = ((1.-PFF(:)-PPSN(:))*PEMIS(:) + PFF(:)*PFEMIS(:))/(1.-PPSN(:)) 00462 ELSEWHERE 00463 PALBT (:) = PALB (:) 00464 PEMIST(:) = PEMIS(:) 00465 ENDWHERE 00466 ! 00467 ENDIF 00468 ! 00469 ! 00470 ELSE 00471 ! 00472 ! Grid averaged albedo and emissivity for composite snow scheme: 00473 ! 00474 IF(HSNOW_ISBA=='EBA') THEN 00475 ! 00476 PALBT(:) = (1-PVEG(:))*(PSNOWFREE_ALB_SOIL(:)*(1-PPSNG(:))+PSNOWALBM(:)*PPSNG(:)) + & 00477 PVEG(:)*(PSNOWFREE_ALB_VEG(:)*(1-PPSNV_A(:)) + & 00478 PSNOWALBM(:)*PPSNV_A(:)) 00479 ! 00480 PEMIST(:) = PEMIS(:)-PPSN(:)*(PEMIS(:)-XEMCRIN) 00481 ! 00482 ELSE 00483 ! 00484 PALBT (:) = ( 1.-PPSN(:)-PFF(:))*PALB(:) + PPSN(:)*PSNOWALBM(:) + PFF(:)*PFALB(:) 00485 ! 00486 PEMIST(:) = ( 1.-PPSN(:)-PFF(:))*PEMIS(:) + PPSN(:)*XEMISSN + PFF(:)*PFEMIS(:) 00487 ! 00488 ENDIF 00489 00490 ENDIF 00491 ! 00492 !------------------------------------------------------------------------------- 00493 ! 00494 !* 5. CALCULATION OF ZA, ZB, ZC 00495 ! ----------------------------- 00496 ! 00497 ! 5.1. Default 00498 ! ------------ 00499 ! 00500 ZTRAD(:) = PEMIST(:) * XSTEFAN * (PTG(:,1)**3) 00501 ZCHUMS(:) = ZRORA(:)*ZLAVG(:)*ZHUMS(:) 00502 ZCHUMA(:) = ZRORA(:)*ZLAVG(:)*ZHUMA(:) 00503 ! 00504 ZPETA2(:) = 1./PEXNS(:) - ZPET_A_COEF(:)/PEXNA(:) 00505 ZPETB2(:) = ZPET_B_COEF(:)/PEXNA(:) 00506 ! 00507 ! Surface Energy Budget linearization coefficients for an explicit 00508 ! soil-flood-vegetation energy budget with an insulating fractional overlying 00509 ! layer of snow: fluxes partitioned between surface "felt" by atmosphere 00510 ! and surface in contact with base of snowpack (flux exchange between 00511 ! atmosphere and snow surface calculated in explicit snow routine) 00512 ! (Boone and Etchevers, 2001, J Hydromet.) 00513 ! NOTE for now, the meltwater advection term (heat source/sink) 00514 ! is OFF because the corresponding energy should be compensated for 00515 ! (but code is retained for possible future activation). 00516 ! 00517 ZA(:) = 1. / PTSTEP + PCT(:) * & 00518 ((ZFNSNOW(:) * & 00519 ( 4.*ZTRAD(:) + ZRORA(:)*ZCPS(:)*ZPETA2(:) )) & 00520 + ZCHUMS(:)*PDQSAT(:) - ZCHUMA(:)*ZPEQ_A_COEF(:)) & 00521 + 2. * XPI / XDAY 00522 ! 00523 ZB(:) = 1. / PTSTEP + PCT(:) * ( ZFNSNOW(:)* 3.*ZTRAD(:) + ZCHUMS(:)*PDQSAT(:) ) 00524 ! 00525 ZC(:) = 2. * XPI * PTG(:,2) / XDAY + PCT(:) * & 00526 ( ZFNSNOW(:) * & 00527 ( ZRORA(:)*ZCPS(:)*ZPETB2(:) & 00528 + PSW_RAD(:)*(1.-PALBT(:)) + PLW_RAD(:)*PEMIST(:)) & 00529 - (ZCHUMS(:)*PQSAT(:) - ZCHUMA(:)*ZPEQ_B_COEF(:))) 00530 ! 00531 IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN 00532 ! 00533 ! 5.2. With CSNOW=SNOW3L or CSNOW=CRO or HISBA=DIF 00534 ! ------------------------------------------------- 00535 ! 00536 !OFF ZA(:) = ZA(:) + PPSN(:) * PCT(:) * XCL * PSNOW_THRUFAL(:) 00537 ! 00538 ZC(:) = ZC(:) + PCT(:)*PPSN(:)*(PGRNDFLUX(:) + PSMELTFLUX(:)) 00539 !OFF + PCT(:)*( PPSN(:)*XTT*XCL*PSNOW_THRUFAL(:)) 00540 ! 00541 00542 ELSEIF (LCPL_ARP) THEN 00543 ! 00544 ! 5.3. With Arpege 00545 ! ---------------- 00546 ! 00547 ZCDQSAT(:) = (XCPV-XCPD)*ZHUMS(:)*PDQSAT(:) 00548 ZINCR(:)= PCT(:) * ZRORA(:) * & 00549 (ZCDQSAT(:) * ( ZPETA2(:)*PTG(:,1) - ZPETB2(:)) + & 00550 ZXCPV_XCL_AVG(:) * & 00551 (ZHUMS(:)*PQSAT(:) - ZHUMA(:) * (ZPEQ_B_COEF(:) + ZPEQ_A_COEF(:) * PTG(:,1)))) 00552 00553 ! Surface Energy Budget linearization coefficients for a composite 00554 ! (soil-vegetation-flood-snow) energy budget: composite fluxes "felt" by 00555 ! atmosphere from a mixed soil,snow and vegetation surface: 00556 ! (Douville et al. 1995, J. Clim. Dyn.) 00557 ! 00558 00559 ZA(:) = ZA(:) + ZINCR(:) 00560 00561 ZB(:) = ZB(:) + ZINCR(:) 00562 00563 IF (LQVNPLUS) THEN 00564 ! 00565 ! 5.4. With LQVNPLUS=TRUE 00566 ! ------------------------ 00567 ! 00568 ZCNHUMA(:)=(XCPV-XCPD)*(1.-ZHUMA(:)) 00569 ZPEQA2(:)=ZCNHUMA(:)*ZPEQ_A_COEF(:)*ZPETA2(:)*PTG(:,1) 00570 ZDPQB(:)=ZPEQ_B_COEF(:)-PQA(:) 00571 00572 ZA(:) = ZA(:) + PCT(:) * ZRORA(:) * & 00573 (2.* ZPEQA2(:) + & 00574 ZCNHUMA(:) * (ZDPQB(:)*ZPETA2(:) - ZPEQ_A_COEF(:)*ZPETB2(:) )) 00575 00576 ZB(:) = ZB(:) + PCT(:) * ZRORA(:) * ZPEQA2(:) 00577 00578 ZC(:) = ZC(:) + PCT(:)*ZRORA(:)*ZCNHUMA(:) *ZDPQB(:)*ZPETB2(:) 00579 00580 ENDIF 00581 ENDIF 00582 ! 00583 00584 !------------------------------------------------------------------------------- 00585 ! 00586 !* 6. T AT TIME 'T+DT' (before snowmelt or soil ice evolution) 00587 ! ----------------- 00588 ! 00589 IF(HISBA == 'DIF')THEN 00590 ! 00591 ! First determine terms needed for implicit linearization of surface: 00592 ! 00593 00594 ZCONDAVG(:) = (PDZG(:,1)*PSOILCONDZ(:,1) + PDZG(:,2)*PSOILCONDZ(:,2))/PD_G(:,2) 00595 ZA(:) = ZA(:) - (2. * XPI / XDAY) + 2.*ZCONDAVG(:)*PCT(:)/PD_G(:,2) 00596 ZTERM2(:) = 2.*ZCONDAVG(:)*PCT(:)/(ZA(:)*PD_G(:,2)) 00597 ZTERM1(:) = (PTG(:,1)*ZB(:) + (ZC(:) - (2. * XPI * PTG(:,2) / XDAY)) )/ZA(:) 00598 ! 00599 ! Save initial temperature profile (K): 00600 ! 00601 PDELTAT(:,:) = PTG(:,:) 00602 ! 00603 ! Determine the soil temperatures: 00604 ! 00605 CALL SOIL_HEATDIF(PTSTEP,PDZG,PDZDIF,PSOILCONDZ, & 00606 PSOILHCAPZ,PCT,ZTERM1,ZTERM2,PTDEEP_A,PTDEEP_B,PTG,PDEEP_FLUX ) 00607 ! 00608 ! Compute the change in temperature over the time 00609 ! step before adjustment owing to phase changes (K) 00610 ! (Used in the diffusion soil phase change computations) 00611 ! 00612 PDELTAT(:,:) = PTG(:,:) - PDELTAT(:,:) ! K 00613 ! 00614 ! 00615 ELSE 00616 ! 00617 IF(OTEMP_ARP)THEN 00618 ! 00619 CALL SOIL_TEMP_ARP(PTSTEP,ZA,ZB,ZC,PGAMMAT,PTDEEP_B,PSODELX,PTG) 00620 ! 00621 ELSE 00622 ! 00623 PTG(:,1) = ( PTG(:,1)*ZB(:) + ZC(:) ) / ZA(:) 00624 ! 00625 WHERE(PTDEEP_B(:) /= XUNDEF .AND. PGAMMAT(:) /= XUNDEF) 00626 PTG(:,2) = (PTG(:,2) + (PTSTEP/XDAY)*(PTG(:,1) + PGAMMAT(:)*PTDEEP_B(:)))/ & 00627 (1.+(PTSTEP/XDAY)*(1.0+PGAMMAT(:))) 00628 ELSEWHERE 00629 PTG(:,2) = (PTG(:,2) + (PTSTEP/XDAY)*PTG(:,1))/ & 00630 (1.+(PTSTEP/XDAY) ) 00631 END WHERE 00632 ! 00633 ENDIF 00634 ! 00635 ENDIF 00636 ! 00637 !------------------------------------------------------------------------------- 00638 !* 7. TA and QA AT TIME 'T+DT' 00639 ! ------------------------ 00640 ! (QA and TA are only modified by these expressions 00641 ! if the implicit atmospheric coupling is used) 00642 ! 00643 PQA_IC(:) = ZPEQ_A_COEF(:)*PTG(:,1) + ZPEQ_B_COEF(:) 00644 ! 00645 PTA_IC(:) = ZPET_A_COEF(:)*PTG(:,1) + ZPET_B_COEF(:) 00646 ! 00647 PUSTAR2_IC(:) = ZUSTAR2(:) 00648 ! 00649 !-------------------------------------------------------------------------------------- 00650 !* 8. Update of LSTT and LVTT for Arpege 00651 ! ---------------------------------- 00652 ! 00653 IF (LCPL_ARP) THEN 00654 00655 IF (.NOT.LQVNPLUS) THEN 00656 PCPS(:) = PCPS(:) + (XCPV-XCPD) *ZHUMS(:)*PDQSAT(:)*(PTG(:,1)-ZPTG_OLD(:)) 00657 ENDIF 00658 00659 00660 IF (LQVNPLUS) THEN 00661 PCPS(:) = PCPS(:) + (XCPV-XCPD) *ZHUMS(:)*PDQSAT(:)*(PTG(:,1)-ZPTG_OLD(:)) & 00662 + (XCPV-XCPD) *(1-ZHUMA(:))*(PQA_IC(:)-PQA(:)) 00663 ENDIF 00664 00665 PLSTT(:) = PLSTT(:) + (XCPV-XCI)*(PTG(:,1)-ZPTG_OLD(:)) 00666 00667 PLVTT(:) = PLVTT(:) + (XCPV-XCL)*(PTG(:,1)-ZPTG_OLD(:)) 00668 00669 00670 ENDIF 00671 IF (LHOOK) CALL DR_HOOK('E_BUDGET',1,ZHOOK_HANDLE) 00672 ! 00673 !------------------------------------------------------------------------------- 00674 ! 00675 END SUBROUTINE E_BUDGET
1.8.0
