|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE SNOW3L_ISBA(HISBA, HSNOW_ISBA, HSNOWRES, OGLACIER, HIMPLICIT_WIND, & 00003 TPTIME, PTSTEP, PVEGTYPE, & 00004 PSNOWSWE, PSNOWHEAT, PSNOWRHO, PSNOWALB, & 00005 PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST,PSNOWAGE, & 00006 PTG, PCG, PCT, PSOILCONDZ, & 00007 PPS, PTA, PSW_RAD, PQA, PVMOD, PLW_RAD, PRR, PSR, & 00008 PRHOA, PUREF, PEXNS, PEXNA, PDIRCOSZW, & 00009 PZREF, PZ0NAT, PZ0EFF, PZ0HNAT, PALB, PD_G1, & 00010 PPEW_A_COEF, PPEW_B_COEF, & 00011 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, & 00012 PTHRUFAL, PGRNDFLUX, PEVAPCOR, & 00013 PRNSNOW, PHSNOW, PGFLUXSNOW, PHPSNOW, PLES3L, PLEL3L, PEVAP, & 00014 PUSTARSNOW, & 00015 PPSN, PSRSFC, PRRSFC, PSMELTFLUX, & 00016 PEMISNOW, PCDSNOW, PCHSNOW, PSNOWTEMP, PSNOWLIQ, PSNOWDZ, & 00017 PSNOWHMASS, PRI, PZENITH, PLAT, PLON ) 00018 ! ###################################################################################### 00019 ! 00020 !!**** *SNOW3L_ISBA* 00021 !! 00022 !! PURPOSE 00023 !! ------- 00024 ! 00025 ! 3-Layer snow scheme option (Boone and Etchevers 1999) 00026 ! This routine is NOT called as snow depth goes below 00027 ! a critical threshold which is vanishingly small. 00028 ! This routine acts as an interface between SNOW3L and ISBA. 00029 ! 00030 !!** METHOD 00031 !! ------ 00032 ! 00033 ! Direct calculation 00034 ! 00035 !! EXTERNAL 00036 !! -------- 00037 ! 00038 ! None 00039 !! 00040 !! IMPLICIT ARGUMENTS 00041 !! ------------------ 00042 !! 00043 !! 00044 !! REFERENCE 00045 !! --------- 00046 !! 00047 !! Boone and Etchevers (1999) 00048 !! Belair (1995) 00049 !! Noilhan and Planton (1989) 00050 !! Noilhan and Mahfouf (1996) 00051 !! 00052 !! AUTHOR 00053 !! ------ 00054 !! A. Boone * Meteo-France * 00055 !! 00056 !! MODIFICATIONS 00057 !! ------------- 00058 !! Original 7/99 Boone 00059 !! Packing added 4/00 Masson & Boone 00060 !! z0h and snow 2/06 LeMoigne 00061 !! 00062 !! Modified by B. Decharme (03/2009): Consistency with Arpege permanent 00063 !! snow/ice treatment 00064 !! Modified by A. Boone (04/2010): Implicit coupling with atmosphere permitted. 00065 !! 00066 !! Modified by B. Decharme (04/2010): check suspicious low temperature for ES and CROCUS 00067 !! 00068 !------------------------------------------------------------------------------- 00069 ! 00070 USE MODD_CSTS, ONLY : XTT, XPI, XDAY, XLMTT 00071 USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWDMIN, XRHOSMIN_ES 00072 USE MODD_SURF_PAR, ONLY : XUNDEF 00073 USE MODD_TYPE_DATE_SURF, ONLY: DATE_TIME 00074 ! 00075 USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW 00076 ! 00077 USE MODI_SNOW3L 00078 USE MODI_SNOWCRO 00079 ! 00080 USE MODI_ABOR1_SFX 00081 ! 00082 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00083 USE PARKIND1 ,ONLY : JPRB 00084 ! 00085 IMPLICIT NONE 00086 ! 00087 ! 00088 ! 00089 !* 0.1 declarations of arguments 00090 ! 00091 REAL, INTENT(IN) :: PTSTEP 00092 ! PTSTEP = time step of the integration 00093 ! 00094 REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! fraction of each vegetation 00095 ! 00096 CHARACTER(LEN=*), INTENT(IN) :: HISBA 00097 ! HISBA = FLAG to use Force-Restore or DIFfusion 00098 ! soil heat and mass transfer method 00099 ! 00100 CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA 00101 ! HSNOW_ISBA = FLAG to use SNOW3L or not 00102 ! (or default FR method) 00103 ! 00104 CHARACTER(LEN=*), INTENT(IN) :: HSNOWRES 00105 ! HSNOWRES = ISBA-SNOW3L turbulant exchange option 00106 ! 'DEF' = Default: Louis (ISBA: Noilhan and Mahfouf 1996) 00107 ! 'RIL' = Limit Richarson number under very stable 00108 ! conditions (currently testing) 00109 ! 00110 LOGICAL, INTENT(IN) :: OGLACIER ! True = Over permanent snow and ice, 00111 ! initialise WGI=WSAT, 00112 ! Hsnow>=10m and allow 0.8<SNOALB<0.85 00113 ! 00114 CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option 00115 ! ! 'OLD' = direct 00116 ! ! 'NEW' = Taylor serie, order 1 00117 ! 00118 TYPE(DATE_TIME), INTENT(IN) :: TPTIME ! current date and time 00119 ! 00120 ! 00121 REAL, DIMENSION(:), INTENT(IN) :: PTG, PD_G1, PCG, PCT, 00122 PSOILCONDZ 00123 ! PTG = Surface soil temperature (effective 00124 ! temperature the of layer lying below snow) 00125 ! PD_G1 = Assumed first soil layer thickness (m) 00126 ! Used to calculate ground/snow heat flux 00127 ! PCG = area-averaged soil heat capacity [(K m2)/J] 00128 ! PCT = area-averaged surface heat capacity [(K m2)/J] 00129 ! PSOILCONDZ= soil thermal conductivity (W m-1 K-1) 00130 ! 00131 REAL, DIMENSION(:), INTENT(IN) :: PPS, PTA, PSW_RAD, PQA, 00132 PVMOD, PLW_RAD, PSR, PRR 00133 ! PSW_RAD = incoming solar radiation (W/m2) 00134 ! PLW_RAD = atmospheric infrared radiation (W/m2) 00135 ! PRR = rain rate [kg/(m2 s)] 00136 ! PSR = snow rate (SWE) [kg/(m2 s)] 00137 ! PTA = atmospheric temperature at level za (K) 00138 ! PVMOD = modulus of the wind parallel to the orography (m/s) 00139 ! PPS = surface pressure 00140 ! PQA = atmospheric specific humidity 00141 ! at level za 00142 ! 00143 REAL, DIMENSION(:), INTENT(IN) :: PZREF, PUREF, PEXNS, PEXNA, PDIRCOSZW, PRHOA, PZ0NAT, PZ0EFF, PZ0HNAT, PALB 00144 ! PZ0EFF = roughness length for momentum 00145 ! PZ0NAT = grid box average roughness length 00146 ! PZ0HNAT = grid box average roughness length 00147 ! PZREF = reference height of the first 00148 ! atmospheric level 00149 ! PUREF = reference height of the wind 00150 ! PRHOA = air density 00151 ! PEXNS = Exner function at surface 00152 ! PEXNA = Exner function at lowest atmos level 00153 ! PDIRCOSZW = Cosinus of the angle between the 00154 ! normal to the surface and the vertical 00155 ! PALB = soil/vegetation albedo 00156 ! 00157 REAL, DIMENSION(:), INTENT(IN) :: PPSN 00158 ! PPSN = Snow cover fraction (total) 00159 ! 00160 REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF, PPEW_B_COEF, 00161 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, 00162 PPEQ_B_COEF 00163 ! PPEW_A_COEF = wind coefficient 00164 ! PPEW_B_COEF = wind coefficient 00165 ! PPET_A_COEF = A-air temperature coefficient 00166 ! PPET_B_COEF = B-air temperature coefficient 00167 ! PPEQ_A_COEF = A-air specific humidity coefficient 00168 ! PPEQ_B_COEF = B-air specific humidity coefficient ! 00169 REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALB 00170 ! PSNOWALB = Prognostic surface snow albedo 00171 ! (does not include anything but 00172 ! the actual snow cover) 00173 ! 00174 REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWHEAT, PSNOWRHO, PSNOWSWE 00175 ! PSNOWHEAT = Snow layer(s) heat content (J/m3) 00176 ! PSNOWRHO = Snow layer(s) averaged density (kg/m3) 00177 ! PSNOWSWE = Snow layer(s) liquid Water Equivalent (SWE:kg m-2) 00178 ! 00179 ! 00180 REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST 00181 ! PSNOWGRAN1 = Snow layer(s) grain parameter 1 00182 ! PSNOWGRAN2 = Snow layer(s) grain parameter 2 00183 ! PSNOWHIST = Snow layer(s) grain historical parameter 00184 REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWAGE ! Snow grain age 00185 ! 00186 ! 00187 REAL, DIMENSION(:), INTENT(OUT) :: PTHRUFAL, PGRNDFLUX, PEVAPCOR, PSNOWHMASS 00188 ! PTHRUFAL = rate that liquid water leaves snow pack: 00189 ! paritioned into soil infiltration/runoff 00190 ! by ISBA [kg/(m2 s)] 00191 ! PGRNDFLUX = soil/snow interface heat flux (W/m2) 00192 ! PEVAPCOR = evaporation/sublimation correction term: 00193 ! extract any evaporation exceeding the 00194 ! actual snow cover (as snow vanishes) 00195 ! and apply it as a surface soil water 00196 ! sink. [kg/(m2 s)] 00197 ! PSNOWHMASS = heat content change due to mass 00198 ! changes in snowpack (J/m2): for budget 00199 ! calculations only. 00200 ! 00201 REAL, DIMENSION(:), INTENT(OUT) :: PRNSNOW, PHSNOW, PGFLUXSNOW, PLES3L, PLEL3L, 00202 PHPSNOW, PUSTARSNOW, PEMISNOW, PCDSNOW, 00203 PCHSNOW, PEVAP 00204 ! PLES3L = evaporation heat flux from snow (W/m2) 00205 ! PLEL3L = sublimation (W/m2) 00206 ! PHPSNOW = heat release from rainfall (W/m2) 00207 ! PRNSNOW = net radiative flux from snow (W/m2) 00208 ! PHSNOW = sensible heat flux from snow (W/m2) 00209 ! PGFLUXSNOW = net heat flux from snow (W/m2) 00210 ! PUSTARSNOW = friction velocity over snow (m/s) 00211 ! PEMISNOW = snow surface emissivity 00212 ! PCDSNOW = drag coefficient for momentum over snow 00213 ! PCHSNOW = drag coefficient for heat over snow 00214 ! PEVAP = total evaporative flux from snow (kg/m2/s) 00215 ! 00216 REAL, DIMENSION(:), INTENT(OUT) :: PSRSFC, PRRSFC, PSMELTFLUX 00217 ! PSRSFC = snow rate on soil/veg surface when SNOW3L in use 00218 ! PRRSFC = rain rate on soil/veg surface when SNOW3L in use 00219 ! PSMELTFLUX = heat flux from soil/vegetation surface 00220 ! to melt thin snow cover when it vanishes (W m-2) 00221 ! 00222 REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWLIQ, PSNOWTEMP, PSNOWDZ 00223 ! PSNOWLIQ = Snow layer(s) liquid water content (m) 00224 ! PSNOWTEMP = Snow layer(s) temperature (m) 00225 ! PSNOWDZ = Snow layer(s) thickness (m) 00226 ! 00227 REAL, DIMENSION(:), INTENT(OUT) :: PRI 00228 ! PRI = Ridcharson number 00229 ! 00230 ! ajout_EB pour prendre en compte angle zenithal du soleil dans LRAD 00231 ! puis plus tard dans LALB 00232 REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! solar zenith angle 00233 REAL, DIMENSION(:), INTENT(IN) :: PLAT 00234 REAL, DIMENSION(:), INTENT(IN) :: PLON 00235 ! 00236 !* 0.2 declarations of local variables 00237 ! 00238 REAL, PARAMETER :: ZCHECK_TEMP = 100.0 00239 ! Limit to check suspicious low temperature (K) 00240 ! 00241 INTEGER :: JWRK, JJ ! Loop control 00242 ! 00243 INTEGER :: INLVLS ! maximum number of snow layers 00244 ! 00245 REAL, DIMENSION(SIZE(PTA)) :: ZRRSNOW, ZSOILCOND, ZSNOW, ZSNOWFALL, 00246 ZSNOWABLAT_DELTA, ZSNOWSWE_1D, ZSNOWD 00247 ! ZSOILCOND = soil thermal conductivity [W/(m K)] 00248 ! ZRRSNOW = rain rate over snow [kg/(m2 s)] 00249 ! ZSNOW = snow depth (m) 00250 ! ZSNOWFALL = minimum equivalent snow depth 00251 ! for snow falling during the 00252 ! current time step (m) 00253 ! ZSNOWABLAT_DELTA = FLAG =1 if snow ablates completely 00254 ! during current time step, else=0 00255 ! ZSNOWSWE_1D = TOTAL snowpack SWE (kg m-2) 00256 ! ZSNOWD = snow depth 00257 ! 00258 !* 0.3 declarations of packed variables 00259 ! 00260 INTEGER :: ISIZE_SNOW ! number of points where computations are done 00261 INTEGER, DIMENSION(SIZE(PTA)) :: NMASK ! indices correspondance between arrays 00262 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00263 ! - - --------------------------------------------------- 00264 ! 00265 !* 0. Initialize variables: 00266 ! --------------------- 00267 ! 00268 IF (LHOOK) CALL DR_HOOK('SNOW3L_ISBA',0,ZHOOK_HANDLE) 00269 PGRNDFLUX(:) = 0.0 00270 PTHRUFAL(:) = 0.0 00271 PEVAPCOR(:) = 0.0 00272 PLES3L(:) = 0.0 00273 PLEL3L(:) = 0.0 00274 PEVAP(:) = 0.0 00275 PRNSNOW(:) = 0.0 00276 PHSNOW(:) = 0.0 00277 PGFLUXSNOW(:) = 0.0 00278 PHPSNOW(:) = 0.0 00279 PSNOWHMASS(:) = 0.0 00280 PUSTARSNOW(:) = 0.0 00281 PSRSFC(:) = PSR(:) ! these are snow and rain rates passed to ISBA, 00282 PRRSFC(:) = PRR(:) ! so initialize here if SNOW3L not used: 00283 PEMISNOW(:) = 1.0 00284 PSMELTFLUX(:) = 0.0 00285 PCDSNOW(:) = 0.0 00286 PRI(:) = XUNDEF 00287 ! 00288 ZSNOW(:) = 0.0 00289 ZSNOWSWE_1D(:) = 0.0 00290 ZSOILCOND(:) = 0.0 00291 ZRRSNOW(:) = 0.0 00292 ZSNOWFALL(:) = 0.0 00293 ZSNOWABLAT_DELTA(:) = 0.0 00294 PSNOWTEMP(:,:) = XTT 00295 PSNOWLIQ(:,:) = 0.0 00296 PSNOWDZ(:,:) = 0.0 00297 ! 00298 INLVLS = SIZE(PSNOWSWE(:,:),2) 00299 ! 00300 ! 00301 ! Use ISBA-SNOW3L or NOT: NOTE that if explicit soil diffusion method in use, 00302 ! then *must* use explicit snow model: 00303 ! 00304 IF (HSNOW_ISBA=='3-L' .OR. HISBA == 'DIF' .OR. HSNOW_ISBA == 'CRO') THEN 00305 ! 00306 ! - Snow and rain falling onto the 3-L grid space: 00307 ! 00308 PSRSFC(:)=0.0 00309 ZSNOW(:)=0. 00310 ZSNOWSWE_1D(:)=0. 00311 DO JJ=1,SIZE(PSR) 00312 00313 ZRRSNOW(JJ) = PPSN(JJ)*PRR(JJ) 00314 PRRSFC(JJ) = PRR(JJ) - ZRRSNOW(JJ) 00315 ! 00316 ZSNOWFALL(JJ) = PSR(JJ)*PTSTEP/XRHOSMAX_ES ! maximum possible snowfall depth (m) 00317 ! 00318 ENDDO 00319 ! 00320 ! Calculate preliminary snow depth (m) 00321 00322 DO JWRK=1,SIZE(PSNOWSWE,2) 00323 DO JJ=1,SIZE(PSNOWSWE,1) 00324 ZSNOW(JJ) = ZSNOW(JJ) + PSNOWSWE(JJ,JWRK)/PSNOWRHO(JJ,JWRK) 00325 ZSNOWSWE_1D(JJ) = ZSNOWSWE_1D(JJ) + PSNOWSWE(JJ,JWRK) 00326 END DO 00327 ENDDO 00328 00329 IF(HISBA == 'DIF')THEN 00330 ZSOILCOND(:) = PSOILCONDZ(:) 00331 ELSE 00332 ! 00333 ! - Soil thermal conductivity 00334 ! is implicit in Force-Restore soil method, so it 00335 ! must be backed-out of surface thermal coefficients 00336 ! (Etchevers and Martin 1997): 00337 ! 00338 ZSOILCOND(:) = 4.*XPI/( PCG(:)*PCG(:)*XDAY/(PD_G1(:)*PCT(:)) ) 00339 00340 ENDIF 00341 ! 00342 ! =============================================================== 00343 ! === Packing: Only call snow model when there is snow on the surface 00344 ! exceeding a minimum threshold OR if the equivalent 00345 ! snow depth falling during the current time step exceeds 00346 ! this limit. 00347 ! 00348 ! counts the number of points where the computations will be made 00349 ! 00350 ! 00351 ISIZE_SNOW = 0 00352 NMASK(:) = 0 00353 ! 00354 DO JJ=1,SIZE(ZSNOW) 00355 IF (ZSNOW(JJ) >= XSNOWDMIN .OR. ZSNOWFALL(JJ) >= XSNOWDMIN) THEN 00356 ISIZE_SNOW = ISIZE_SNOW + 1 00357 NMASK(ISIZE_SNOW) = JJ 00358 ENDIF 00359 ENDDO 00360 ! 00361 IF (ISIZE_SNOW>0) CALL CALL_MODEL(ISIZE_SNOW,INLVLS,NMASK) 00362 ! 00363 ! =============================================================== 00364 ! - Remove trace amounts of snow and reinitialize snow prognostic variables 00365 ! if snow cover is ablated: 00366 ! 00367 ZSNOWABLAT_DELTA(:) = 0.0 00368 ZSNOWD(:) = 0. 00369 DO JWRK=1,SIZE(PSNOWSWE,2) 00370 DO JJ=1,SIZE(PSNOWSWE,1) 00371 ZSNOWD(JJ) = ZSNOWD(JJ) + PSNOWSWE(JJ,JWRK)/PSNOWRHO(JJ,JWRK) 00372 ENDDO 00373 END DO 00374 WHERE(ZSNOWD(:) < XSNOWDMIN*1.1) 00375 PTHRUFAL(:) = ZSNOWSWE_1D(:)/PTSTEP + PSR(:) ! kg m-2 s-1 Conserve mass 00376 PSMELTFLUX(:) = -PTHRUFAL(:)*XLMTT ! W m-2 Conserve Energy 00377 PLEL3L(:) = 0.0 00378 PLES3L(:) = 0.0 00379 PEVAP(:) = 0.0 00380 PSRSFC(:) = 0.0 00381 PRRSFC(:) = PRR(:) 00382 ZRRSNOW(:) = 0.0 00383 ZSNOWABLAT_DELTA(:) = 1.0 00384 PSNOWALB(:) = XUNDEF 00385 END WHERE 00386 00387 DO JWRK=1,INLVLS 00388 DO JJ=1,SIZE(PSNOWSWE,1) 00389 PSNOWSWE(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWSWE(JJ,JWRK) 00390 PSNOWHEAT(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWHEAT(JJ,JWRK) 00391 PSNOWRHO(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWRHO(JJ,JWRK) + & 00392 ZSNOWABLAT_DELTA(JJ)*XRHOSMIN_ES 00393 PSNOWTEMP(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWTEMP(JJ,JWRK) + & 00394 ZSNOWABLAT_DELTA(JJ)*XTT 00395 PSNOWLIQ(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWLIQ(JJ,JWRK) 00396 PSNOWDZ(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWDZ(JJ,JWRK) 00397 ENDDO 00398 ENDDO 00399 00400 IF (HSNOW_ISBA=='CRO') THEN 00401 DO JWRK=1,INLVLS 00402 DO JJ=1,SIZE(PSNOWGRAN1,1) 00403 PSNOWGRAN1(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWGRAN1(JJ,JWRK) 00404 PSNOWGRAN2(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWGRAN2(JJ,JWRK) 00405 PSNOWHIST(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWHIST(JJ,JWRK) 00406 PSNOWAGE (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWAGE (JJ,JWRK) 00407 ENDDO 00408 ENDDO 00409 ENDIF 00410 ! 00411 ! =============================================================== 00412 ! check suspicious low temperature 00413 ! 00414 DO JWRK=1,INLVLS 00415 DO JJ=1,SIZE(PSNOWSWE,1) 00416 IF(PSNOWSWE(JJ,JWRK)>0.0.AND.PSNOWTEMP(JJ,JWRK)<ZCHECK_TEMP)THEN 00417 write(*,*) 'Suspicious low temperature :',JJ,JWRK,PSNOWTEMP(JJ,JWRK) 00418 write(*,*) 'XLAT=',PLAT(JJ),'XLON=',PLON(JJ) 00419 write(*,*) PSNOWSWE (JJ,1:INLVLS) 00420 write(*,*) PSNOWDZ (JJ,1:INLVLS) 00421 write(*,*) PSNOWRHO (JJ,1:INLVLS) 00422 write(*,*) PSNOWTEMP(JJ,1:INLVLS) 00423 CALL ABOR1_SFX('SNOW3L_ISBA: erreur tempe snow') 00424 ENDIF 00425 ENDDO 00426 ENDDO 00427 ! 00428 ! =============================================================== 00429 ! 00430 ENDIF 00431 ! 00432 IF (LHOOK) CALL DR_HOOK('SNOW3L_ISBA',1,ZHOOK_HANDLE) 00433 ! 00434 CONTAINS 00435 ! 00436 SUBROUTINE CALL_MODEL(KSIZE1,KSIZE2,KMASK) 00437 ! 00438 IMPLICIT NONE 00439 ! 00440 INTEGER, INTENT(IN) :: KSIZE1 00441 INTEGER, INTENT(IN) :: KSIZE2 00442 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK 00443 ! 00444 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWSWE 00445 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWDZ 00446 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWRHO 00447 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWHEAT 00448 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWTEMP 00449 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWLIQ 00450 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWGRAN1 00451 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWGRAN2 00452 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWHIST 00453 REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWAGE 00454 REAL, DIMENSION(KSIZE1) :: ZP_SNOWALB 00455 REAL, DIMENSION(KSIZE1) :: ZP_PS 00456 REAL, DIMENSION(KSIZE1) :: ZP_SRSNOW 00457 REAL, DIMENSION(KSIZE1) :: ZP_RRSNOW 00458 REAL, DIMENSION(KSIZE1) :: ZP_PSN3L 00459 REAL, DIMENSION(KSIZE1) :: ZP_TA 00460 REAL, DIMENSION(KSIZE1) :: ZP_TG 00461 REAL, DIMENSION(KSIZE1) :: ZP_SW_RAD 00462 REAL, DIMENSION(KSIZE1) :: ZP_QA 00463 REAL, DIMENSION(KSIZE1) :: ZP_VMOD 00464 REAL, DIMENSION(KSIZE1) :: ZP_LW_RAD 00465 REAL, DIMENSION(KSIZE1) :: ZP_RHOA 00466 REAL, DIMENSION(KSIZE1) :: ZP_UREF 00467 REAL, DIMENSION(KSIZE1) :: ZP_EXNS 00468 REAL, DIMENSION(KSIZE1) :: ZP_EXNA 00469 REAL, DIMENSION(KSIZE1) :: ZP_DIRCOSZW 00470 REAL, DIMENSION(KSIZE1) :: ZP_ZREF 00471 REAL, DIMENSION(KSIZE1) :: ZP_Z0NAT 00472 REAL, DIMENSION(KSIZE1) :: ZP_Z0HNAT 00473 REAL, DIMENSION(KSIZE1) :: ZP_Z0EFF 00474 REAL, DIMENSION(KSIZE1) :: ZP_ALB 00475 REAL, DIMENSION(KSIZE1) :: ZP_SOILCOND 00476 REAL, DIMENSION(KSIZE1) :: ZP_D_G 00477 REAL, DIMENSION(KSIZE1) :: ZP_THRUFAL 00478 REAL, DIMENSION(KSIZE1) :: ZP_GRNDFLUX 00479 REAL, DIMENSION(KSIZE1) :: ZP_EVAPCOR 00480 REAL, DIMENSION(KSIZE1) :: ZP_RNSNOW 00481 REAL, DIMENSION(KSIZE1) :: ZP_HSNOW 00482 REAL, DIMENSION(KSIZE1) :: ZP_GFLUXSNOW 00483 REAL, DIMENSION(KSIZE1) :: ZP_HPSNOW 00484 REAL, DIMENSION(KSIZE1) :: ZP_LES3L 00485 REAL, DIMENSION(KSIZE1) :: ZP_LEL3L 00486 REAL, DIMENSION(KSIZE1) :: ZP_EVAP 00487 REAL, DIMENSION(KSIZE1) :: ZP_RI 00488 REAL, DIMENSION(KSIZE1) :: ZP_EMISNOW 00489 REAL, DIMENSION(KSIZE1) :: ZP_CDSNOW 00490 REAL, DIMENSION(KSIZE1) :: ZP_USTARSNOW 00491 REAL, DIMENSION(KSIZE1) :: ZP_CHSNOW 00492 REAL, DIMENSION(KSIZE1) :: ZP_SNOWHMASS 00493 REAL, DIMENSION(KSIZE1) :: ZP_VEGTYPE 00494 REAL, DIMENSION(KSIZE1) :: ZP_PEW_A_COEF 00495 REAL, DIMENSION(KSIZE1) :: ZP_PEW_B_COEF 00496 REAL, DIMENSION(KSIZE1) :: ZP_PET_A_COEF 00497 REAL, DIMENSION(KSIZE1) :: ZP_PET_B_COEF 00498 REAL, DIMENSION(KSIZE1) :: ZP_PEQ_A_COEF 00499 REAL, DIMENSION(KSIZE1) :: ZP_PEQ_B_COEF 00500 REAL, DIMENSION(KSIZE1) :: ZP_ZENITH 00501 REAL, DIMENSION(KSIZE1) :: ZP_LAT,ZP_LON 00502 ! 00503 INTEGER :: JWRK, JJ, JI 00504 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00505 ! 00506 IF (LHOOK) CALL DR_HOOK('SNOW3L_ISBA:CALL_MODEL',0,ZHOOK_HANDLE) 00507 ! 00508 ! pack the variables 00509 ! 00510 DO JWRK=1,KSIZE2 00511 DO JJ=1,KSIZE1 00512 JI = KMASK(JJ) 00513 ZP_SNOWSWE (JJ,JWRK) = PSNOWSWE (JI,JWRK) 00514 ZP_SNOWRHO (JJ,JWRK) = PSNOWRHO (JI,JWRK) 00515 ZP_SNOWHEAT(JJ,JWRK) = PSNOWHEAT(JI,JWRK) 00516 ZP_SNOWTEMP(JJ,JWRK) = PSNOWTEMP(JI,JWRK) 00517 ZP_SNOWLIQ (JJ,JWRK) = PSNOWLIQ (JI,JWRK) 00518 ZP_SNOWDZ (JJ,JWRK) = PSNOWDZ (JI,JWRK) 00519 ENDDO 00520 ENDDO 00521 ! 00522 IF (HSNOW_ISBA=='CRO') THEN 00523 DO JWRK=1,KSIZE2 00524 DO JJ=1,KSIZE1 00525 JI = KMASK(JJ) 00526 ZP_SNOWGRAN1(JJ,JWRK) = PSNOWGRAN1 (JI,JWRK) 00527 ZP_SNOWGRAN2(JJ,JWRK) = PSNOWGRAN2 (JI,JWRK) 00528 ZP_SNOWHIST (JJ,JWRK) = PSNOWHIST (JI,JWRK) 00529 ZP_SNOWAGE (JJ,JWRK) = PSNOWAGE (JI,JWRK) 00530 ENDDO 00531 ENDDO 00532 ELSE 00533 DO JWRK=1,KSIZE2 00534 DO JJ=1,KSIZE1 00535 ZP_SNOWGRAN1(JJ,JWRK) = XUNDEF 00536 ZP_SNOWGRAN2(JJ,JWRK) = XUNDEF 00537 ZP_SNOWHIST (JJ,JWRK) = XUNDEF 00538 ZP_SNOWAGE (JJ,JWRK) = XUNDEF 00539 ENDDO 00540 ENDDO 00541 ENDIF 00542 ! 00543 DO JJ=1,KSIZE1 00544 JI = KMASK(JJ) 00545 ZP_SNOWALB (JJ) = PSNOWALB (JI) 00546 ZP_PS (JJ) = PPS (JI) 00547 ZP_SRSNOW (JJ) = PSR (JI) 00548 ZP_RRSNOW (JJ) = ZRRSNOW (JI) 00549 ZP_PSN3L (JJ) = PPSN (JI) 00550 ZP_TA (JJ) = PTA (JI) 00551 ZP_TG (JJ) = PTG (JI) 00552 ZP_SW_RAD (JJ) = PSW_RAD (JI) 00553 ZP_QA (JJ) = PQA (JI) 00554 ZP_VMOD (JJ) = PVMOD (JI) 00555 ZP_LW_RAD (JJ) = PLW_RAD (JI) 00556 ZP_RHOA (JJ) = PRHOA (JI) 00557 ZP_UREF (JJ) = PUREF (JI) 00558 ZP_EXNS (JJ) = PEXNS (JI) 00559 ZP_EXNA (JJ) = PEXNA (JI) 00560 ZP_DIRCOSZW(JJ) = PDIRCOSZW(JI) 00561 ZP_ZREF (JJ) = PZREF (JI) 00562 ZP_Z0NAT (JJ) = PZ0NAT (JI) 00563 ZP_Z0HNAT (JJ) = PZ0HNAT (JI) 00564 ZP_Z0EFF (JJ) = PZ0EFF (JI) 00565 ZP_ALB (JJ) = PALB (JI) 00566 ZP_SOILCOND(JJ) = ZSOILCOND(JI) 00567 ZP_D_G (JJ) = PD_G1 (JI) 00568 ! 00569 ZP_PEW_A_COEF(JJ) = PPEW_A_COEF(JI) 00570 ZP_PEW_B_COEF(JJ) = PPEW_B_COEF(JI) 00571 ZP_PET_A_COEF(JJ) = PPET_A_COEF(JI) 00572 ZP_PEQ_A_COEF(JJ) = PPEQ_A_COEF(JI) 00573 ZP_PET_B_COEF(JJ) = PPET_B_COEF(JI) 00574 ZP_PEQ_B_COEF(JJ) = PPEQ_B_COEF(JI) 00575 ! 00576 ZP_LAT (JJ) = PLAT(JI) 00577 ZP_LON (JJ) = PLON(JI) 00578 ZP_ZENITH(JJ) = PZENITH (JI) 00579 ENDDO 00580 ! 00581 DO JJ=1,KSIZE1 00582 JI = KMASK(JJ) 00583 ZP_VEGTYPE (JJ) = PVEGTYPE (JI,NVT_SNOW) 00584 ENDDO 00585 ! 00586 ! =============================================================== 00587 ! conversion of snow heat from J/m3 into J/m2 00588 WHERE(ZP_SNOWSWE(:,:)>0.) & 00589 ZP_SNOWHEAT(:,:) = ZP_SNOWHEAT(:,:) / ZP_SNOWRHO (:,:) * ZP_SNOWSWE (:,:) 00590 ! =============================================================== 00591 ! 00592 ! Call ISBA-SNOW3L model: 00593 ! 00594 IF (HSNOW_ISBA=='CRO') THEN 00595 00596 CALL SNOWCRO(HSNOWRES, TPTIME, OGLACIER, HIMPLICIT_WIND, & 00597 ZP_PEW_A_COEF, ZP_PEW_B_COEF, & 00598 ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, & 00599 ZP_SNOWSWE,ZP_SNOWRHO, ZP_SNOWHEAT, ZP_SNOWALB, & 00600 ZP_SNOWGRAN1, ZP_SNOWGRAN2, ZP_SNOWHIST, ZP_SNOWAGE, PTSTEP, & 00601 ZP_PS, ZP_SRSNOW, ZP_RRSNOW ,ZP_PSN3L, ZP_TA, ZP_TG, & 00602 ZP_SW_RAD, ZP_QA, ZP_VMOD, ZP_LW_RAD, ZP_RHOA, ZP_UREF, & 00603 ZP_EXNS, ZP_EXNA, ZP_DIRCOSZW, ZP_ZREF, ZP_Z0NAT, ZP_Z0EFF, & 00604 ZP_Z0HNAT, ZP_ALB, ZP_SOILCOND, ZP_D_G,ZP_SNOWLIQ, & 00605 ZP_SNOWTEMP, ZP_SNOWDZ, ZP_THRUFAL, ZP_GRNDFLUX, ZP_EVAPCOR, & 00606 ZP_RNSNOW, ZP_HSNOW, ZP_GFLUXSNOW, ZP_HPSNOW, ZP_LES3L, & 00607 ZP_LEL3L, ZP_EVAP, ZP_RI, ZP_EMISNOW, ZP_CDSNOW, ZP_USTARSNOW,& 00608 ZP_CHSNOW, ZP_SNOWHMASS, ZP_VEGTYPE, ZP_ZENITH, ZP_LAT, ZP_LON) 00609 00610 ELSE 00611 00612 CALL SNOW3L(HSNOWRES, TPTIME, OGLACIER, HIMPLICIT_WIND, & 00613 ZP_PEW_A_COEF, ZP_PEW_B_COEF, & 00614 ZP_PET_A_COEF, ZP_PEQ_A_COEF,ZP_PET_B_COEF, ZP_PEQ_B_COEF, & 00615 ZP_SNOWSWE, ZP_SNOWRHO, ZP_SNOWHEAT, ZP_SNOWALB, & 00616 ZP_SNOWGRAN1, ZP_SNOWGRAN2, ZP_SNOWHIST, ZP_SNOWAGE, PTSTEP, & 00617 ZP_PS, ZP_SRSNOW, ZP_RRSNOW, ZP_PSN3L, ZP_TA,ZP_TG, & 00618 ZP_SW_RAD, ZP_QA, ZP_VMOD, ZP_LW_RAD, ZP_RHOA, ZP_UREF, & 00619 ZP_EXNS, ZP_EXNA, ZP_DIRCOSZW, ZP_ZREF, ZP_Z0NAT, ZP_Z0EFF, & 00620 ZP_Z0HNAT, ZP_ALB, ZP_SOILCOND, ZP_D_G, ZP_SNOWLIQ, & 00621 ZP_SNOWTEMP, ZP_SNOWDZ, ZP_THRUFAL, ZP_GRNDFLUX ,ZP_EVAPCOR, & 00622 ZP_RNSNOW, ZP_HSNOW, ZP_GFLUXSNOW, ZP_HPSNOW, ZP_LES3L, & 00623 ZP_LEL3L, ZP_EVAP, ZP_RI, ZP_EMISNOW, ZP_CDSNOW, ZP_USTARSNOW,& 00624 ZP_CHSNOW, ZP_SNOWHMASS, ZP_VEGTYPE, ZP_ZENITH, ZP_LAT, ZP_LON) 00625 00626 ENDIF 00627 ! 00628 ! =============================================================== 00629 ! conversion of snow heat from J/m2 into J/m3 00630 WHERE(ZP_SNOWSWE(:,:)>0.) & 00631 ZP_SNOWHEAT(:,:) = ZP_SNOWHEAT(:,:)* ZP_SNOWRHO (:,:) / ZP_SNOWSWE (:,:) 00632 ! =============================================================== 00633 ! === Packing: 00634 ! 00635 ! unpack variables 00636 ! 00637 DO JWRK=1,KSIZE2 00638 DO JJ=1,KSIZE1 00639 JI = KMASK(JJ) 00640 PSNOWSWE (JI,JWRK) = ZP_SNOWSWE (JJ,JWRK) 00641 PSNOWRHO (JI,JWRK) = ZP_SNOWRHO (JJ,JWRK) 00642 PSNOWHEAT (JI,JWRK) = ZP_SNOWHEAT (JJ,JWRK) 00643 PSNOWTEMP (JI,JWRK) = ZP_SNOWTEMP (JJ,JWRK) 00644 PSNOWLIQ (JI,JWRK) = ZP_SNOWLIQ (JJ,JWRK) 00645 PSNOWDZ (JI,JWRK) = ZP_SNOWDZ (JJ,JWRK) 00646 ENDDO 00647 ENDDO 00648 ! 00649 IF (HSNOW_ISBA=='CRO') THEN 00650 DO JWRK=1,KSIZE2 00651 DO JJ=1,KSIZE1 00652 JI = KMASK(JJ) 00653 PSNOWGRAN1(JI,JWRK) = ZP_SNOWGRAN1(JJ,JWRK) 00654 PSNOWGRAN2(JI,JWRK) = ZP_SNOWGRAN2(JJ,JWRK) 00655 PSNOWHIST (JI,JWRK) = ZP_SNOWHIST (JJ,JWRK) 00656 PSNOWAGE (JI,JWRK) = ZP_SNOWAGE (JJ,JWRK) 00657 ENDDO 00658 ENDDO 00659 ENDIF 00660 ! 00661 DO JJ=1,KSIZE1 00662 JI = KMASK(JJ) 00663 PSNOWALB (JI) = ZP_SNOWALB (JJ) 00664 PTHRUFAL (JI) = ZP_THRUFAL (JJ) 00665 PGRNDFLUX (JI) = ZP_GRNDFLUX (JJ) 00666 PEVAPCOR (JI) = ZP_EVAPCOR (JJ) 00667 PRNSNOW (JI) = ZP_RNSNOW (JJ) 00668 PHSNOW (JI) = ZP_HSNOW (JJ) 00669 PGFLUXSNOW(JI) = ZP_GFLUXSNOW(JJ) 00670 PHPSNOW (JI) = ZP_HPSNOW (JJ) 00671 PLES3L (JI) = ZP_LES3L (JJ) 00672 PLEL3L (JI) = ZP_LEL3L (JJ) 00673 PEVAP (JI) = ZP_EVAP (JJ) 00674 PRI (JI) = ZP_RI (JJ) 00675 PEMISNOW (JI) = ZP_EMISNOW (JJ) 00676 PCDSNOW (JI) = ZP_CDSNOW (JJ) 00677 PUSTARSNOW(JI) = ZP_USTARSNOW(JJ) 00678 PCHSNOW (JI) = ZP_CHSNOW (JJ) 00679 PSNOWHMASS(JI) = ZP_SNOWHMASS(JJ) 00680 ENDDO 00681 ! 00682 IF (LHOOK) CALL DR_HOOK('SNOW3L_ISBA:CALL_MODEL',1,ZHOOK_HANDLE) 00683 ! 00684 END SUBROUTINE CALL_MODEL 00685 ! 00686 END SUBROUTINE SNOW3L_ISBA
1.8.0
