|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ################## 00002 MODULE MODE_SNOW3L 00003 ! ################## 00004 ! 00005 !!**** *MODE_SNOW * - contains explicit snow (ISBA-ES) characteristics functions 00006 !! for total liquid water holding capacity of a snow layer (m) 00007 !! and the thermal heat capacity of a layer (J K-1 m-3) 00008 !! 00009 !! PURPOSE 00010 !! ------- 00011 ! 00012 !!** METHOD 00013 !! ------ 00014 !! direct calculation 00015 !! 00016 !! EXTERNAL 00017 !! -------- 00018 !! 00019 !! IMPLICIT ARGUMENTS 00020 !! ------------------ 00021 !! 00022 !! REFERENCE 00023 !! --------- 00024 !! Boone and Etchevers, J. HydroMeteor., 2001 00025 !! 00026 !! 00027 !! AUTHOR 00028 !! ------ 00029 !! A. Boone * Meteo France * 00030 !! 00031 !! MODIFICATIONS 00032 !! ------------- 00033 !! Original 01/08/02 00034 !! V. Masson 01/2004 add snow grid computations 00035 !! V. Vionnet 06/2008 -Introduction of Crocus formulation to 00036 ! calculate maximum liquid water holding capacity 00037 !! - New algorithm to compute snow grid : 00038 ! 10 layers 00039 !! - Routine to aggregate snow grain type 00040 ! from 2 layers 00041 !! _ Routine to compute average grain 00042 ! type when snow depth< 3 cm. 00043 ! S. Morin 02/2011 - Add routines for Crocus 00044 ! A. Boone 02/2012 - Add optimization of do-loops. 00045 ! M. Lafaysse 01/2013 - Remove SNOWCROWLIQMAX routines (not used) 00046 !---------------------------------------------------------------------------- 00047 ! 00048 !* 0. DECLARATIONS 00049 ! 00050 ! 00051 INTERFACE SNOW3LWLIQMAX 00052 MODULE PROCEDURE SNOW3LWLIQMAX_3D 00053 MODULE PROCEDURE SNOW3LWLIQMAX_2D 00054 MODULE PROCEDURE SNOW3LWLIQMAX_1D 00055 END INTERFACE 00056 INTERFACE SNOW3LHOLD 00057 MODULE PROCEDURE SNOW3LHOLD_3D 00058 MODULE PROCEDURE SNOW3LHOLD_2D 00059 MODULE PROCEDURE SNOW3LHOLD_1D 00060 MODULE PROCEDURE SNOW3LHOLD_0D 00061 END INTERFACE 00062 INTERFACE SNOWCROHOLD 00063 MODULE PROCEDURE SNOWCROHOLD_3D 00064 MODULE PROCEDURE SNOWCROHOLD_2D 00065 MODULE PROCEDURE SNOWCROHOLD_1D 00066 MODULE PROCEDURE SNOWCROHOLD_0D 00067 END INTERFACE 00068 ! 00069 INTERFACE SNOW3LSCAP 00070 MODULE PROCEDURE SNOW3LSCAP_3D 00071 MODULE PROCEDURE SNOW3LSCAP_2D 00072 MODULE PROCEDURE SNOW3LSCAP_1D 00073 MODULE PROCEDURE SNOW3LSCAP_0D 00074 END INTERFACE 00075 ! 00076 INTERFACE SNOW3L_MARBOUTY 00077 MODULE PROCEDURE SNOW3L_MARBOUTY 00078 END INTERFACE 00079 ! 00080 INTERFACE SNOW3LGRID 00081 MODULE PROCEDURE SNOW3LGRID_2D 00082 MODULE PROCEDURE SNOW3LGRID_1D 00083 END INTERFACE 00084 ! 00085 INTERFACE SNOW3LAGREG 00086 MODULE PROCEDURE SNOW3LAGREG 00087 END INTERFACE 00088 ! 00089 INTERFACE SNOW3LAVGRAIN 00090 MODULE PROCEDURE SNOW3LAVGRAIN 00091 END INTERFACE 00092 ! 00093 INTERFACE SNOW3LDIFTYP 00094 MODULE PROCEDURE SNOW3LDIFTYP 00095 END INTERFACE 00096 ! 00097 !------------------------------------------------------------------------------- 00098 CONTAINS 00099 ! 00100 !#################################################################### 00101 FUNCTION SNOW3LWLIQMAX_3D(PSNOWRHO) RESULT(PWLIQMAX) 00102 ! 00103 !! PURPOSE 00104 !! ------- 00105 ! Calculate the maximum liquid water holding capacity of 00106 ! snow layer(s). 00107 ! 00108 USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWRHOHOLD, & 00109 XWSNOWHOLDMAX2, XWSNOWHOLDMAX1 00110 ! 00111 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00112 USE PARKIND1 ,ONLY : JPRB 00113 ! 00114 IMPLICIT NONE 00115 ! 00116 !* 0.1 declarations of arguments 00117 ! 00118 REAL, DIMENSION(:,:,:), INTENT(IN) :: PSNOWRHO ! (kg/m3) 00119 ! 00120 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2),SIZE(PSNOWRHO,3)) :: PWLIQMAX ! (kg/m3) 00121 ! 00122 !* 0.2 declarations of local variables 00123 ! 00124 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2),SIZE(PSNOWRHO,3)) :: ZHOLDMAXR, ZSNOWRHO 00125 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00126 !----------------------------------------------------------------------- 00127 ! Evaluate capacity using upper density limit: 00128 ! 00129 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LWLIQMAX_3D',0,ZHOOK_HANDLE) 00130 ZSNOWRHO(:,:,:) = MIN(XRHOSMAX_ES, PSNOWRHO(:,:,:)) 00131 ! 00132 ! Maximum ratio of liquid to SWE: 00133 ! 00134 ZHOLDMAXR(:,:,:) = XWSNOWHOLDMAX1 + (XWSNOWHOLDMAX2-XWSNOWHOLDMAX1)* & 00135 MAX(0.,XSNOWRHOHOLD-ZSNOWRHO(:,:,:))/XSNOWRHOHOLD 00136 ! 00137 ! Maximum liquid water holding capacity of the snow (kg/m3): 00138 ! 00139 PWLIQMAX(:,:,:) = ZHOLDMAXR(:,:,:)*ZSNOWRHO(:,:,:) 00140 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LWLIQMAX_3D',1,ZHOOK_HANDLE) 00141 ! 00142 END FUNCTION SNOW3LWLIQMAX_3D 00143 !#################################################################### 00144 FUNCTION SNOW3LWLIQMAX_2D(PSNOWRHO) RESULT(PWLIQMAX) 00145 ! 00146 !! PURPOSE 00147 !! ------- 00148 ! Calculate the maximum liquid water holding capacity of 00149 ! snow layer(s). 00150 ! 00151 USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWRHOHOLD, & 00152 XWSNOWHOLDMAX2, XWSNOWHOLDMAX1 00153 ! 00154 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00155 USE PARKIND1 ,ONLY : JPRB 00156 ! 00157 IMPLICIT NONE 00158 ! 00159 !* 0.1 declarations of arguments 00160 ! 00161 REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWRHO ! (kg/m3) 00162 ! 00163 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PWLIQMAX ! (kg/m3) 00164 ! 00165 !* 0.2 declarations of local variables 00166 ! 00167 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZHOLDMAXR, ZSNOWRHO 00168 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00169 !----------------------------------------------------------------------- 00170 ! Evaluate capacity using upper density limit: 00171 ! 00172 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LWLIQMAX_2D',0,ZHOOK_HANDLE) 00173 ZSNOWRHO(:,:) = MIN(XRHOSMAX_ES, PSNOWRHO(:,:)) 00174 ! 00175 ! Maximum ratio of liquid to SWE: 00176 ! 00177 ZHOLDMAXR(:,:) = XWSNOWHOLDMAX1 + (XWSNOWHOLDMAX2-XWSNOWHOLDMAX1)* & 00178 MAX(0.,XSNOWRHOHOLD-ZSNOWRHO(:,:))/XSNOWRHOHOLD 00179 ! 00180 ! Maximum liquid water holding capacity of the snow (kg/m3): 00181 ! 00182 PWLIQMAX(:,:) = ZHOLDMAXR(:,:)*ZSNOWRHO(:,:) 00183 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LWLIQMAX_2D',1,ZHOOK_HANDLE) 00184 ! 00185 END FUNCTION SNOW3LWLIQMAX_2D 00186 !#################################################################### 00187 FUNCTION SNOW3LWLIQMAX_1D(PSNOWRHO) RESULT(PWLIQMAX) 00188 ! 00189 !! PURPOSE 00190 !! ------- 00191 ! Calculate the maximum liquid water holding capacity of 00192 ! snow layer(s). 00193 ! 00194 USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWRHOHOLD, & 00195 XWSNOWHOLDMAX2, XWSNOWHOLDMAX1 00196 ! 00197 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00198 USE PARKIND1 ,ONLY : JPRB 00199 ! 00200 IMPLICIT NONE 00201 ! 00202 !* 0.1 declarations of arguments 00203 ! 00204 REAL, DIMENSION(:), INTENT(IN) :: PSNOWRHO ! (kg/m3) 00205 ! 00206 REAL, DIMENSION(SIZE(PSNOWRHO)) :: PWLIQMAX ! (kg/m3) 00207 ! 00208 !* 0.2 declarations of local variables 00209 ! 00210 REAL, DIMENSION(SIZE(PSNOWRHO)) :: ZHOLDMAXR, ZSNOWRHO 00211 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00212 !---------------------------------------------------------------------- 00213 ! Evaluate capacity using upper density limit: 00214 ! 00215 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LWLIQMAX_1D',0,ZHOOK_HANDLE) 00216 ZSNOWRHO(:) = MIN(XRHOSMAX_ES, PSNOWRHO(:)) 00217 ! 00218 ! Maximum ratio of liquid to SWE: 00219 ! 00220 ZHOLDMAXR(:) = XWSNOWHOLDMAX1 + (XWSNOWHOLDMAX2-XWSNOWHOLDMAX1)* & 00221 MAX(0.,XSNOWRHOHOLD-ZSNOWRHO(:))/XSNOWRHOHOLD 00222 ! 00223 ! Maximum liquid water holding capacity of the snow (kg/m3): 00224 ! 00225 PWLIQMAX(:) = ZHOLDMAXR(:)*ZSNOWRHO(:) 00226 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LWLIQMAX_1D',1,ZHOOK_HANDLE) 00227 ! 00228 END FUNCTION SNOW3LWLIQMAX_1D 00229 !#################################################################### 00230 !#################################################################### 00231 FUNCTION SNOW3LHOLD_3D(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX) 00232 ! 00233 !! PURPOSE 00234 !! ------- 00235 ! Calculate the maximum liquid water holding capacity of 00236 ! snow layer(s). 00237 ! 00238 USE MODD_CSTS, ONLY : XRHOLW 00239 USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWRHOHOLD, & 00240 XWSNOWHOLDMAX2, XWSNOWHOLDMAX1 00241 ! 00242 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00243 USE PARKIND1 ,ONLY : JPRB 00244 ! 00245 IMPLICIT NONE 00246 ! 00247 !* 0.1 declarations of arguments 00248 ! 00249 REAL, DIMENSION(:,:,:), INTENT(IN) :: PSNOWDZ, PSNOWRHO 00250 ! 00251 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2),SIZE(PSNOWRHO,3)) :: PWHOLDMAX 00252 ! 00253 !* 0.2 declarations of local variables 00254 ! 00255 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2),SIZE(PSNOWRHO,3)) :: ZHOLDMAXR, ZSNOWRHO 00256 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00257 !------------------------------------------------------------------------- 00258 ! Evaluate capacity using upper density limit: 00259 ! 00260 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LHOLD_3D',0,ZHOOK_HANDLE) 00261 ZSNOWRHO(:,:,:) = MIN(XRHOSMAX_ES, PSNOWRHO(:,:,:)) 00262 ! 00263 ! Maximum ratio of liquid to SWE: 00264 ! 00265 ZHOLDMAXR(:,:,:) = XWSNOWHOLDMAX1 + (XWSNOWHOLDMAX2-XWSNOWHOLDMAX1)* & 00266 MAX(0.,XSNOWRHOHOLD-ZSNOWRHO(:,:,:))/XSNOWRHOHOLD 00267 ! 00268 ! Maximum liquid water holding capacity of the snow (m): 00269 ! 00270 PWHOLDMAX(:,:,:) = ZHOLDMAXR(:,:,:)*PSNOWDZ(:,:,:)*ZSNOWRHO(:,:,:)/XRHOLW 00271 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LHOLD_3D',1,ZHOOK_HANDLE) 00272 ! 00273 END FUNCTION SNOW3LHOLD_3D 00274 !#################################################################### 00275 FUNCTION SNOW3LHOLD_2D(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX) 00276 ! 00277 !! PURPOSE 00278 !! ------- 00279 ! Calculate the maximum liquid water holding capacity of 00280 ! snow layer(s). 00281 ! 00282 USE MODD_CSTS, ONLY : XRHOLW 00283 USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWRHOHOLD, & 00284 XWSNOWHOLDMAX2, XWSNOWHOLDMAX1 00285 ! 00286 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00287 USE PARKIND1 ,ONLY : JPRB 00288 ! 00289 IMPLICIT NONE 00290 ! 00291 !* 0.1 declarations of arguments 00292 ! 00293 REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWDZ, PSNOWRHO 00294 ! 00295 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PWHOLDMAX 00296 ! 00297 !* 0.2 declarations of local variables 00298 ! 00299 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZHOLDMAXR, ZSNOWRHO 00300 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00301 !----------------------------------------------------------------------- 00302 ! Evaluate capacity using upper density limit: 00303 ! 00304 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LHOLD_2D',0,ZHOOK_HANDLE) 00305 ZSNOWRHO(:,:) = MIN(XRHOSMAX_ES, PSNOWRHO(:,:)) 00306 ! 00307 ! Maximum ratio of liquid to SWE: 00308 ! 00309 ZHOLDMAXR(:,:) = XWSNOWHOLDMAX1 + (XWSNOWHOLDMAX2-XWSNOWHOLDMAX1)* & 00310 MAX(0.,XSNOWRHOHOLD-ZSNOWRHO(:,:))/XSNOWRHOHOLD 00311 ! 00312 ! Maximum liquid water holding capacity of the snow (m): 00313 ! 00314 PWHOLDMAX(:,:) = ZHOLDMAXR(:,:)*PSNOWDZ(:,:)*ZSNOWRHO(:,:)/XRHOLW 00315 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LHOLD_2D',1,ZHOOK_HANDLE) 00316 ! 00317 END FUNCTION SNOW3LHOLD_2D 00318 !#################################################################### 00319 FUNCTION SNOW3LHOLD_1D(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX) 00320 ! 00321 !! PURPOSE 00322 !! ------- 00323 ! Calculate the maximum liquid water holding capacity of 00324 ! snow layer(s). 00325 ! 00326 USE MODD_CSTS, ONLY : XRHOLW 00327 USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWRHOHOLD, & 00328 XWSNOWHOLDMAX2, XWSNOWHOLDMAX1 00329 ! 00330 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00331 USE PARKIND1 ,ONLY : JPRB 00332 ! 00333 IMPLICIT NONE 00334 ! 00335 !* 0.1 declarations of arguments 00336 ! 00337 REAL, DIMENSION(:), INTENT(IN) :: PSNOWDZ, PSNOWRHO 00338 ! 00339 REAL, DIMENSION(SIZE(PSNOWRHO)) :: PWHOLDMAX 00340 ! 00341 !* 0.2 declarations of local variables 00342 ! 00343 REAL, DIMENSION(SIZE(PSNOWRHO)) :: ZHOLDMAXR, ZSNOWRHO 00344 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00345 !----------------------------------------------------------------------- 00346 ! Evaluate capacity using upper density limit: 00347 ! 00348 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LHOLD_1D',0,ZHOOK_HANDLE) 00349 ZSNOWRHO(:) = MIN(XRHOSMAX_ES, PSNOWRHO(:)) 00350 ! 00351 ! Maximum ratio of liquid to SWE: 00352 ! 00353 ZHOLDMAXR(:) = XWSNOWHOLDMAX1 + (XWSNOWHOLDMAX2-XWSNOWHOLDMAX1)* & 00354 MAX(0.,XSNOWRHOHOLD-ZSNOWRHO(:))/XSNOWRHOHOLD 00355 ! 00356 ! Maximum liquid water holding capacity of the snow (m): 00357 ! 00358 PWHOLDMAX(:) = ZHOLDMAXR(:)*PSNOWDZ(:)*ZSNOWRHO(:)/XRHOLW 00359 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LHOLD_1D',1,ZHOOK_HANDLE) 00360 ! 00361 END FUNCTION SNOW3LHOLD_1D 00362 !#################################################################### 00363 FUNCTION SNOW3LHOLD_0D(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX) 00364 ! 00365 !! PURPOSE 00366 !! ------- 00367 ! Calculate the maximum liquid water holding capacity of 00368 ! snow layer(s). 00369 ! 00370 USE MODD_CSTS, ONLY : XRHOLW 00371 USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWRHOHOLD, & 00372 XWSNOWHOLDMAX2, XWSNOWHOLDMAX1 00373 ! 00374 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00375 USE PARKIND1 ,ONLY : JPRB 00376 ! 00377 IMPLICIT NONE 00378 ! 00379 !* 0.1 declarations of arguments 00380 ! 00381 REAL, INTENT(IN) :: PSNOWDZ, PSNOWRHO 00382 ! 00383 REAL :: PWHOLDMAX 00384 ! 00385 !* 0.2 declarations of local variables 00386 ! 00387 REAL :: ZHOLDMAXR, ZSNOWRHO 00388 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00389 !------------------------------------------------------------------------------- 00390 ! Evaluate capacity using upper density limit: 00391 ! 00392 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LHOLD_0D',0,ZHOOK_HANDLE) 00393 ZSNOWRHO = MIN(XRHOSMAX_ES, PSNOWRHO) 00394 ! 00395 ! Maximum ratio of liquid to SWE: 00396 ! 00397 ZHOLDMAXR = XWSNOWHOLDMAX1 + (XWSNOWHOLDMAX2-XWSNOWHOLDMAX1)* & 00398 MAX(0.,XSNOWRHOHOLD-ZSNOWRHO)/XSNOWRHOHOLD 00399 ! 00400 ! Maximum liquid water holding capacity of the snow (m): 00401 ! 00402 PWHOLDMAX = ZHOLDMAXR*PSNOWDZ*ZSNOWRHO/XRHOLW 00403 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LHOLD_0D',1,ZHOOK_HANDLE) 00404 ! 00405 END FUNCTION SNOW3LHOLD_0D 00406 !#################################################################### 00407 FUNCTION SNOWCROHOLD_3D(PSNOWRHO,PSNOWLIQ,PSNOWDZ) RESULT(PWHOLDMAX) 00408 ! 00409 !! PURPOSE 00410 !! ------- 00411 ! Calculate the maximum liquid water holding capacity of 00412 ! snow layer(s). 00413 ! 00414 USE MODD_CSTS, ONLY : XRHOLW,XRHOLI 00415 ! 00416 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00417 USE PARKIND1 ,ONLY : JPRB 00418 ! 00419 IMPLICIT NONE 00420 ! 00421 !* 0.1 declarations of arguments 00422 ! 00423 REAL, DIMENSION(:,:,:), INTENT(IN) :: PSNOWDZ, PSNOWLIQ, PSNOWRHO 00424 ! 00425 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2),SIZE(PSNOWRHO,3)) :: PWHOLDMAX 00426 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00427 !------------------------------------------------------------------------------- 00428 ! computation of water holding capacity based on Crocus, 00429 !taking into account the conversion between wet and dry density - 00430 !S. Morin/V. Vionnet 2010 12 09 00431 00432 ! PWHOLDMAX is expressed in m water for each layer 00433 ! In short, PWHOLDMAX = XPERCENTAGEPORE * porosity * PSNOWDZ . 00434 ! The porosity is computed as (rho_ice - (rho_snow - lwc))/(rho_ice) 00435 ! where everything has to be in kg m-3 units. In practice, since 00436 ! PSNOWLIQ is expressed in m water, expressing the lwc in kg m-3 00437 ! is achieved as PSNOWLIQ*XRHOLW/PSNOWDZ. After some rearranging one 00438 ! obtains the equation given above. 00439 ! Note that equation (19) in Vionnet et al., GMD 2012, is wrong, 00440 ! because it does not take into account the fact that liquid water 00441 ! content has to be substracted from total density to compute the 00442 ! porosity. 00443 00444 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOWCROHOLD_3D',0,ZHOOK_HANDLE) 00445 PWHOLDMAX(:,:,:) = 0.05/XRHOLI * (PSNOWDZ * (XRHOLI-PSNOWRHO) + PSNOWLIQ*XRHOLW) 00446 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOWCROHOLD_3D',1,ZHOOK_HANDLE) 00447 ! 00448 END FUNCTION SNOWCROHOLD_3D 00449 !#################################################################### 00450 FUNCTION SNOWCROHOLD_2D(PSNOWRHO,PSNOWLIQ,PSNOWDZ) RESULT(PWHOLDMAX) 00451 ! 00452 !! PURPOSE 00453 !! ------- 00454 ! Calculate the maximum liquid water holding capacity of 00455 ! snow layer(s). 00456 ! 00457 USE MODD_CSTS, ONLY : XRHOLW,XRHOLI 00458 ! 00459 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00460 USE PARKIND1 ,ONLY : JPRB 00461 ! 00462 IMPLICIT NONE 00463 ! 00464 !* 0.1 declarations of arguments 00465 ! 00466 REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWDZ, PSNOWRHO, PSNOWLIQ 00467 ! 00468 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PWHOLDMAX 00469 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00470 !------------------------------------------------------------------------------- 00471 ! computation of water holding capacity based on Crocus, 00472 !taking into account the conversion between wet and dry density - 00473 !S. Morin/V. Vionnet 2010 12 09 00474 00475 ! PWHOLDMAX is expressed in m water for each layer 00476 ! In short, PWHOLDMAX = XPERCENTAGEPORE * porosity * PSNOWDZ . 00477 ! The porosity is computed as (rho_ice - (rho_snow - lwc))/(rho_ice) 00478 ! where everything has to be in kg m-3 units. In practice, since 00479 ! PSNOWLIQ is expressed in m water, expressing the lwc in kg m-3 00480 ! is achieved as PSNOWLIQ*XRHOLW/PSNOWDZ. After some rearranging one 00481 ! obtains the equation given above. 00482 ! Note that equation (19) in Vionnet et al., GMD 2012, is wrong, 00483 ! because it does not take into account the fact that liquid water 00484 ! content has to be substracted from total density to compute the 00485 ! porosity. 00486 00487 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOWCROHOLD_2D',0,ZHOOK_HANDLE) 00488 PWHOLDMAX(:,:) = 0.05/XRHOLI * (PSNOWDZ * (XRHOLI-PSNOWRHO) + PSNOWLIQ*XRHOLW) 00489 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOWCROHOLD_2D',1,ZHOOK_HANDLE) 00490 ! 00491 END FUNCTION SNOWCROHOLD_2D 00492 !#################################################################### 00493 !#################################################################### 00494 !#################################################################### 00495 FUNCTION SNOWCROHOLD_1D(PSNOWRHO,PSNOWLIQ,PSNOWDZ) RESULT(PWHOLDMAX) 00496 ! 00497 !! PURPOSE 00498 !! ------- 00499 ! Calculate the maximum liquid water holding capacity of 00500 ! snow layer(s). 00501 ! 00502 USE MODD_CSTS, ONLY : XRHOLW,XRHOLI 00503 ! 00504 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00505 USE PARKIND1 ,ONLY : JPRB 00506 ! 00507 IMPLICIT NONE 00508 ! 00509 !* 0.1 declarations of arguments 00510 ! 00511 REAL, DIMENSION(:), INTENT(IN) :: PSNOWDZ, PSNOWRHO, PSNOWLIQ 00512 ! 00513 REAL, DIMENSION(SIZE(PSNOWRHO)) :: PWHOLDMAX 00514 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00515 !------------------------------------------------------------------------------- 00516 ! computation of water holding capacity based on Crocus, 00517 !taking into account the conversion between wet and dry density - 00518 !S. Morin/V. Vionnet 2010 12 09 00519 00520 ! PWHOLDMAX is expressed in m water for each layer 00521 ! In short, PWHOLDMAX = XPERCENTAGEPORE * porosity * PSNOWDZ . 00522 ! The porosity is computed as (rho_ice - (rho_snow - lwc))/(rho_ice) 00523 ! where everything has to be in kg m-3 units. In practice, since 00524 ! PSNOWLIQ is expressed in m water, expressing the lwc in kg m-3 00525 ! is achieved as PSNOWLIQ*XRHOLW/PSNOWDZ. After some rearranging one 00526 ! obtains the equation given above. 00527 ! Note that equation (19) in Vionnet et al., GMD 2012, is wrong, 00528 ! because it does not take into account the fact that liquid water 00529 ! content has to be substracted from total density to compute the 00530 ! porosity. 00531 00532 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOWCROHOLD_1D',0,ZHOOK_HANDLE) 00533 PWHOLDMAX(:) = 0.05/XRHOLI * (PSNOWDZ * (XRHOLI-PSNOWRHO) + PSNOWLIQ*XRHOLW) 00534 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOWCROHOLD_1D',1,ZHOOK_HANDLE) 00535 ! 00536 END FUNCTION SNOWCROHOLD_1D 00537 !#################################################################### 00538 FUNCTION SNOWCROHOLD_0D(PSNOWRHO,PSNOWLIQ,PSNOWDZ) RESULT(PWHOLDMAX) 00539 ! 00540 !! PURPOSE 00541 !! ------- 00542 ! Calculate the maximum liquid water holding capacity of 00543 ! snow layer(s). 00544 ! 00545 USE MODD_CSTS, ONLY : XRHOLW,XRHOLI 00546 ! 00547 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00548 USE PARKIND1 ,ONLY : JPRB 00549 ! 00550 IMPLICIT NONE 00551 ! 00552 !* 0.1 declarations of arguments 00553 ! 00554 REAL, INTENT(IN) :: PSNOWDZ, PSNOWRHO, PSNOWLIQ 00555 ! 00556 REAL :: PWHOLDMAX 00557 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00558 !------------------------------------------------------------------------------- 00559 ! computation of water holding capacity based on Crocus, 00560 !taking into account the conversion between wet and dry density - 00561 !S. Morin/V. Vionnet 2010 12 09 00562 00563 ! PWHOLDMAX is expressed in m water for each layer 00564 ! In short, PWHOLDMAX = XPERCENTAGEPORE * porosity * PSNOWDZ . 00565 ! The porosity is computed as (rho_ice - (rho_snow - lwc))/(rho_ice) 00566 ! where everything has to be in kg m-3 units. In practice, since 00567 ! PSNOWLIQ is expressed in m water, expressing the lwc in kg m-3 00568 ! is achieved as PSNOWLIQ*XRHOLW/PSNOWDZ. After some rearranging one 00569 ! obtains the equation given above. 00570 ! Note that equation (19) in Vionnet et al., GMD 2012, is wrong, 00571 ! because it does not take into account the fact that liquid water 00572 ! content has to be substracted from total density to compute the 00573 ! porosity. 00574 00575 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOWCROHOLD_0D',0,ZHOOK_HANDLE) 00576 PWHOLDMAX = 0.05/XRHOLI * (PSNOWDZ * (XRHOLI-PSNOWRHO) + PSNOWLIQ*XRHOLW) 00577 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOWCROHOLD_0D',1,ZHOOK_HANDLE) 00578 ! 00579 END FUNCTION SNOWCROHOLD_0D 00580 !#################################################################### 00581 !#################################################################### 00582 !#################################################################### 00583 FUNCTION SNOW3LSCAP_3D(PSNOWRHO) RESULT(PSCAP) 00584 ! 00585 !! PURPOSE 00586 !! ------- 00587 ! Calculate the heat capacity of a snow layer. 00588 ! 00589 USE MODD_CSTS,ONLY : XCI 00590 ! 00591 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00592 USE PARKIND1 ,ONLY : JPRB 00593 ! 00594 IMPLICIT NONE 00595 ! 00596 !* 0.1 declarations of arguments 00597 ! 00598 REAL, DIMENSION(:,:,:), INTENT(IN) :: PSNOWRHO 00599 ! 00600 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2),SIZE(PSNOWRHO,3)) :: PSCAP 00601 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00602 !------------------------------------------------------------------------------- 00603 ! The method of Verseghy (1991), Int. J. Climat., 11, 111-133. 00604 ! 00605 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LSCAP_3D',0,ZHOOK_HANDLE) 00606 PSCAP(:,:,:) = PSNOWRHO(:,:,:)*XCI ! (J K-1 m-3) 00607 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LSCAP_3D',1,ZHOOK_HANDLE) 00608 ! 00609 END FUNCTION SNOW3LSCAP_3D 00610 !#################################################################### 00611 FUNCTION SNOW3LSCAP_2D(PSNOWRHO) RESULT(PSCAP) 00612 ! 00613 !! PURPOSE 00614 !! ------- 00615 ! Calculate the heat capacity of a snow layer. 00616 ! 00617 USE MODD_CSTS,ONLY : XCI 00618 ! 00619 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00620 USE PARKIND1 ,ONLY : JPRB 00621 ! 00622 IMPLICIT NONE 00623 ! 00624 !* 0.1 declarations of arguments 00625 ! 00626 REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWRHO 00627 ! 00628 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PSCAP 00629 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00630 !------------------------------------------------------------------------------- 00631 ! The method of Verseghy (1991), Int. J. Climat., 11, 111-133. 00632 ! 00633 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LSCAP_2D',0,ZHOOK_HANDLE) 00634 PSCAP(:,:) = PSNOWRHO(:,:)*XCI ! (J K-1 m-3) 00635 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LSCAP_2D',1,ZHOOK_HANDLE) 00636 ! 00637 END FUNCTION SNOW3LSCAP_2D 00638 !#################################################################### 00639 FUNCTION SNOW3LSCAP_1D(PSNOWRHO) RESULT(PSCAP) 00640 ! 00641 !! PURPOSE 00642 !! ------- 00643 ! Calculate the heat capacity of a snow layer. 00644 ! 00645 USE MODD_CSTS,ONLY : XCI 00646 ! 00647 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00648 USE PARKIND1 ,ONLY : JPRB 00649 ! 00650 IMPLICIT NONE 00651 ! 00652 !* 0.1 declarations of arguments 00653 ! 00654 REAL, DIMENSION(:), INTENT(IN) :: PSNOWRHO 00655 ! 00656 REAL, DIMENSION(SIZE(PSNOWRHO)) :: PSCAP 00657 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00658 !------------------------------------------------------------------------------- 00659 ! The method of Verseghy (1991), Int. J. Climat., 11, 111-133. 00660 ! 00661 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LSCAP_1D',0,ZHOOK_HANDLE) 00662 PSCAP(:) = PSNOWRHO(:)*XCI ! (J K-1 m-3) 00663 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LSCAP_1D',1,ZHOOK_HANDLE) 00664 ! 00665 END FUNCTION SNOW3LSCAP_1D 00666 !#################################################################### 00667 FUNCTION SNOW3LSCAP_0D(PSNOWRHO) RESULT(PSCAP) 00668 ! 00669 !! PURPOSE 00670 !! ------- 00671 ! Calculate the heat capacity of a snow layer. 00672 ! 00673 USE MODD_CSTS,ONLY : XCI 00674 ! 00675 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00676 USE PARKIND1 ,ONLY : JPRB 00677 ! 00678 IMPLICIT NONE 00679 ! 00680 !* 0.1 declarations of arguments 00681 ! 00682 REAL, INTENT(IN) :: PSNOWRHO 00683 ! 00684 REAL :: PSCAP 00685 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00686 !------------------------------------------------------------------------------- 00687 ! The method of Verseghy (1991), Int. J. Climat., 11, 111-133. 00688 ! 00689 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LSCAP_0D',0,ZHOOK_HANDLE) 00690 PSCAP = PSNOWRHO*XCI ! (J K-1 m-3) 00691 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LSCAP_0D',1,ZHOOK_HANDLE) 00692 ! 00693 END FUNCTION SNOW3LSCAP_0D 00694 ! 00695 !#################################################################### 00696 !#################################################################### 00697 !#################################################################### 00698 FUNCTION SNOW3L_MARBOUTY(PSNOWRHO,PSNOWTEMP,PGRADT) RESULT(PDANGL) 00699 !**** *ZDANGL* - CROISSANCE DES GRAINS NON DENDRITIQUES ET ANGULEUX . 00700 ! - GROWTH RATES FOR NON DENDRITIC GRAINS WITH SPHERICITY=0 00701 00702 00703 ! OBJET. 00704 ! ------ 00705 00706 !** INTERFACE. 00707 ! ---------- 00708 00709 ! *ZDANGL*(PST,PSRO,PGRADT)* 00710 00711 ! *PST* - TEMPERATURE DE LA STRATE DE NEIGE. 00712 ! *PSRO* - MASSE VOLUMIQUE DE LA STRATE DE NEIGE. 00713 ! *PGRADT* - GRADIENT DE TEMPERATURE AFFECTANT LA STRATE DE NEIGE. 00714 00715 ! METHODE. 00716 ! -------- 00717 ! THE FUNCTION RETURN A VALUE BETWEEN 0 AND 1 WHICH IS USED IN THE DETERMINATION OF THE 00718 ! GROWTH RATE FOR THE CONSIDERED LAYER. 00719 ! THIS VALUE (WITHOUT UNIT) IS THE PRODUCT OF 3 FUNCTIONS (WHICH HAVE THEIR SOLUTIONS BETWEEN 0 AND 1) : 00720 ! F(TEMPERATURE) * H(DENSITY) * G(TEMPERATURE GRADIENT) 00721 00722 ! EXTERNES. 00723 ! --------- 00724 00725 ! REFERENCES. 00726 ! ----------- 00727 ! MARBOUTY D (1980) AN EXPERIMENTAL STUDY OF TEMPERATURE GRADIENT 00728 ! METAMORPHISM J GLACIOLOGY 00729 00730 ! AUTEURS. 00731 ! -------- 00732 ! DOMINIQUE MARBOUTY (FMARBO/GMARBO/HMARBO). 00733 00734 ! MODIFICATIONS. 00735 ! -------------- 00736 ! 08/95: YANNICK DANIELOU - CODAGE A LA NORME DOCTOR. 00737 ! 03/06: JM WILLEMET - F90 AND SI UNITS 00738 ! 01/08: JM WILLEMET - ERROR ON THE FORMULATION OF G FUNCTION (WITH GRADIENT) IS CORRECTED 00739 00740 USE MODD_CSTS, ONLY : XTT 00741 USE MODD_SNOW_METAMO 00742 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00743 USE PARKIND1 ,ONLY : JPRB 00744 ! 00745 IMPLICIT NONE 00746 00747 00748 ! DECLARATIONS. 00749 ! ------------- 00750 REAL ,INTENT(IN) :: PSNOWTEMP,PSNOWRHO,PGRADT 00751 REAL :: PDANGL 00752 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00753 00754 00755 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3L_MARBOUTY',0,ZHOOK_HANDLE) 00756 PDANGL=0.0 00757 ! INFLUENCE DE LA TEMPERATURE /TEMPERATURE INFLUENCE. 00758 00759 IF(PSNOWTEMP >= XTT-VTANG1)THEN 00760 IF(PSNOWTEMP >= XTT-VTANG2)THEN 00761 PDANGL=VTANG4+VTANG5*(XTT-PSNOWTEMP)/VTANG6 00762 ELSEIF(PSNOWTEMP >= XTT-VTANG3)THEN 00763 PDANGL=VTANG7-VTANG8*(XTT-VTANG2-PSNOWTEMP)/VTANG9 00764 ELSE 00765 PDANGL=VTANGA-VTANGB*(XTT-VTANG3-PSNOWTEMP)/VTANGC 00766 ENDIF 00767 00768 ! INFLUENCE DE LA MASSE VOLUMIQUE / DENSITY INFLUENCE. 00769 00770 IF (PSNOWRHO <= VRANG1) THEN 00771 IF(PSNOWRHO > VRANG2) THEN 00772 PDANGL=PDANGL*(1.-(PSNOWRHO-VRANG2)/(VRANG1-VRANG2)) 00773 ENDIF 00774 ! INFLUENCE DU GRADIENT DE TEMPERATURE / TEMPERATURE GRADIENT INFLUENCE. 00775 00776 IF(PGRADT <= VGANG1)THEN 00777 IF(PGRADT <= VGANG2)THEN 00778 PDANGL=PDANGL*VGANG5*(PGRADT-VGANG6)/(VGANG2-VGANG6) 00779 ELSEIF(PGRADT <= VGANG3)THEN 00780 PDANGL = PDANGL*(VGANG7 + VGANG8*(PGRADT-VGANG2)/(VGANG3-VGANG2)) 00781 ELSEIF(PGRADT <= VGANG4)THEN 00782 PDANGL = PDANGL*(VGANG9 + VGANGA*(PGRADT-VGANG3)/(VGANG4-VGANG3)) 00783 ELSE 00784 PDANGL = PDANGL*(VGANGB + VGANGC*(PGRADT-VGANG4)/(VGANG1-VGANG4)) 00785 ENDIF 00786 ENDIF 00787 ELSE 00788 PDANGL=0. 00789 ENDIF 00790 ELSE 00791 PDANGL=0. 00792 ENDIF 00793 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3L_MARBOUTY',1,ZHOOK_HANDLE) 00794 END FUNCTION SNOW3L_MARBOUTY 00795 00796 !#################################################################### 00797 !#################################################################### 00798 !#################################################################### 00799 00800 SUBROUTINE SNOW3LGRID_2D(PSNOWDZ,PSNOW) 00801 ! 00802 !! PURPOSE 00803 !! ------- 00804 ! Once during each time step, update grid to maintain 00805 ! grid proportions. Similar to approach of Lynch-Steiglitz, 00806 ! 1994, J. Clim., 7, 1842-1855. Corresponding mass and 00807 ! heat adjustments made directly after the call to this 00808 ! routine. 3 grid configurations: 00809 ! 1) for very thin snow, constant grid spacing 00810 ! 2) for intermediate thicknesses, highest resolution at soil/snow 00811 ! interface and at the snow/atmosphere interface 00812 ! 3) for deep snow, vertical resoution finest at snow/atmosphere 00813 ! interface (set to a constant value) and increases with snow depth. 00814 ! Second layer can't be more than an order of magnitude thicker 00815 ! than surface layer. 00816 ! 00817 ! 00818 USE MODD_SURF_PAR, ONLY : XUNDEF 00819 USE MODD_SNOW_PAR, ONLY : XSNOWCRITD 00820 ! 00821 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00822 USE PARKIND1 ,ONLY : JPRB 00823 ! 00824 IMPLICIT NONE 00825 ! 00826 !* 0.1 declarations of arguments 00827 ! 00828 REAL, DIMENSION(:), INTENT(IN) :: PSNOW 00829 ! 00830 REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWDZ 00831 ! 00832 !* 0.1 declarations of local variables 00833 ! 00834 INTEGER :: JJ, JI 00835 ! 00836 INTEGER :: INLVLS, INI 00837 ! 00838 REAL, DIMENSION(SIZE(PSNOW)) :: ZWORK 00839 ! 00840 ! ISBA-ES snow grid parameters 00841 ! 00842 REAL, PARAMETER, DIMENSION(3) :: ZSGCOEF1 = (/0.25, 0.50, 0.25/) 00843 REAL, PARAMETER, DIMENSION(2) :: ZSGCOEF2 = (/0.05, 0.34/) 00844 REAL, PARAMETER, DIMENSION(10) :: ZSGCOEF3 = (/0.025, 0.033, 0.043, 00845 0.055, 0.071, 0.091, 0.117, 0.150, 0.193, 0.247/) 00846 00847 ! Minimum total snow depth at which surface layer thickness is constant: 00848 ! 00849 REAL, PARAMETER :: ZSNOWTRANS = 0.20 ! (m) 00850 REAL, PARAMETER :: ZSNOWTRANS1 = 0.40 ! (m) 00851 REAL, PARAMETER :: ZSNOWTRANS2 = 0.6061 ! (m) 00852 REAL, PARAMETER :: ZSNOWTRANS3 = 0.7143 ! (m) 00853 REAL, PARAMETER :: ZSNOWTRANS4 = 0.9259 ! (m) 00854 REAL, PARAMETER :: ZSNOWTRANS5 = 1.4493 ! (m) 00855 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00856 ! 00857 !------------------------------------------------------------------------------- 00858 ! 00859 ! 0. Initialization: 00860 ! ------------------ 00861 ! 00862 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LGRID_2D',0,ZHOOK_HANDLE) 00863 INLVLS = SIZE(PSNOWDZ(:,:),2) 00864 INI = SIZE(PSNOWDZ(:,:),1) 00865 ! 00866 ZWORK(:) = 0.0 00867 ! 00868 ! 1. Calculate current grid for 3-layer (default) configuration): 00869 ! --------------------------------------------------------------- 00870 ! Based on formulation of Lynch-Stieglitz (1994) 00871 ! except for 3 modifications: 00872 ! i) smooth transition here at ZSNOWTRANS 00873 ! ii) constant ratio for very thin snow: 00874 ! iii) ratio of layer 2 to surface layer <= 10 00875 ! 00876 IF(INLVLS == 3)THEN 00877 ! 00878 WHERE(PSNOW <= XSNOWCRITD+0.01) 00879 PSNOWDZ(:,1) = MIN(0.01, PSNOW(:)/INLVLS) 00880 PSNOWDZ(:,3) = MIN(0.01, PSNOW(:)/INLVLS) 00881 PSNOWDZ(:,2) = PSNOW(:) - PSNOWDZ(:,1) - PSNOWDZ(:,3) 00882 END WHERE 00883 ! 00884 WHERE(PSNOW <= ZSNOWTRANS .AND. PSNOW > XSNOWCRITD+0.01) 00885 PSNOWDZ(:,1) = PSNOW(:)*ZSGCOEF1(1) 00886 PSNOWDZ(:,2) = PSNOW(:)*ZSGCOEF1(2) 00887 PSNOWDZ(:,3) = PSNOW(:)*ZSGCOEF1(3) 00888 END WHERE 00889 ! 00890 WHERE(PSNOW > ZSNOWTRANS) 00891 PSNOWDZ(:,1) = ZSGCOEF2(1) 00892 PSNOWDZ(:,2) = (PSNOW(:)-ZSGCOEF2(1))*ZSGCOEF2(2) + ZSGCOEF2(1) 00893 ! 00894 ! When using simple finite differences, limit the thickness 00895 ! factor between the top and 2nd layers to at most 10 00896 ! 00897 PSNOWDZ(:,2) = MIN(10*ZSGCOEF2(1), PSNOWDZ(:,2)) 00898 PSNOWDZ(:,3) = PSNOW(:) - PSNOWDZ(:,2) - PSNOWDZ(:,1) 00899 END WHERE 00900 ! 00901 ! 2. For more than 3-layers: 00902 ! -------------------------- 00903 ! For the case when more than 3 layers are to be used, specifiy how 00904 ! grid should be defined here. For now, a very simple arbitrary method 00905 ! herein. WARNING: Detailed testing using more than 3-layers has not been done 00906 ! to date, only minor tests. 00907 ! 00908 ELSE IF(INLVLS>3 .AND. INLVLS<10) THEN 00909 DO JJ=1,INLVLS 00910 DO JI=1,INI 00911 PSNOWDZ(JI,JJ) = PSNOW(JI)/INLVLS 00912 ENDDO 00913 ENDDO 00914 ! 00915 PSNOWDZ(:,INLVLS) = PSNOWDZ(:,INLVLS) + (PSNOWDZ(:,1) - MIN(0.05, PSNOWDZ(:,1))) 00916 PSNOWDZ(:,1) = MIN(0.05, PSNOWDZ(:,1)) 00917 ! ajout EB pour permettre > 10 00918 ELSE IF(INLVLS==10) THEN 00919 ! 00920 ! 00921 ! DO JJ=1,INLVLS 00922 ! WHERE(PSNOW <=XSNOWCRITD+0.07 ) 00923 ! PSNOWDZ(:,JJ) = PSNOW(:)/INLVLS 00924 ! ENDWHERE 00925 ! WHERE(PSNOW >XSNOWCRITD+0.07) 00926 ! PSNOWDZ(:,JJ) = (PSNOW(:)-1)*ZSGCOEF3(JJ) 00927 ! ENDWHERE 00928 ! END DO 00929 ! 00930 ! 00931 ! WHERE(PSNOW <= ZSNOWTRANS2 .AND. PSNOW > ZSNOWTRANS1) 00932 ! PSNOWDZ(:,INLVLS)=PSNOWDZ(:,INLVLS)-0.01+PSNOWDZ(:,1) 00933 ! PSNOWDZ(:,1)=0.01 00934 ! END WHERE 00935 ! 00936 ! WHERE(PSNOW <= ZSNOWTRANS3 .AND. PSNOW > ZSNOWTRANS2) 00937 ! PSNOWDZ(:,INLVLS)=PSNOWDZ(:,INLVLS)+(PSNOWDZ(:,1)-0.01)+(PSNOWDZ(:,2)-0.02) 00938 ! PSNOWDZ(:,1)=0.01 00939 ! PSNOWDZ(:,2)=0.02 00940 ! END WHERE 00941 ! 00942 ! WHERE(PSNOW <= ZSNOWTRANS4 .AND. PSNOW > ZSNOWTRANS3) 00943 ! PSNOWDZ(:,INLVLS)=PSNOWDZ(:,INLVLS)+(PSNOWDZ(:,1)-0.01)+(PSNOWDZ(:,2)-0.02)+(PSNOWDZ(:,3)-0.03) 00944 ! PSNOWDZ(:,1)=0.01 00945 ! PSNOWDZ(:,2)=0.02 00946 ! PSNOWDZ(:,3)=0.03 00947 ! END WHERE 00948 ! 00949 ! WHERE(PSNOW <= ZSNOWTRANS5 .AND. PSNOW > ZSNOWTRANS4) 00950 ! PSNOWDZ(:,INLVLS)=PSNOWDZ(:,INLVLS)+(PSNOWDZ(:,1)-0.01)+(PSNOWDZ(:,2)-0.02)+(PSNOWDZ(:,3)-0.03)& 00951 ! &+(PSNOWDZ(:,4)-0.05) 00952 ! PSNOWDZ(:,1)=0.01 00953 ! PSNOWDZ(:,2)=0.02 00954 ! PSNOWDZ(:,3)=0.03 00955 ! PSNOWDZ(:,4)=0.05 00956 ! END WHERE 00957 ! 00958 ! WHERE(PSNOW > ZSNOWTRANS5) 00959 ! 00960 ! PSNOWDZ(:,INLVLS) = PSNOWDZ(:,INLVLS)+(PSNOWDZ(:,1)-0.01)+(PSNOWDZ(:,2)-0.02)+(PSNOWDZ(:,3)-0.03)+& 00961 !&(PSNOWDZ(:,4)-0.05)+(PSNOWDZ(:,5)-0.1) 00962 ! 00963 ! PSNOWDZ(:,1)=0.01 00964 ! PSNOWDZ(:,2)=0.02 00965 ! PSNOWDZ(:,3)=0.03 00966 ! PSNOWDZ(:,4)=0.05 00967 ! PSNOWDZ(:,5)=0.1 00968 ! 00969 ! END WHERE 00970 00971 WHERE(PSNOW <= XSNOWCRITD+0.07) 00972 PSNOWDZ(:,1) = MIN(0.01, PSNOW(:)/INLVLS) 00973 PSNOWDZ(:,2) = MIN(0.01, PSNOW(:)/INLVLS) 00974 PSNOWDZ(:,3) = MIN(0.01, PSNOW(:)/INLVLS) 00975 PSNOWDZ(:,4) = MIN(0.01, PSNOW(:)/INLVLS) 00976 PSNOWDZ(:,5) = MIN(0.01, PSNOW(:)/INLVLS) 00977 PSNOWDZ(:,6) = MIN(0.01, PSNOW(:)/INLVLS) 00978 PSNOWDZ(:,7) = MIN(0.01, PSNOW(:)/INLVLS) 00979 PSNOWDZ(:,8) = MIN(0.01, PSNOW(:)/INLVLS) 00980 PSNOWDZ(:,9) = MIN(0.01, PSNOW(:)/INLVLS) 00981 PSNOWDZ(:,INLVLS) = PSNOW(:) - SUM(PSNOWDZ(:,1:9)) 00982 END WHERE 00983 00984 WHERE(PSNOW > XSNOWCRITD+0.07 .AND. PSNOW<=0.19) 00985 PSNOWDZ(:,1) = 0.01 00986 PSNOWDZ(:,2) = 0.01+(PSNOW(:)-0.1)/9 00987 PSNOWDZ(:,3) = 0.01+(PSNOW(:)-0.1)/9 00988 PSNOWDZ(:,4) = 0.01+(PSNOW(:)-0.1)/9 00989 PSNOWDZ(:,5) = 0.01+(PSNOW(:)-0.1)/9 00990 PSNOWDZ(:,6) = 0.01+(PSNOW(:)-0.1)/9 00991 PSNOWDZ(:,7) = 0.01+(PSNOW(:)-0.1)/9 00992 PSNOWDZ(:,8) = 0.01+(PSNOW(:)-0.1)/9 00993 PSNOWDZ(:,9) = 0.01+(PSNOW(:)-0.1)/9 00994 PSNOWDZ(:,INLVLS) = PSNOW(:) - SUM(PSNOWDZ(:,1:9)) 00995 END WHERE 00996 00997 WHERE(PSNOW > 0.19 .AND. PSNOW<=0.27) 00998 PSNOWDZ(:,1) = 0.01 00999 PSNOWDZ(:,2) = 0.02 01000 PSNOWDZ(:,3) = 0.02+(PSNOW(:)-0.19)/8 01001 PSNOWDZ(:,4) = 0.02+(PSNOW(:)-0.19)/8 01002 PSNOWDZ(:,5) = 0.02+(PSNOW(:)-0.19)/8 01003 PSNOWDZ(:,6) = 0.02+(PSNOW(:)-0.19)/8 01004 PSNOWDZ(:,7) = 0.02+(PSNOW(:)-0.19)/8 01005 PSNOWDZ(:,8) = 0.02+(PSNOW(:)-0.19)/8 01006 PSNOWDZ(:,9) = 0.02+(PSNOW(:)-0.19)/8 01007 PSNOWDZ(:,INLVLS) = PSNOW(:) - SUM(PSNOWDZ(:,1:9)) 01008 END WHERE 01009 01010 WHERE(PSNOW > 0.27 .AND. PSNOW<=0.41) 01011 PSNOWDZ(:,1) = 0.01 01012 PSNOWDZ(:,2) = 0.02 01013 PSNOWDZ(:,3) = 0.03 01014 PSNOWDZ(:,4) = 0.03+(PSNOW(:)-0.27)/7 01015 PSNOWDZ(:,5) = 0.03+(PSNOW(:)-0.27)/7 01016 PSNOWDZ(:,6) = 0.03+(PSNOW(:)-0.27)/7 01017 PSNOWDZ(:,7) = 0.03+(PSNOW(:)-0.27)/7 01018 PSNOWDZ(:,8) = 0.03+(PSNOW(:)-0.27)/7 01019 PSNOWDZ(:,9) = 0.03+(PSNOW(:)-0.27)/7 01020 PSNOWDZ(:,INLVLS) = PSNOW(:) - SUM(PSNOWDZ(:,1:9)) 01021 END WHERE 01022 01023 WHERE(PSNOW > 0.41 .AND. PSNOW<=0.71) 01024 PSNOWDZ(:,1) = 0.01 01025 PSNOWDZ(:,2) = 0.02 01026 PSNOWDZ(:,3) = 0.03 01027 PSNOWDZ(:,4) = 0.05 01028 PSNOWDZ(:,5) = 0.05+(PSNOW(:)-0.41)/6 01029 PSNOWDZ(:,6) = 0.05+(PSNOW(:)-0.41)/6 01030 PSNOWDZ(:,7) = 0.05+(PSNOW(:)-0.41)/6 01031 PSNOWDZ(:,8) = 0.05+(PSNOW(:)-0.41)/6 01032 PSNOWDZ(:,9) = 0.05+(PSNOW(:)-0.41)/6 01033 PSNOWDZ(:,INLVLS) = PSNOW(:) - SUM(PSNOWDZ(:,1:9)) 01034 END WHERE 01035 01036 WHERE(PSNOW > 0.71) 01037 PSNOWDZ(:,1) = 0.01 01038 PSNOWDZ(:,2) = 0.02 01039 PSNOWDZ(:,3) = 0.03 01040 PSNOWDZ(:,4) = 0.05 01041 PSNOWDZ(:,5) = 0.1 01042 PSNOWDZ(:,6) = 0.1+(PSNOW(:)-0.71)/5 01043 PSNOWDZ(:,7) = 0.1+(PSNOW(:)-0.71)/5 01044 PSNOWDZ(:,8) = 0.1+(PSNOW(:)-0.71)/5 01045 PSNOWDZ(:,9) = 0.1+(PSNOW(:)-0.71)/5 01046 PSNOWDZ(:,INLVLS) = PSNOW(:) - SUM(PSNOWDZ(:,1:9)) 01047 END WHERE 01048 01049 ! ajout EB pour permettre cas INLVLS > 10 01050 ELSE 01051 PSNOWDZ(:,1) = MIN(0.02,PSNOW(:)/INLVLS) 01052 PSNOWDZ(:,2) = MIN(0.01*PSNOW(:),PSNOW(:)/INLVLS) 01053 PSNOWDZ(:,3) = MIN(0.02*PSNOW(:),PSNOW(:)/INLVLS) 01054 PSNOWDZ(:,4) = MIN(0.03*PSNOW(:),PSNOW(:)/INLVLS) 01055 PSNOWDZ(:,5) = MIN(0.05*PSNOW(:),PSNOW(:)/INLVLS) 01056 PSNOWDZ(:,INLVLS)=MIN(0.05*PSNOW(:),PSNOW(:)/INLVLS) 01057 ZWORK(:) = SUM(PSNOWDZ(:,1:5)) 01058 DO JJ=6,INLVLS-1,1 01059 DO JI=1,INI 01060 PSNOWDZ(JI,JJ) = (PSNOW(JI) - ZWORK(JI) -PSNOWDZ(JI,INLVLS)) & 01061 /(INLVLS-6) 01062 ENDDO 01063 ENDDO 01064 ! 01065 ENDIF 01066 ! 01067 DO JJ=1,INLVLS 01068 DO JI=1,INI 01069 IF(PSNOW(JI)==XUNDEF)THEN 01070 PSNOWDZ(JI,JJ) = XUNDEF 01071 ENDIF 01072 ENDDO 01073 ENDDO 01074 ! 01075 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LGRID_2D',1,ZHOOK_HANDLE) 01076 ! 01077 END SUBROUTINE SNOW3LGRID_2D 01078 !#################################################################### 01079 !#################################################################### 01080 !#################################################################### 01081 01082 SUBROUTINE SNOW3LGRID_1D(PSNOWDZ,PSNOW) 01083 ! 01084 !! PURPOSE 01085 !! ------- 01086 ! Once during each time step, update grid to maintain 01087 ! grid proportions. Similar to approach of Lynch-Steiglitz, 01088 ! 1994, J. Clim., 7, 1842-1855. Corresponding mass and 01089 ! heat adjustments made directly after the call to this 01090 ! routine. 3 grid configurations: 01091 ! 1) for very thin snow, constant grid spacing 01092 ! 2) for intermediate thicknesses, highest resolution at soil/snow 01093 ! interface and at the snow/atmosphere interface 01094 ! 3) for deep snow, vertical resoution finest at snow/atmosphere 01095 ! interface (set to a constant value) and increases with snow depth. 01096 ! Second layer can't be more than an order of magnitude thicker 01097 ! than surface layer. 01098 ! 01099 ! 01100 USE MODD_SURF_PAR, ONLY : XUNDEF 01101 USE MODD_SNOW_PAR, ONLY : XSNOWCRITD 01102 ! 01103 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 01104 USE PARKIND1 ,ONLY : JPRB 01105 ! 01106 IMPLICIT NONE 01107 ! 01108 !* 0.1 declarations of arguments 01109 ! 01110 REAL, INTENT(IN) :: PSNOW 01111 ! 01112 REAL, DIMENSION(:), INTENT(OUT) :: PSNOWDZ 01113 ! 01114 !* 0.1 declarations of local variables 01115 ! 01116 INTEGER JJ 01117 ! 01118 INTEGER :: INLVLS 01119 ! 01120 REAL :: ZWORK 01121 ! 01122 ! ISBA-ES snow grid parameters 01123 ! 01124 REAL, PARAMETER, DIMENSION(3) :: ZSGCOEF1 = (/0.25, 0.50, 0.25/) 01125 REAL, PARAMETER, DIMENSION(2) :: ZSGCOEF2 = (/0.05, 0.34/) 01126 REAL, PARAMETER, DIMENSION(10) :: ZSGCOEF3 = (/0.025, 0.033, 0.043, 01127 0.055, 0.071, 0.091, 0.117, 0.150, 0.193, 0.247/) 01128 01129 ! Minimum total snow depth at which surface layer thickness is constant: 01130 ! 01131 REAL, PARAMETER :: ZSNOWTRANS = 0.20 ! (m) 01132 REAL, PARAMETER :: ZSNOWTRANS1 = 0.40 ! (m) 01133 REAL, PARAMETER :: ZSNOWTRANS2 = 0.6061 ! (m) 01134 REAL, PARAMETER :: ZSNOWTRANS3 = 0.7143 ! (m) 01135 REAL, PARAMETER :: ZSNOWTRANS4 = 0.9259 ! (m) 01136 REAL, PARAMETER :: ZSNOWTRANS5 = 1.4493 ! (m) 01137 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01138 ! 01139 !------------------------------------------------------------------------------- 01140 ! 01141 ! 0. Initialization: 01142 ! ------------------ 01143 ! 01144 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LGRID_1D',0,ZHOOK_HANDLE) 01145 INLVLS = SIZE(PSNOWDZ(:),1) 01146 ! 01147 ! 1. Calculate current grid for 3-layer (default) configuration): 01148 ! --------------------------------------------------------------- 01149 ! Based on formulation of Lynch-Stieglitz (1994) 01150 ! except for 3 modifications: 01151 ! i) smooth transition here at ZSNOWTRANS 01152 ! ii) constant ratio for very thin snow: 01153 ! iii) ratio of layer 2 to surface layer <= 10 01154 ! 01155 IF(INLVLS == 3)THEN 01156 ! 01157 IF(PSNOW <= XSNOWCRITD+0.01)THEN 01158 PSNOWDZ(1) = MIN(0.01, PSNOW/INLVLS) 01159 PSNOWDZ(3) = MIN(0.01, PSNOW/INLVLS) 01160 PSNOWDZ(2) = PSNOW - PSNOWDZ(1) - PSNOWDZ(3) 01161 ENDIF 01162 ! 01163 IF(PSNOW <= ZSNOWTRANS .AND. PSNOW > XSNOWCRITD+0.01)THEN 01164 PSNOWDZ(1) = PSNOW*ZSGCOEF1(1) 01165 PSNOWDZ(2) = PSNOW*ZSGCOEF1(2) 01166 PSNOWDZ(3) = PSNOW*ZSGCOEF1(3) 01167 ENDIF 01168 ! 01169 IF(PSNOW > ZSNOWTRANS)THEN 01170 PSNOWDZ(1) = ZSGCOEF2(1) 01171 PSNOWDZ(2) = (PSNOW-ZSGCOEF2(1))*ZSGCOEF2(2) + ZSGCOEF2(1) 01172 ! 01173 ! When using simple finite differences, limit the thickness 01174 ! factor between the top and 2nd layers to at most 10 01175 ! 01176 PSNOWDZ(2) = MIN(10*ZSGCOEF2(1), PSNOWDZ(2)) 01177 PSNOWDZ(3) = PSNOW - PSNOWDZ(2) - PSNOWDZ(1) 01178 END IF 01179 ! 01180 ! 01181 !plm 01182 ELSE IF(INLVLS>3 .AND. INLVLS<10) THEN 01183 DO JJ=1,INLVLS 01184 PSNOWDZ(JJ) = PSNOW/INLVLS 01185 ENDDO 01186 ! 01187 PSNOWDZ(INLVLS) = PSNOWDZ(INLVLS) + (PSNOWDZ(1) - MIN(0.05, PSNOWDZ(1))) 01188 PSNOWDZ(1) = MIN(0.05, PSNOWDZ(1)) 01189 ! ajout EB pour permettre > 10 01190 ELSE IF(INLVLS==10) THEN 01191 ! plm 01192 ! ELSE 01193 ! 01194 ! 2. For more than 3-layers: 01195 ! -------------------------- 01196 ! For the case when more than 3 layers are to be used, specifiy how 01197 ! grid should be defined here. For now, a very simple arbitrary method 01198 ! herein. WARNING: Detailed testing using more than 3-layers has not been done 01199 ! to date, only minor tests. 01200 ! 01201 IF(PSNOW <= XSNOWCRITD+0.07)THEN 01202 PSNOWDZ(1) = MIN(0.01, PSNOW/INLVLS) 01203 PSNOWDZ(2) = MIN(0.01, PSNOW/INLVLS) 01204 PSNOWDZ(3) = MIN(0.01, PSNOW/INLVLS) 01205 PSNOWDZ(4) = MIN(0.01, PSNOW/INLVLS) 01206 PSNOWDZ(5) = MIN(0.01, PSNOW/INLVLS) 01207 PSNOWDZ(6) = MIN(0.01, PSNOW/INLVLS) 01208 PSNOWDZ(7) = MIN(0.01, PSNOW/INLVLS) 01209 PSNOWDZ(8) = MIN(0.01, PSNOW/INLVLS) 01210 PSNOWDZ(9) = MIN(0.01, PSNOW/INLVLS) 01211 PSNOWDZ(INLVLS) = PSNOW - SUM(PSNOWDZ(1:9)) 01212 ! 01213 ELSEIF(PSNOW > XSNOWCRITD+0.07 .AND. PSNOW<=0.19)THEN 01214 PSNOWDZ(1) = 0.01 01215 PSNOWDZ(2) = 0.01+(PSNOW-0.1)/9 01216 PSNOWDZ(3) = 0.01+(PSNOW-0.1)/9 01217 PSNOWDZ(4) = 0.01+(PSNOW-0.1)/9 01218 PSNOWDZ(5) = 0.01+(PSNOW-0.1)/9 01219 PSNOWDZ(6) = 0.01+(PSNOW-0.1)/9 01220 PSNOWDZ(7) = 0.01+(PSNOW-0.1)/9 01221 PSNOWDZ(8) = 0.01+(PSNOW-0.1)/9 01222 PSNOWDZ(9) = 0.01+(PSNOW-0.1)/9 01223 PSNOWDZ(INLVLS) = PSNOW - SUM(PSNOWDZ(1:9)) 01224 ! 01225 ELSEIF(PSNOW > 0.19 .AND. PSNOW<=0.27)THEN 01226 PSNOWDZ(1) = 0.01 01227 PSNOWDZ(2) = 0.02 01228 PSNOWDZ(3) = 0.02+(PSNOW-0.19)/8 01229 PSNOWDZ(4) = 0.02+(PSNOW-0.19)/8 01230 PSNOWDZ(5) = 0.02+(PSNOW-0.19)/8 01231 PSNOWDZ(6) = 0.02+(PSNOW-0.19)/8 01232 PSNOWDZ(7) = 0.02+(PSNOW-0.19)/8 01233 PSNOWDZ(8) = 0.02+(PSNOW-0.19)/8 01234 PSNOWDZ(9) = 0.02+(PSNOW-0.19)/8 01235 PSNOWDZ(INLVLS) = PSNOW - SUM(PSNOWDZ(1:9)) 01236 ! 01237 ELSEIF(PSNOW > 0.27 .AND. PSNOW<=0.41)THEN 01238 PSNOWDZ(1) = 0.01 01239 PSNOWDZ(2) = 0.02 01240 PSNOWDZ(3) = 0.03 01241 PSNOWDZ(4) = 0.03+(PSNOW-0.27)/7 01242 PSNOWDZ(5) = 0.03+(PSNOW-0.27)/7 01243 PSNOWDZ(6) = 0.03+(PSNOW-0.27)/7 01244 PSNOWDZ(7) = 0.03+(PSNOW-0.27)/7 01245 PSNOWDZ(8) = 0.03+(PSNOW-0.27)/7 01246 PSNOWDZ(9) = 0.03+(PSNOW-0.27)/7 01247 PSNOWDZ(INLVLS) = PSNOW - SUM(PSNOWDZ(1:9)) 01248 ! 01249 ELSEIF(PSNOW > 0.41 .AND. PSNOW<=0.71)THEN 01250 PSNOWDZ(1) = 0.01 01251 PSNOWDZ(2) = 0.02 01252 PSNOWDZ(3) = 0.03 01253 PSNOWDZ(4) = 0.05 01254 PSNOWDZ(5) = 0.05+(PSNOW-0.41)/6 01255 PSNOWDZ(6) = 0.05+(PSNOW-0.41)/6 01256 PSNOWDZ(7) = 0.05+(PSNOW-0.41)/6 01257 PSNOWDZ(8) = 0.05+(PSNOW-0.41)/6 01258 PSNOWDZ(9) = 0.05+(PSNOW-0.41)/6 01259 PSNOWDZ(INLVLS) = PSNOW - SUM(PSNOWDZ(1:9)) 01260 ! 01261 ELSE 01262 PSNOWDZ(1) = 0.01 01263 PSNOWDZ(2) = 0.02 01264 PSNOWDZ(3) = 0.03 01265 PSNOWDZ(4) = 0.05 01266 PSNOWDZ(5) = 0.1 01267 PSNOWDZ(6) = 0.1+(PSNOW-0.71)/5 01268 PSNOWDZ(7) = 0.1+(PSNOW-0.71)/5 01269 PSNOWDZ(8) = 0.1+(PSNOW-0.71)/5 01270 PSNOWDZ(9) = 0.1+(PSNOW-0.71)/5 01271 PSNOWDZ(INLVLS) = PSNOW - SUM(PSNOWDZ(1:9)) 01272 ENDIF 01273 01274 ! ajout EB pour permettre cas INLVLS > 10 01275 ELSE 01276 PSNOWDZ(1) = MIN(0.02,PSNOW/INLVLS) 01277 PSNOWDZ(2) = MIN(0.01*PSNOW,PSNOW/INLVLS) 01278 PSNOWDZ(3) = MIN(0.02*PSNOW,PSNOW/INLVLS) 01279 PSNOWDZ(4) = MIN(0.03*PSNOW,PSNOW/INLVLS) 01280 PSNOWDZ(5) = MIN(0.05*PSNOW,PSNOW/INLVLS) 01281 PSNOWDZ(INLVLS)=MIN(0.05*PSNOW,PSNOW/INLVLS) 01282 ZWORK = SUM(PSNOWDZ(1:5)) 01283 DO JJ=6,INLVLS-1,1 01284 PSNOWDZ(JJ) = (PSNOW - ZWORK -PSNOWDZ(INLVLS)) & 01285 /(INLVLS-6) 01286 END DO 01287 ! 01288 ENDIF 01289 ! 01290 DO JJ=1,INLVLS 01291 IF(PSNOW==XUNDEF)THEN 01292 PSNOWDZ(JJ) = XUNDEF 01293 ENDIF 01294 END DO 01295 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LGRID_1D',1,ZHOOK_HANDLE) 01296 ! 01297 END SUBROUTINE SNOW3LGRID_1D 01298 ! 01299 !################################################################################### 01300 !################################################################################### 01301 ! 01302 ! 01303 SUBROUTINE SNOW3LAGREG(PSNOWDZN,PSNOWDZ,PSNOWRHO,PSNOWGRAN1, PSNOWGRAN2,& 01304 PSNOWHIST,PSNOWGRAN1N,PSNOWGRAN2N,PSNOWHISTN, & 01305 KILAYER1,KILAYER2,PSNOWDDZ) 01306 ! 01307 USE MODD_SNOW_METAMO 01308 ! 01309 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 01310 USE PARKIND1 ,ONLY : JPRB 01311 ! 01312 IMPLICIT NONE 01313 ! 01314 ! 0.1 declarations of arguments 01315 ! 01316 REAL, DIMENSION(:), INTENT(IN) :: PSNOWDZN,PSNOWDZ,PSNOWRHO, 01317 PSNOWDDZ 01318 ! 01319 REAL, DIMENSION(:), INTENT(IN) :: PSNOWGRAN1, PSNOWGRAN2, 01320 PSNOWHIST 01321 01322 REAL, DIMENSION(:), INTENT(OUT) :: PSNOWGRAN1N, PSNOWGRAN2N, 01323 PSNOWHISTN 01324 01325 INTEGER, INTENT(IN) :: KILAYER1 ! Indice 01326 ! couche de référence (i) 01327 INTEGER, INTENT(IN) :: KILAYER2 ! Indice de 01328 ! la couche (i-1 ou i+1) dont une partie est aggrégée à la couche (i) 01329 ! 01330 ! 0.2 declaration of local variables 01331 ! 01332 REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZSNOWRHO 01333 01334 ! 01335 INTEGER :: IDENT, IVIEU, ILAYER 01336 ! 01337 REAL :: ZDELTA 01338 REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZDIAMD, 01339 ZDIAMV,ZSPHERD,ZSPHERV, 01340 ZDIAMN,ZSPHERN,ZDENT 01341 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01342 01343 ! 01344 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LAGREG',0,ZHOOK_HANDLE) 01345 IF(KILAYER1<KILAYER2)THEN 01346 ZDELTA=0.0 01347 ILAYER = KILAYER1 01348 ELSE 01349 ZDELTA=1.0 01350 ILAYER = KILAYER2 01351 ENDIF 01352 ! Mean Properties 01353 ! 01354 ! 1. History 01355 ! 01356 IF(PSNOWHIST(KILAYER1)/=PSNOWHIST(KILAYER2)) THEN 01357 PSNOWHISTN(KILAYER1)=0.0 01358 ENDIF 01359 ! 01360 ! 2. New grain types 01361 ! 01362 ! 2.1 Same grain type 01363 ! 01364 ! 01365 01366 IF((PSNOWGRAN1(KILAYER1)*PSNOWGRAN1(KILAYER2)>0.0).OR. & 01367 (PSNOWGRAN1(KILAYER1)==0.AND.PSNOWGRAN1(KILAYER2)>=0.0).OR. & 01368 (PSNOWGRAN1(KILAYER2)==0.AND.PSNOWGRAN1(KILAYER1)>=0.0)) THEN 01369 ! 01370 !code original vincent PSNOWGRAN1N(KILAYER1)=(PSNOWGRAN1(KILAYER1)*PSNOWRHO(KILAYER1)& 01371 !code original vincent *(PSNOWDZN(KILAYER1)-(1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))-ZDELTA*& 01372 !code original vincent abs(PSNOWDDZ(KILAYER2)))+PSNOWGRAN1(KILAYER2)* & 01373 !code original vincent PSNOWRHO(KILAYER2)*((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))+ & 01374 !code original vincent ZDELTA*abs(PSNOWDDZ(KILAYER2))))/((PSNOWDZN(KILAYER1)-(1.0-ZDELTA)& 01375 !code original vincent *abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2)))* & 01376 !code original vincent PSNOWRHO(KILAYER1)+((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))+ & 01377 !code original vincent ZDELTA*abs(PSNOWDDZ(KILAYER2)))*PSNOWRHO(KILAYER2)) 01378 !code original vincent ! 01379 !code original vincent PSNOWGRAN2N(KILAYER1)=(PSNOWGRAN2(KILAYER1)*PSNOWRHO(KILAYER1) & 01380 !code original vincent *(PSNOWDZN(KILAYER1)-(1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))-ZDELTA* & 01381 !code original vincent abs(PSNOWDDZ(KILAYER2)))+PSNOWGRAN2(KILAYER2)* & 01382 !code original vincent PSNOWRHO(KILAYER2)*((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1)) & 01383 !code original vincent +ZDELTA*abs(PSNOWDDZ(KILAYER2))))/((PSNOWDZN(KILAYER1)-(1.0-ZDELTA)& 01384 !code original vincent *abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2)))* & 01385 !code original vincent PSNOWRHO(KILAYER1)+((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))+ & 01386 !code original vincent ZDELTA*abs(PSNOWDDZ(KILAYER2)))*PSNOWRHO(KILAYER2)) 01387 ! 01388 !plm 01389 PSNOWGRAN1N(KILAYER1) = ( PSNOWGRAN1(KILAYER1) * PSNOWRHO(KILAYER1) & 01390 * (PSNOWDZN(KILAYER1) - abs(PSNOWDDZ(ILAYER))) & 01391 + PSNOWGRAN1(KILAYER2) * PSNOWRHO(KILAYER2) & 01392 * abs(PSNOWDDZ(ILAYER)) ) / & 01393 ( (PSNOWDZN(KILAYER1)-abs(PSNOWDDZ(ILAYER))) & 01394 * PSNOWRHO(KILAYER1) & 01395 + abs(PSNOWDDZ(ILAYER))*PSNOWRHO(KILAYER2) ) 01396 ! 01397 PSNOWGRAN2N(KILAYER1) = ( PSNOWGRAN2(KILAYER1) * PSNOWRHO(KILAYER1) & 01398 * (PSNOWDZN(KILAYER1) - abs(PSNOWDDZ(ILAYER))) & 01399 + PSNOWGRAN2(KILAYER2) * PSNOWRHO(KILAYER2) & 01400 * abs(PSNOWDDZ(ILAYER)) ) / & 01401 ( (PSNOWDZN(KILAYER1)-abs(PSNOWDDZ(ILAYER))) & 01402 * PSNOWRHO(KILAYER1) & 01403 + abs(PSNOWDDZ(ILAYER))*PSNOWRHO(KILAYER2) ) 01404 !plm 01405 ! 01406 ELSE 01407 ! 01408 ! 2.2 Different types 01409 ! 01410 IF(PSNOWGRAN1(KILAYER1)<0.0) THEN 01411 IDENT = KILAYER1 01412 IVIEU = KILAYER2 01413 ELSE 01414 IDENT = KILAYER2 01415 IVIEU = KILAYER1 01416 ENDIF 01417 ! 01418 ZDIAMD(KILAYER1)=-PSNOWGRAN1(IDENT)*XDIAET/XGRAN+ & 01419 (1.0+PSNOWGRAN1(IDENT)/XGRAN)*(PSNOWGRAN2(IDENT) & 01420 *XDIAGF/XGRAN+(1.0-PSNOWGRAN2(IDENT)/XGRAN)& 01421 *XDIAFP) 01422 ZSPHERD(KILAYER1)=PSNOWGRAN2(IDENT)/XGRAN 01423 ZDIAMV(KILAYER1)=PSNOWGRAN2(IVIEU) 01424 ZSPHERV(KILAYER1)=PSNOWGRAN1(IVIEU)/XGRAN 01425 !IF(KILAYER1==1)THEN 01426 !write(*,*) 'ZDD1',ZDIAMD(1),'ZSD1',ZSPHERD(1) 01427 !write(*,*) 'ZDV1',ZDIAMV(1),'ZSV1',ZSPHERV(1) 01428 !ENDIF 01429 ! 01430 ! 01431 ! 01432 IF(IDENT==KILAYER1) THEN 01433 !code original vincent ZDIAMN(KILAYER1)= (ZDIAMD(KILAYER1)*PSNOWRHO(IDENT)*& 01434 !code original vincent (PSNOWDZN(IDENT)-(1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))-ZDELTA* & 01435 !code original vincent abs(PSNOWDDZ(KILAYER2)))+ZDIAMV(KILAYER1)*PSNOWRHO(IVIEU)*( & 01436 !code original vincent (1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2))))/& 01437 !code original vincent ((PSNOWDZN(KILAYER1)-(1.0-ZDELTA)* & 01438 !code original vincent abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2)))* & 01439 !code original vincent PSNOWRHO(KILAYER1)+((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))+ & 01440 !code original vincent ZDELTA*abs(PSNOWDDZ(KILAYER2)))*PSNOWRHO(KILAYER2)) 01441 ! 01442 !plm 01443 ZDIAMN(KILAYER1)= (ZDIAMD(KILAYER1)*PSNOWRHO(IDENT)*& 01444 (PSNOWDZN(IDENT)-abs(PSNOWDDZ(ILAYER)))+ & 01445 ZDIAMV(KILAYER1)*PSNOWRHO(IVIEU)*abs(PSNOWDDZ(ILAYER)))/& 01446 ((PSNOWDZN(KILAYER1)-abs(PSNOWDDZ(ILAYER)))* & 01447 PSNOWRHO(KILAYER1)+abs(PSNOWDDZ(ILAYER))*PSNOWRHO(KILAYER2)) 01448 !plm 01449 01450 ! 01451 ! 01452 !code original vincent ZSPHERN(KILAYER1)= (ZSPHERD(KILAYER1)*PSNOWRHO(IDENT)*& 01453 !code original vincent (PSNOWDZN(IDENT)-(1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))-ZDELTA* & 01454 !code original vincent abs(PSNOWDDZ(KILAYER2)))+ZSPHERV(KILAYER1)*PSNOWRHO(IVIEU)*( & 01455 !code original vincent (1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2))))/& 01456 !code original vincent ((PSNOWDZN(KILAYER1)-(1.0-ZDELTA)* & 01457 !code original vincent abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2)))* & 01458 !code original vincent PSNOWRHO(KILAYER1)+((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))+ & 01459 !code original vincent ZDELTA*abs(PSNOWDDZ(KILAYER2)))*PSNOWRHO(KILAYER2)) 01460 01461 !plm 01462 ZSPHERN(KILAYER1)= (ZSPHERD(KILAYER1)*PSNOWRHO(IDENT)*& 01463 (PSNOWDZN(IDENT)-abs(PSNOWDDZ(ILAYER)))+ & 01464 ZSPHERV(KILAYER1)*PSNOWRHO(IVIEU)* abs(PSNOWDDZ(ILAYER)))/& 01465 ((PSNOWDZN(KILAYER1)-abs(PSNOWDDZ(ILAYER)))* & 01466 PSNOWRHO(KILAYER1)+abs(PSNOWDDZ(ILAYER))*PSNOWRHO(KILAYER2)) 01467 !plm 01468 ! 01469 ! 01470 ! 01471 ELSE 01472 !code original vincent ZDIAMN(KILAYER1)= (ZDIAMD(KILAYER1)*PSNOWRHO(IDENT)*& 01473 !code original vincent ((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))+ZDELTA*abs(PSNOWDDZ(KILAYER2)))& 01474 !code original vincent +ZDIAMV(KILAYER1)*PSNOWRHO(IVIEU)*(PSNOWDZN(IVIEU)-(1.0-ZDELTA)* & 01475 !code original vincent abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2))))/& 01476 !code original vincent ((PSNOWDZN(KILAYER1)-(1.0-ZDELTA)* & 01477 !code original vincent abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2)))* & 01478 !code original vincent PSNOWRHO(KILAYER1)+((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))+ & 01479 !code original vincent ZDELTA*abs(PSNOWDDZ(KILAYER2)))*PSNOWRHO(KILAYER2)) 01480 !code original vincent! 01481 !code original vincent ZSPHERN(KILAYER1)= (ZSPHERD(KILAYER1)*PSNOWRHO(IDENT)*& 01482 !code original vincent ((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))+ZDELTA*abs(PSNOWDDZ(KILAYER2)))& 01483 !code original vincent +ZSPHERV(KILAYER1)*PSNOWRHO(IVIEU)*(PSNOWDZN(IVIEU)-(1.0-ZDELTA)* & 01484 !code original vincent abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2))))/& 01485 !code original vincent ((PSNOWDZN(KILAYER1)-(1.0-ZDELTA)* & 01486 !code original vincent abs(PSNOWDDZ(KILAYER1))-ZDELTA*abs(PSNOWDDZ(KILAYER2)))* & 01487 !code original vincent PSNOWRHO(KILAYER1)+((1.0-ZDELTA)*abs(PSNOWDDZ(KILAYER1))+ & 01488 !code original vincent ZDELTA*abs(PSNOWDDZ(KILAYER2)))*PSNOWRHO(KILAYER2)) 01489 01490 !plm 01491 ZDIAMN(KILAYER1)= (ZDIAMD(KILAYER1)*PSNOWRHO(IDENT)*& 01492 abs(PSNOWDDZ(ILAYER))& 01493 +ZDIAMV(KILAYER1)*PSNOWRHO(IVIEU)*(PSNOWDZN(IVIEU)-abs(PSNOWDDZ(ILAYER))))/& 01494 ((PSNOWDZN(KILAYER1)-abs(PSNOWDDZ(ILAYER)))* & 01495 PSNOWRHO(KILAYER1)+abs(PSNOWDDZ(ILAYER))*PSNOWRHO(KILAYER2)) 01496 ! 01497 ZSPHERN(KILAYER1)= (ZSPHERD(KILAYER1)*PSNOWRHO(IDENT)*& 01498 abs(PSNOWDDZ(ILAYER))& 01499 +ZSPHERV(KILAYER1)*PSNOWRHO(IVIEU)*(PSNOWDZN(IVIEU)-abs(PSNOWDDZ(ILAYER))))/& 01500 ((PSNOWDZN(KILAYER1)-abs(PSNOWDDZ(ILAYER)))* & 01501 PSNOWRHO(KILAYER1)+abs(PSNOWDDZ(ILAYER))*PSNOWRHO(KILAYER2)) 01502 !plm 01503 ENDIF 01504 ! 01505 ! 01506 ! 01507 IF(ZDIAMN(KILAYER1)<ZSPHERN(KILAYER1)*XDIAGF+& 01508 (1-ZSPHERN(KILAYER1))*XDIAFP) THEN 01509 ZDENT(KILAYER1)=(ZDIAMN(KILAYER1)-(ZSPHERN(KILAYER1)*& 01510 XDIAGF+(1-ZSPHERN(KILAYER1))*XDIAFP))/(XDIAET-& 01511 (ZSPHERN(KILAYER1)*XDIAGF+(1-ZSPHERN(KILAYER1))*XDIAFP)) 01512 !IF(KILAYER1==1) write(*,*) 'ZDENT',ZDENT(1) 01513 PSNOWGRAN1N(KILAYER1)=-XGRAN*ZDENT(KILAYER1) 01514 PSNOWGRAN2N(KILAYER1)= XGRAN*ZSPHERN(KILAYER1) 01515 ELSE 01516 PSNOWGRAN1N(KILAYER1)= XGRAN*ZSPHERN(KILAYER1) 01517 PSNOWGRAN2N(KILAYER1)= ZDIAMN(KILAYER1) 01518 ENDIF 01519 ENDIF 01520 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LAGREG',1,ZHOOK_HANDLE) 01521 ! 01522 ! 3. Update snow grains parameters : GRAN1, GRAN2 01523 ! PSNOWGRAN1(KILAYER1)=ZSNOWGRAN1(KILAYER1) 01524 ! PSNOWGRAN2(KILAYER1)=ZSNOWGRAN2(KILAYER1) 01525 01526 01527 END SUBROUTINE SNOW3LAGREG 01528 ! 01529 !############################################################################### 01530 !############################################################################### 01531 ! 01532 ! 01533 !ajout EB : ajout des arguments "N" pour faire idem variables d'origine 01534 01535 SUBROUTINE SNOW3LAVGRAIN(PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST, & 01536 ZSNOWGRAN1N, ZSNOWGRAN2N, ZSNOWHISTN,PNDENT, PNVIEU) 01537 ! 01538 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 01539 USE PARKIND1 ,ONLY : JPRB 01540 ! 01541 ! 01542 IMPLICIT NONE 01543 ! 01544 ! 0.1 declarations of arguments 01545 ! 01546 REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWGRAN1,PSNOWGRAN2, 01547 PSNOWHIST 01548 ! 01549 ! ajout EB 01550 REAL, DIMENSION(:,:), INTENT(INOUT) :: ZSNOWGRAN1N,ZSNOWGRAN2N, 01551 ZSNOWHISTN 01552 01553 REAL, DIMENSION(:), INTENT(IN) :: PNDENT, PNVIEU 01554 ! 01555 ! 01556 ! 0.2 declaration of local variables 01557 ! 01558 INTEGER :: JI, JJ 01559 INTEGER :: INLVLS, INI 01560 ! 01561 REAL, DIMENSION(SIZE(PSNOWGRAN1,1)) ::KGRAN1, KGRAN2, KHIST 01562 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01563 ! 01564 ! 0.3 initialization 01565 ! 01566 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LAVGRAIN',0,ZHOOK_HANDLE) 01567 INLVLS = SIZE(PSNOWGRAN1,2) 01568 INI = SIZE(PSNOWGRAN1,1) 01569 KGRAN1(:) = 0.0 01570 KGRAN2(:) = 0.0 01571 KHIST(:) = 0.0 01572 ! 01573 ! 01574 ! 01575 DO JJ=1,INLVLS 01576 DO JI=1,INI 01577 IF(PNDENT(JI)==0.0 .AND. PNVIEU(JI)==0.0)THEN 01578 KGRAN1(JI) = 1.0 01579 KGRAN2(JI) = 1.0 01580 KHIST(JI) = 1.0 01581 ELSEIF(PNDENT(JI)>=PNVIEU(JI))THEN ! more dendritic than non dendritic snow layer 01582 IF(PSNOWGRAN1(JI,JJ)<0.0)THEN 01583 KGRAN1(JI) = KGRAN1(JI)+PSNOWGRAN1(JI,JJ) 01584 KGRAN2(JI) = KGRAN2(JI)+PSNOWGRAN2(JI,JJ) 01585 ENDIF 01586 ELSE ! more non dendritic than dendritic snow layers 01587 IF(PSNOWGRAN1(JI,JJ)>=0)THEN 01588 KGRAN1(JI) = KGRAN1(JI)+PSNOWGRAN1(JI,JJ) 01589 KGRAN2(JI) = KGRAN2(JI)+PSNOWGRAN2(JI,JJ) 01590 KHIST(JI) = KHIST(JI)+PSNOWHIST(JI,JJ) 01591 ENDIF 01592 ENDIF 01593 ENDDO 01594 ENDDO 01595 ! 01596 DO JJ=1,INLVLS 01597 DO JI=1,INI 01598 IF(PNDENT(JI)==0.0 .AND. PNVIEU(JI)==0.0)THEN 01599 KGRAN1(JI) =1.0 01600 ELSEIF(PNDENT(JI)>=PNVIEU(JI))THEN 01601 ZSNOWGRAN1N(JI,JJ)= KGRAN1(JI)/PNDENT(JI) 01602 ZSNOWGRAN2N(JI,JJ)= KGRAN2(JI)/PNDENT(JI) 01603 ZSNOWHISTN(JI,JJ) = 0.0 01604 ELSE 01605 ZSNOWGRAN1N(JI,JJ)= KGRAN1(JI)/PNVIEU(JI) 01606 ZSNOWGRAN2N(JI,JJ)= KGRAN2(JI)/PNVIEU(JI) 01607 ZSNOWHISTN(JI,JJ) = KHIST(JI) /PNVIEU(JI) 01608 ENDIF 01609 ENDDO 01610 ENDDO 01611 ! 01612 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LAVGRAIN',1,ZHOOK_HANDLE) 01613 END SUBROUTINE SNOW3LAVGRAIN 01614 ! 01615 !#################################################################### 01616 !#################################################################### 01617 !#################################################################### 01618 FUNCTION SNOW3LDIFTYP(PGRAIN1,PGRAIN2,PGRAIN3,PGRAIN4) RESULT(ZDIFTYPE) 01619 ! 01620 ! à remplacer sans doute par une routine equivalente du nouveau crocus 01621 !* CALCUL DE LA DIFFERENCE ENTRE DEUX TYPES DE GRAINS 01622 ! VALEUR ENTRE 200 ET 0 01623 ! 01624 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 01625 USE PARKIND1 ,ONLY : JPRB 01626 ! 01627 IMPLICIT NONE 01628 !* 0.1 declarations of arguments 01629 REAL :: PGRAIN1, PGRAIN2, PGRAIN3, PGRAIN4, ZDIFTYPE 01630 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01631 01632 !* 0.2 calcul de la difference entre type de grains 01633 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LDIFTYP',0,ZHOOK_HANDLE) 01634 if (pgrain1==0.and.pgrain2>=0) then 01635 ZDIFTYPE=ABS(PGRAIN1-PGRAIN2)+ABS(PGRAIN3-PGRAIN4)*5.*10000. 01636 elseIF(PGRAIN1>=0.and.PGRAIN2==0) then 01637 ZDIFTYPE=ABS(PGRAIN1-PGRAIN2)+ABS(PGRAIN3-PGRAIN4)*5.*10000. 01638 else if(PGRAIN1<0.and.PGRAIN2==0) then 01639 zdiftype=200. 01640 else if(PGRAIN1==0.and.PGRAIN2<0) then 01641 zdiftype=200. 01642 ELSEIF(PGRAIN1*PGRAIN2.LT.0.) THEN 01643 ZDIFTYPE=200. 01644 ELSEIF(PGRAIN1.LT.0.) THEN 01645 ZDIFTYPE=ABS(PGRAIN1-PGRAIN2)*.5+ABS(PGRAIN3-PGRAIN4)*.5 01646 ELSE 01647 ZDIFTYPE=ABS(PGRAIN1-PGRAIN2)+ABS(PGRAIN3-PGRAIN4)*5.*10000. 01648 ENDIF 01649 IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LDIFTYP',1,ZHOOK_HANDLE) 01650 END FUNCTION SNOW3LDIFTYP 01651 !#################################################################### 01652 !#################################################################### 01653 !#################################################################### 01654 01655 END MODULE MODE_SNOW3L 01656
1.8.0
