|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE SNOW_COVER_1LAYER(PTSTEP, PANSMIN, PANSMAX, PTODRY, & 00003 PRHOSMIN, PRHOSMAX, PRHOFOLD, OALL_MELT, & 00004 PDRAIN_TIME, PWCRN, PZ0SN, PZ0HSN, & 00005 PTSNOW, PASNOW, PRSNOW, PWSNOW, PTS_SNOW, & 00006 PESNOW, & 00007 PTG,PABS_SW, PLW1, PLW2, & 00008 PTA, PQA, PVMOD, PPS, PRHOA, PSR, & 00009 PZREF, PUREF, & 00010 PRNSNOW, PHSNOW, PLESNOW, PGSNOW, PMELT, & 00011 PDQS_SNOW, PABS_LW ) 00012 ! ########################################################################## 00013 ! 00014 !!**** *SNOW_COVER_1LAYER* 00015 !! 00016 !! PURPOSE 00017 !! ------- 00018 ! 00019 ! One layer snow mantel scheme 00020 ! 00021 ! 00022 !!** METHOD 00023 ! ------ 00024 ! 00025 ! 00026 ! The temperature equation is written as: 00027 ! 00028 ! b T+ = y 00029 ! 00030 ! 00031 !! EXTERNAL 00032 !! -------- 00033 !! 00034 !! 00035 !! IMPLICIT ARGUMENTS 00036 !! ------------------ 00037 !! 00038 !! MODD_CST 00039 !! 00040 !! 00041 !! REFERENCE 00042 !! --------- 00043 !! 00044 !! 00045 !! AUTHOR 00046 !! ------ 00047 !! 00048 !! V. Masson * Meteo-France * 00049 !! 00050 !! MODIFICATIONS 00051 !! ------------- 00052 !! Original 08/09/98 00053 !! J. Escobar 24/10/2012 : BUF PGI10.X , rewrite some 1 line WHERE statement 00054 !------------------------------------------------------------------------------- 00055 ! 00056 !* 0. DECLARATIONS 00057 ! ------------ 00058 ! 00059 USE MODD_CSTS, ONLY : XTT, XCI, XRHOLI, XRHOLW, XCPD, XLSTT, XLMTT, XDAY, XCONDI 00060 USE MODD_SNOW_PAR, ONLY : XEMISSN 00061 USE MODD_SURF_PAR, ONLY : XUNDEF 00062 ! 00063 USE MODE_THERMOS 00064 ! 00065 USE MODI_SURFACE_RI 00066 USE MODI_SURFACE_AERO_COND 00067 ! 00068 ! 00069 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00070 USE PARKIND1 ,ONLY : JPRB 00071 ! 00072 IMPLICIT NONE 00073 ! 00074 !* 0.1 declarations of arguments 00075 ! 00076 ! 00077 REAL, INTENT(IN) :: PTSTEP ! time step 00078 REAL, INTENT(IN) :: PANSMIN ! minimum snow albedo 00079 REAL, INTENT(IN) :: PANSMAX ! maximum snow albedo 00080 REAL, INTENT(IN) :: PTODRY ! snow albedo decreasing constant 00081 REAL, INTENT(IN) :: PRHOSMIN ! minimum snow density 00082 REAL, INTENT(IN) :: PRHOSMAX ! maximum snow density 00083 REAL, INTENT(IN) :: PRHOFOLD ! snow density increasing constant 00084 LOGICAL, INTENT(IN) :: OALL_MELT! T --> all snow runs off if 00085 ! lower surf. temperature is 00086 ! positive 00087 REAL, INTENT(IN) :: PDRAIN_TIME ! drainage folding time (days) 00088 REAL, INTENT(IN) :: PWCRN ! critical snow amount necessary 00089 ! to cover the considered surface 00090 REAL, INTENT(IN) :: PZ0SN ! snow roughness length for momentum 00091 REAL, INTENT(IN) :: PZ0HSN ! snow roughness length for heat 00092 REAL, DIMENSION(:), INTENT(INOUT) :: PWSNOW ! snow reservoir (kg/m2) 00093 REAL, DIMENSION(:), INTENT(INOUT) :: PTSNOW ! snow temperature 00094 REAL, DIMENSION(:), INTENT(INOUT) :: PASNOW ! snow albedo 00095 REAL, DIMENSION(:), INTENT(INOUT) :: PRSNOW ! snow density 00096 REAL, DIMENSION(:), INTENT(INOUT) :: PTS_SNOW ! snow surface temperature 00097 REAL, DIMENSION(:), INTENT(INOUT) :: PESNOW ! snow emissivity 00098 REAL, DIMENSION(:), INTENT(IN) :: PTG ! underlying ground temperature 00099 REAL, DIMENSION(:), INTENT(IN) :: PABS_SW ! absorbed SW energy (Wm-2) 00100 REAL, DIMENSION(:), INTENT(IN) :: PLW1 ! LW coef independant of TSNOW 00101 ! (Wm-2) usually equal to: 00102 ! emis_snow * LW_down 00103 ! 00104 REAL, DIMENSION(:), INTENT(IN) :: PLW2 ! LW coef dependant of TSNOW 00105 ! (Wm-2 K-4) usually equal to: 00106 ! -1 * emis_snow * stefan_constant 00107 ! 00108 REAL, DIMENSION(:), INTENT(IN) :: PTA ! temperature at the lowest level 00109 REAL, DIMENSION(:), INTENT(IN) :: PQA ! specific humidity 00110 ! at the lowest level 00111 REAL, DIMENSION(:), INTENT(IN) :: PVMOD ! module of the horizontal wind 00112 REAL, DIMENSION(:), INTENT(IN) :: PPS ! pressure at the surface 00113 REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density 00114 ! at the lowest level 00115 REAL, DIMENSION(:), INTENT(IN) :: PSR ! snow rate 00116 REAL, DIMENSION(:), INTENT(IN) :: PZREF ! reference height of the first 00117 ! atmospheric level (temperature) 00118 REAL, DIMENSION(:), INTENT(IN) :: PUREF ! reference height of the first 00119 ! atmospheric level (wind) 00120 REAL, DIMENSION(:), INTENT(OUT) :: PRNSNOW ! net radiation over snow 00121 REAL, DIMENSION(:), INTENT(OUT) :: PHSNOW ! sensible heat flux over snow 00122 REAL, DIMENSION(:), INTENT(OUT) :: PLESNOW ! latent heat flux over snow 00123 REAL, DIMENSION(:), INTENT(OUT) :: PGSNOW ! flux under the snow 00124 REAL, DIMENSION(:), INTENT(OUT) :: PMELT ! snow melting rate (kg/m2/s) 00125 REAL, DIMENSION(:), INTENT(OUT) :: PDQS_SNOW! heat storage inside snow 00126 REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW ! absorbed LW rad by snow (W/m2) 00127 ! 00128 ! 00129 !* 0.2 declarations of local variables 00130 ! 00131 REAL :: ZEXPL = 0. 00132 REAL :: ZIMPL = 1. 00133 ! 00134 REAL, DIMENSION(SIZE(PWSNOW)) :: ZEXNS, ZEXNA, ZDIRCOSZW 00135 REAL, DIMENSION(SIZE(PWSNOW)) :: ZZ0 ! roughness length for momentum 00136 REAL, DIMENSION(SIZE(PWSNOW)) :: ZZ0H ! roughness length forheat 00137 ! 00138 REAL, DIMENSION(SIZE(PWSNOW)) :: ZRI ! Richardson number 00139 REAL, DIMENSION(SIZE(PWSNOW)) :: ZAC ! aerodynamical conductance 00140 REAL, DIMENSION(SIZE(PWSNOW)) :: ZRA ! aerodynamical resistance 00141 REAL, DIMENSION(SIZE(PWSNOW)) :: ZCH ! drag coefficient for heat 00142 REAL, DIMENSION(SIZE(PWSNOW)) :: ZB, ZY ! coefficients in Ts eq. 00143 REAL, DIMENSION(SIZE(PWSNOW)) :: ZWSNOW ! snow before evolution 00144 REAL, DIMENSION(SIZE(PWSNOW)) :: ZSNOW_HC ! snow heat capacity 00145 REAL, DIMENSION(SIZE(PWSNOW)) :: ZSNOW_TC ! snow thermal conductivity 00146 REAL, DIMENSION(SIZE(PWSNOW)) :: ZSNOW_D ! snow depth 00147 REAL, DIMENSION(SIZE(PWSNOW)) :: ZMELT ! snow melting rate (kg/m3/s) 00148 REAL, DIMENSION(SIZE(PWSNOW)) :: ZTS_SNOW ! snow surface temperature 00149 ! at previous time-step 00150 REAL, DIMENSION(SIZE(PWSNOW)) :: ZQSAT ! specific humidity 00151 ! ! for ice 00152 REAL, DIMENSION(SIZE(PWSNOW)) :: ZDQSAT ! d(specific humidity)/dT 00153 ! ! for ice 00154 ! 00155 REAL, DIMENSION(SIZE(PWSNOW)) :: ZSR1, ZSR2 ! norm. snow precip. 00156 ! 00157 LOGICAL, DIMENSION(SIZE(PWSNOW)) :: GSNOWMASK ! where snow is 00158 ! ! at previuos time-step 00159 LOGICAL, DIMENSION(SIZE(PWSNOW)) :: GFLUXMASK ! where fluxes can 00160 ! ! be computed at 00161 ! ! new time-step 00162 ! ! i.e. snow occurence 00163 ! ! at previous time-step 00164 ! ! OR snow fall 00165 INTEGER, DIMENSION(SIZE(PWSNOW)) :: JSNOWMASK1, JSNOWMASK2, JSNOWMASK3 ! where snow is or not 00166 ! ! at previuos time-step 00167 INTEGER, DIMENSION(SIZE(PWSNOW)) :: JFLUXMASK ! where fluxes can 00168 ! ! be computed at 00169 ! ! new time-step 00170 ! ! i.e. snow occurence 00171 ! ! at previous time-step 00172 ! ! OR snow fall 00173 ! 00174 REAL :: ZWSNOW_MIN = 0.1 ! minimum value of snow content (kg/m2) for prognostic 00175 ! ! computations 00176 ! 00177 REAL, DIMENSION(SIZE(PWSNOW)) :: ZEI_SNOW ! internal energy of snow 00178 REAL, DIMENSION(SIZE(PWSNOW)) :: ZPEI_SNOW ! internal energy of snow at t+ 00179 REAL, DIMENSION(SIZE(PWSNOW)) :: ZWORK1 00180 REAL, DIMENSION(SIZE(PWSNOW)) :: ZDQSATI, ZQSATI 00181 ! 00182 INTEGER :: JJ, JI, JCOMPT_SNOW1, JCOMPT_SNOW2, JCOMPT_SNOW3, JCOMPT_FLUX 00183 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00184 !------------------------------------------------------------------------------- 00185 ! 00186 ! 00187 IF (LHOOK) CALL DR_HOOK('SNOW_COVER_1LAYER',0,ZHOOK_HANDLE) 00188 ZB(:)=0. 00189 ZY(:)=0. 00190 ZMELT (:) = 0. 00191 PMELT (:) = 0. 00192 PRNSNOW(:) = 0. 00193 PHSNOW (:) = 0. 00194 PLESNOW(:) = 0. 00195 PGSNOW (:) = 0. 00196 PABS_LW(:) = XUNDEF 00197 ! 00198 !* snow reservoir before evolution 00199 ! 00200 ZWSNOW(:) = PWSNOW(:) 00201 ZTS_SNOW(:) = MIN(XTT,PTG(:)) 00202 ! 00203 ZSNOW_D (:) = 0. 00204 ZSNOW_TC(:) = 0. 00205 ZSNOW_HC(:) = 0. 00206 ! 00207 !------------------------------------------------------------------------------- 00208 ! 00209 !* 1.1 most useful masks 00210 ! ----------------- 00211 ! 00212 GSNOWMASK(:)=.FALSE. 00213 GFLUXMASK(:)=.FALSE. 00214 JSNOWMASK1(:)=0. 00215 JSNOWMASK2(:)=0. 00216 JSNOWMASK3(:)=0. 00217 JFLUXMASK(:)=0. 00218 00219 !* 1.2 drag 00220 ! ---- 00221 ! 00222 !* 1.2.1 defaults 00223 ! -------- 00224 ! 00225 !* variation of temperature with altitude is neglected 00226 ! 00227 ZEXNS(:) = 1. 00228 ZEXNA(:) = 1. 00229 ! 00230 !* slope is neglected in drag computation 00231 ! 00232 ZDIRCOSZW(:) = 1. 00233 ! 00234 !* roughness length are imposed: 00235 ! 00236 ZZ0 (:) = PZ0SN 00237 ZZ0H (:) = PZ0HSN 00238 00239 ! 00240 ! 00241 !* 1.1 most useful masks 00242 ! ----------------- 00243 !* snow occurence at previous time-step 00244 ! 00245 !* snow occurence during the time-step for fluxes computation 00246 ! 00247 JCOMPT_SNOW1=0 00248 JCOMPT_SNOW2=0 00249 JCOMPT_SNOW3=0 00250 JCOMPT_FLUX=0 00251 DO JJ=1,SIZE(ZWSNOW) 00252 IF (ZWSNOW(JJ)>0.) THEN 00253 GSNOWMASK(JJ)=.TRUE. 00254 !* surface temperature 00255 ZTS_SNOW(JJ)=PTS_SNOW(JJ) 00256 GFLUXMASK(JJ)=.TRUE. 00257 !gsnowmask=t 00258 JCOMPT_SNOW1=JCOMPT_SNOW1+1 00259 JSNOWMASK1(JCOMPT_SNOW1) = JJ 00260 !gfluxmask=t 00261 JCOMPT_FLUX=JCOMPT_FLUX+1 00262 JFLUXMASK(JCOMPT_FLUX) = JJ 00263 IF (ZWSNOW(JJ)>=ZWSNOW_MIN) THEN 00264 !second snow mask 00265 JCOMPT_SNOW3=JCOMPT_SNOW3+1 00266 JSNOWMASK3(JCOMPT_SNOW3)=JJ 00267 ELSE 00268 !lower limit of snow cover for prognostic computations 00269 !0.1 kg/m2 of snow water content 00270 PTSNOW(JJ)=MIN(PTG(JJ),XTT) 00271 ENDIF 00272 ELSE 00273 PTSNOW(JJ)=MIN(PTG(JJ),XTT) 00274 !gsnowmask=false 00275 JCOMPT_SNOW2=JCOMPT_SNOW2+1 00276 JSNOWMASK2(JCOMPT_SNOW2) = JJ 00277 IF (PSR(JJ)>0.) THEN 00278 GFLUXMASK(JJ)=.TRUE. 00279 JCOMPT_FLUX=JCOMPT_FLUX+1 00280 JFLUXMASK(JCOMPT_FLUX) = JJ 00281 ENDIF 00282 ENDIF 00283 ENDDO 00284 ! 00285 !------------------------------------------------------------------------------- 00286 ! 00287 !* 1.2 drag 00288 ! ---- 00289 ! 00290 !* 1.2.2 qsat (Tsnow) 00291 ! ------------ 00292 ! 00293 ZQSAT(:) = QSATI(ZTS_SNOW(:), PPS(:) ) 00294 ! 00295 !* 1.2.3 Richardson number 00296 ! ----------------- 00297 ! 00298 !* snow is present on all the considered surface. 00299 !* computation occurs where snow is and/or falls. 00300 ! 00301 CALL SURFACE_RI(ZTS_SNOW, ZQSAT, ZEXNS, ZEXNA, PTA, PQA, & 00302 PZREF, PUREF, ZDIRCOSZW, PVMOD, ZRI ) 00303 ! 00304 !* 1.2.4 Aerodynamical conductance 00305 ! ------------------------- 00306 ! 00307 CALL SURFACE_AERO_COND(ZRI, PZREF, PUREF, PVMOD, ZZ0, ZZ0H, ZAC, ZRA, ZCH) 00308 ! 00309 !------------------------------------------------------------------------------- 00310 ! 00311 !* 2. snow thermal characteristics 00312 ! ---------------------------- 00313 !cdir nodep 00314 DO JJ=1,JCOMPT_SNOW1 00315 ! 00316 JI = JSNOWMASK1(JJ) 00317 ! 00318 !* 2.1 snow heat capacity 00319 ZSNOW_HC(JI) = PRSNOW(JI) * XCI * XRHOLI / XRHOLW 00320 !* 2.2 snow depth 00321 ZSNOW_D(JI) = ZWSNOW(JI) / PRSNOW(JI) 00322 !* 2.3 snow thermal conductivity 00323 ZSNOW_TC(JI) = XCONDI * (PRSNOW(JI)/XRHOLW)**1.885 00324 !* 2.4 internal energy of snow 00325 ZEI_SNOW(JI) = ZSNOW_HC(JI)*ZSNOW_D(JI)*PTSNOW(JI) 00326 ! 00327 ENDDO 00328 ! 00329 !cdir nodep 00330 DO JJ=1,JCOMPT_SNOW2 00331 ! 00332 JI = JSNOWMASK2(JJ) 00333 ! 00334 !* 2.1 snow heat capacity 00335 ZSNOW_HC(JI) = PRHOSMIN * XCI * XRHOLI / XRHOLW 00336 !* 2.2 snow depth 00337 ZSNOW_D(JI) = PTSTEP * PSR(JI) / PRHOSMIN 00338 !* 2.3 snow thermal conductivity 00339 ZSNOW_TC(JI) = XCONDI * (PRHOSMIN /XRHOLW)**1.885 00340 !* 2.4 internal energy of snow 00341 ZEI_SNOW(JI) = 0. 00342 ! 00343 ENDDO 00344 ! 00345 !------------------------------------------------------------------------------- 00346 ! 00347 !* 3. Snow temperature evolution 00348 ! -------------------------- 00349 ! 00350 !* 3.5 dqsat/ dT (Tsnow) 00351 ! ----------------- 00352 ! 00353 ZDQSATI = DQSATI(ZTS_SNOW(:),PPS(:),ZQSAT(:)) 00354 WHERE (GSNOWMASK(:) .AND. ZWSNOW(:)>=ZWSNOW_MIN) 00355 ZDQSAT(:) = ZDQSATI(:) 00356 END WHERE 00357 ! 00358 !* 3.1 coefficients from Temperature tendency 00359 ! -------------------------------------- 00360 ! 00361 !cdir nodep 00362 DO JJ=1,JCOMPT_SNOW3 00363 ! 00364 JI=JSNOWMASK3(JJ) 00365 00366 ZWORK1(JI) = ZSNOW_D(JI) * ZSNOW_HC(JI) / PTSTEP 00367 ! 00368 ZB(JI) = ZB(JI) + ZWORK1(JI) 00369 ! 00370 !* 3.2 coefficients from solar radiation 00371 ! --------------------------------- 00372 ! 00373 ZY(JI) = ZY(JI) + ZWORK1(JI) * PTSNOW(JI) + PABS_SW(JI) 00374 ! 00375 ! 00376 !* 3.3 coefficients from infra-red radiation 00377 ! ------------------------------------- 00378 ! 00379 ZWORK1(JI) = PLW2(JI) * PTSNOW(JI)**3 00380 ! 00381 ZB(JI) = ZB(JI) - 4 * ZIMPL * ZWORK1(JI) 00382 ! 00383 ZY(JI) = ZY(JI) + PLW1(JI) + ZWORK1(JI) * (ZEXPL-3.*ZIMPL) * PTSNOW(JI) 00384 ! 00385 ! 00386 !* 3.4 coefficients from sensible heat flux 00387 ! ------------------------------------ 00388 ! 00389 ZWORK1(JI) = XCPD * PRHOA(JI) * ZAC(JI) 00390 ! 00391 ZB(JI) = ZB(JI) + ZWORK1(JI) * ZIMPL 00392 ! 00393 ZY(JI) = ZY(JI) - ZWORK1(JI) * ( ZEXPL * PTSNOW(JI) - PTA(JI) ) 00394 ! 00395 ! 00396 !* 3.6 coefficients from latent heat flux 00397 ! ---------------------------------- 00398 ! 00399 ZWORK1(JI) = XLSTT * PRHOA(JI) * ZAC(JI) 00400 ! 00401 ZB(JI) = ZB(JI) + ZWORK1(JI) * ZIMPL * ZDQSAT(JI) 00402 ! 00403 ZY(JI) = ZY(JI) - ZWORK1(JI) * ( ZQSAT(JI) - PQA(JI) - ZIMPL * ZDQSAT(JI)*PTSNOW(JI) ) 00404 ! 00405 !* 3.7 coefficients from conduction flux at snow base 00406 ! ---------------------------------------------- 00407 ! 00408 ZWORK1(JI) = ZSNOW_TC(JI)/(0.5*ZSNOW_D(JI)) 00409 ! 00410 ZB(JI) = ZB(JI) + ZWORK1(JI) * ZIMPL 00411 ! 00412 ZY(JI) = ZY(JI) - ZWORK1(JI) * (ZEXPL * PTSNOW(JI) - PTG(JI)) 00413 ! 00414 !* 3.8 guess of snow temperature before accumulation and melting 00415 ! --------------------------------------------------------- 00416 ! 00417 PTSNOW(JI) = ZY(JI) / ZB(JI) 00418 ! 00419 ENDDO 00420 ! 00421 !------------------------------------------------------------------------------- 00422 ! 00423 !* 4. Snow melt 00424 ! --------- 00425 ! 00426 !* 4.1 melting 00427 ! ------- 00428 ! 00429 !cdir nodep 00430 DO JJ=1,JCOMPT_SNOW1 00431 ! 00432 JI = JSNOWMASK1(JJ) 00433 ! 00434 ZMELT(JI) = MAX( PTSNOW(JI) - XTT , 0. ) * ZSNOW_HC(JI) / XLMTT / PTSTEP 00435 ! 00436 ZMELT(JI) = MIN( ZMELT(JI) , ZWSNOW(JI) / ZSNOW_D(JI) / PTSTEP ) 00437 ! 00438 PTSNOW(JI) = MIN( PTSNOW(JI) , XTT ) 00439 ! 00440 ENDDO 00441 ! 00442 !* 4.2 run-off of all snow if lower surface temperature is positive 00443 ! ------------------------------------------------------------ 00444 ! 00445 !* this option is used when snow is located on sloping roofs for example. 00446 ! 00447 IF (OALL_MELT) THEN 00448 WHERE ( GSNOWMASK(:) .AND. PTG(:)>XTT .AND. ZWSNOW(:)>=ZWSNOW_MIN ) 00449 PMELT(:) = PMELT(:) + ZWSNOW(:) / PTSTEP 00450 END WHERE 00451 END IF 00452 ! 00453 !* 4.3 output melting in kg/m2/s 00454 ! ------------------------- 00455 ! 00456 PMELT(:) = ZMELT(:) * ZSNOW_D(:) 00457 ! 00458 !------------------------------------------------------------------------------- 00459 ! 00460 !* 5. fluxes 00461 ! ------ 00462 ! 00463 !* 5.3 qsat (Tsnow) 00464 ! ------------ 00465 ! 00466 ZQSATI = QSATI(PTSNOW(:),PPS(:)) 00467 WHERE (GFLUXMASK(:)) 00468 ZQSAT(:) = ZQSATI(:) 00469 END WHERE 00470 ! 00471 !* 5.1 net radiation (with Ts lin. extrapolation) 00472 ! ------------- 00473 ! 00474 !cdir nodep 00475 DO JJ = 1, JCOMPT_FLUX 00476 ! 00477 JI = JFLUXMASK(JJ) 00478 ! 00479 PABS_LW(JI) = PLW1(JI) + PLW2(JI) * PTSNOW(JI)**4 00480 ! 00481 PRNSNOW(JI) = PABS_SW(JI) + PABS_LW(JI) 00482 ! 00483 ! 00484 !* 5.2 sensible heat flux 00485 ! ------------------ 00486 ! 00487 PHSNOW(JI) = XCPD * PRHOA(JI) * ZAC(JI) * ( PTSNOW(JI) - PTA(JI) ) 00488 ! 00489 ! 00490 !* 5.4 latent heat flux 00491 ! ---------------- 00492 ! 00493 PLESNOW(JI) = XLSTT * PRHOA(JI) * ZAC(JI) * ( ZQSAT(JI) - PQA(JI) ) 00494 ! 00495 ! 00496 !* 5.5 Conduction heat flux 00497 ! -------------------- 00498 ! 00499 PGSNOW(JI) = ZSNOW_TC(JI)/(0.5*ZSNOW_D(JI)) * ( PTSNOW(JI) - PTG(JI) ) 00500 ! 00501 ! 00502 !* 5.6 If ground T>0 C, Melting is estimated from conduction heat flux 00503 ! --------------------------------------------------------------- 00504 ! 00505 IF (PTG(JI)>XTT) PMELT(JI) = MAX (PMELT(JI), -PGSNOW(JI)/XLMTT) 00506 ! 00507 ENDDO 00508 ! 00509 !------------------------------------------------------------------------------- 00510 ! 00511 !* 6. reservoir evolution 00512 ! ------------------- 00513 ! 00514 !cdir nodep 00515 DO JJ = 1, SIZE(PWSNOW) 00516 ! 00517 !* 6.1 snow fall 00518 ! --------- 00519 ! 00520 PWSNOW(JJ) = PWSNOW(JJ) + PTSTEP * PSR(JJ) 00521 ! 00522 ! 00523 !* 6.2 sublimation 00524 ! ----------- 00525 ! 00526 PLESNOW(JJ) = MIN( PLESNOW(JJ), XLSTT*PWSNOW(JJ)/PTSTEP ) 00527 ! 00528 PWSNOW(JJ) = MAX( PWSNOW(JJ) - PTSTEP * PLESNOW(JJ)/XLSTT , 0.) 00529 ! 00530 IF ( PWSNOW(JJ)<1.E-8 * PTSTEP ) PWSNOW(JJ) = 0. 00531 ! 00532 !* 6.3 melting 00533 ! ------- 00534 ! 00535 PMELT(JJ) = MIN( PMELT(JJ), PWSNOW(JJ)/PTSTEP ) 00536 ! 00537 PWSNOW(JJ)= MAX( PWSNOW(JJ) - PTSTEP * PMELT(JJ) , 0.) 00538 ! 00539 IF ( PWSNOW(JJ)<1.E-8 * PTSTEP ) PWSNOW(JJ) = 0. 00540 ! 00541 IF (PWSNOW(JJ)==0.) PGSNOW(JJ) = MAX ( PGSNOW(JJ), - PMELT(JJ)*XLMTT ) 00542 ! 00543 ENDDO 00544 ! 00545 !* 6.4 time dependent drainage 00546 ! ----------------------- 00547 ! 00548 IF (PDRAIN_TIME>0.) THEN 00549 WHERE ( PWSNOW(:)>0.) 00550 PWSNOW(:) = PWSNOW(:) * EXP(-PTSTEP/PDRAIN_TIME/XDAY) 00551 END WHERE 00552 END IF 00553 ! 00554 !* 6.5 melting of last 1mm of snow depth 00555 ! --------------------------------- 00556 ! 00557 WHERE ( PWSNOW(:)<ZWSNOW_MIN .AND. PMELT(:)>0. .AND. PSR(:)==0. ) 00558 PMELT(:) = PMELT(:) + PWSNOW(:) / PTSTEP 00559 PWSNOW(:)=0. 00560 END WHERE 00561 ! 00562 WHERE ( PWSNOW(:)<1.E-8 * PTSTEP ) 00563 PWSNOW(:) = 0. 00564 END WHERE 00565 ! 00566 !------------------------------------------------------------------------------- 00567 ! 00568 !* 7. albedo evolution 00569 ! ---------------- 00570 ! 00571 !* 7.1 If melting occurs or not 00572 ! ----------------------- 00573 ! 00574 ! 00575 !cdir nodep 00576 DO JJ=1,JCOMPT_SNOW1 00577 ! 00578 JI = JSNOWMASK1(JJ) 00579 ! 00580 IF (PMELT(JI) > 0. ) THEN 00581 ! 00582 PASNOW(JI) = (PASNOW(JI)-PANSMIN)*EXP(-PRHOFOLD*PTSTEP/XDAY) + PANSMIN & 00583 + PSR(JI)*PTSTEP/PWCRN*PANSMAX 00584 ! 00585 ELSEIF (PMELT(JI)==0.) THEN 00586 PASNOW(JI) = PASNOW(JI) - PTODRY*PTSTEP/XDAY & 00587 + PSR(JI)*PTSTEP/PWCRN*PANSMAX 00588 ! 00589 ENDIF 00590 ! 00591 ENDDO 00592 ! 00593 !------------------------------------------------------------------------------- 00594 ! 00595 !* 8. density evolution 00596 ! ----------------- 00597 ! 00598 !* 8.1 old snow 00599 ! -------- 00600 ! 00601 !cdir nodep 00602 DO JJ = 1, JCOMPT_SNOW1 00603 ! 00604 JI = JSNOWMASK1(JJ) 00605 ! 00606 IF (PWSNOW(JI)>0. ) THEN 00607 ! 00608 ZSR1(JI) = MAX( PWSNOW(JI) , PSR(JI) * PTSTEP ) 00609 ! 00610 PRSNOW(JI) = (PRSNOW(JI)-PRHOSMAX)*EXP(-PRHOFOLD*PTSTEP/XDAY) + PRHOSMAX 00611 PRSNOW(JI) = ( (ZSR1(JI)-PSR(JI)*PTSTEP) * PRSNOW(JI) & 00612 + (PSR(JI)*PTSTEP) * PRHOSMIN ) / ZSR1(JI) 00613 ENDIF 00614 ! 00615 ENDDO 00616 ! 00617 !* 8.2 fresh snow 00618 ! ---------- 00619 ! 00620 !cdir nodep 00621 DO JJ=1,SIZE(PWSNOW) 00622 IF ( PWSNOW(JJ)>0. ) THEN 00623 PASNOW(JJ) = MAX(PASNOW(JJ),PANSMIN) 00624 PASNOW(JJ) = MIN(PASNOW(JJ),PANSMAX) 00625 IF (ZWSNOW(JJ)==0.) THEN 00626 PASNOW(JJ) = PANSMAX 00627 PESNOW(JJ) = XEMISSN 00628 PRSNOW(JJ) = PRHOSMIN 00629 ENDIF 00630 ENDIF 00631 ENDDO 00632 ! 00633 !------------------------------------------------------------------------------- 00634 ! 00635 !* 9. fresh snow accumulation (if more than 1mm of snow depth) 00636 ! ----------------------- 00637 ! 00638 !cdir nodep 00639 DO JJ=1,JCOMPT_SNOW3 00640 ! 00641 JI = JSNOWMASK3(JJ) 00642 ! 00643 IF (PSR(JI)>0. .AND. PWSNOW(JI)>0.) THEN 00644 ! 00645 ZSR2(JI) = MIN( PWSNOW(JI) , PSR(JI) * PTSTEP ) 00646 ! 00647 PTSNOW(JI) =( ( PWSNOW(JI) - ZSR2(JI) ) * PTSNOW(JI) & 00648 + ZSR2(JI) * MIN( PTA (JI) ,XTT ))& 00649 /( PWSNOW(JI) ) 00650 ENDIF 00651 ! 00652 ENDDO 00653 ! 00654 !------------------------------------------------------------------------------- 00655 ! 00656 !* 10. Surface temperature 00657 ! ------------------- 00658 ! 00659 !* note that if the relation between snow pack temperature and its 00660 ! surface temperature is modified, think to modify it also in 00661 ! subroutine init_snow_lw.f90 00662 ! 00663 WHERE (GSNOWMASK(:) ) 00664 PTS_SNOW(:) = PTSNOW(:) 00665 END WHERE 00666 ! 00667 !------------------------------------------------------------------------------- 00668 ! 00669 !* 11. bogus values 00670 ! ------------ 00671 ! 00672 !* 11.1 snow characteristics where snow IS present at current time-step 00673 ! --------------------------------------------------------------- 00674 ! 00675 WHERE (PWSNOW(:)==0.) 00676 PTSNOW (:) = XUNDEF 00677 PRSNOW (:) = XUNDEF 00678 PASNOW (:) = XUNDEF 00679 PTS_SNOW(:) = XUNDEF 00680 PESNOW (:) = XUNDEF 00681 END WHERE 00682 ! 00683 ! 00684 !------------------------------------------------------------------------------- 00685 ! 00686 !* 12. Heat storage inside snow pack 00687 ! 00688 WHERE (GSNOWMASK(:)) 00689 ZPEI_SNOW(:) = ZSNOW_HC(:)*ZSNOW_D(:)*PTSNOW(:) 00690 ELSEWHERE 00691 ZPEI_SNOW(:) = 0. 00692 END WHERE 00693 PDQS_SNOW(:) = (ZPEI_SNOW(:)-ZEI_SNOW(:))/PTSTEP 00694 ! 00695 IF (LHOOK) CALL DR_HOOK('SNOW_COVER_1LAYER',1,ZHOOK_HANDLE) 00696 00697 !------------------------------------------------------------------------------- ! 00698 END SUBROUTINE SNOW_COVER_1LAYER 00699
1.8.0
