|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE SNOWCROUPGRID(PSNOW, PSNOWDZ, PSNOWDZN, PSNOWRHO, & 00003 PSNOWHEAT,PSNOWGRAN1, PSNOWGRAN2, & 00004 PSNOWHIST,PSNOWHMASS,OSNOWFALL, PSNOWBIS, & 00005 PSNOWDZBIS, & 00006 PSNOWHEATBIS,PSNOWRHOBIS, PSNOWGRAN1BIS, & 00007 PSNOWGRAN2BIS,PSNOWHISTBIS,PTSTEP,PSR, & 00008 PTA,PVMOD ) 00009 ! 00010 USE MODD_SNOW_PAR, ONLY : XSNOWCRITD 00011 USE MODE_SNOW3L 00012 ! 00013 ! modifs_EB: transformation de grille uniquement si chute de neige, une couche 00014 ! trop petite ou HTN < 3 cm (==>omodifgrid=.T.) 00015 ! modifs pour traiter les grains comme les variables d'origine 00016 ! 00017 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00018 USE PARKIND1 ,ONLY : JPRB 00019 ! 00020 IMPLICIT NONE 00021 ! 00022 ! 0.1 declarations of arguments 00023 ! 00024 REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWDZ,PSNOWRHO, 00025 PSNOWDZN, PSNOWHEAT 00026 ! 00027 REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWDZBIS, 00028 PSNOWHEATBIS,PSNOWRHOBIS, PSNOWGRAN1BIS, 00029 PSNOWGRAN2BIS,PSNOWHISTBIS 00030 REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWGRAN1, PSNOWGRAN2, 00031 PSNOWHIST 00032 ! 00033 REAL, DIMENSION(:), INTENT(INOUT) :: PSNOW, PSNOWBIS,PSNOWHMASS 00034 ! 00035 REAL, DIMENSION(:), INTENT(IN) :: PSR, PTA, PVMOD 00036 ! 00037 LOGICAL,DIMENSION(:), INTENT(IN) :: OSNOWFALL 00038 ! 00039 REAL, INTENT(IN) :: PTSTEP 00040 ! 00041 ! 0.2 declaration of local variables 00042 ! 00043 REAL, DIMENSION(SIZE(PSNOW)) :: ZSUMHEAT, ZSUMSWE, 00044 ZSNOWMIX_DELTA, 00045 ZSNOWHMASS 00046 ! 00047 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) ::ZSNOWHEATN, 00048 ZSNOWRHON 00049 ! ajout EB 00050 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) ::ZSNOWGRAN1N, 00051 ZSNOWGRAN2N,ZSNOWHISTN 00052 REAL, DIMENSION(SIZE(PSNOW)) :: ZNDENT, ZNVIEU 00053 ! 00054 INTEGER :: INLVLS 00055 INTEGER JJ1,JJ2 00056 ! ajout EB 00057 REAL, DIMENSION(SIZE(PSNOW)) :: PSNOWMIN 00058 integer JJ3 00059 logical OMODIFGRID 00060 ! 00061 REAL :: ZTSTEP 00062 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00063 ! 00064 ! 0.3 initialization 00065 IF (LHOOK) CALL DR_HOOK('SNOWCROUPGRID',0,ZHOOK_HANDLE) 00066 INLVLS = SIZE(PSNOWDZ(:,:),2) 00067 ! 00068 ! 1. update grid for snowpack>3cm 00069 ! 00070 ! 00071 ! ajout EB 00072 IF((PSNOWGRAN1(1,3)>80.0).and.(PSNOWGRAN2(1,3)>2.E-2))then 00073 WRITE(*,*) 'pb1 psnowgran',PSNOWGRAN1(1,3),PSNOWGRAN2(1,3) & 00074 , PSNOWRHO(1,3),PSNOWDZ(1,3) 00075 ENDIF 00076 IF((PSNOWGRAN1BIS(1,3)>80.0).and.(PSNOWGRAN2BIS(1,3)>2.E-2))then 00077 WRITE(*,*) 'pb1 psnowgranBIS',PSNOWGRAN1BIS(1,3),PSNOWGRAN2BIS(1,3) 00078 ENDIF 00079 ! 00080 OMODIFGRID=.FALSE. 00081 ! 00082 DO JJ1=1,SIZE(PSNOW(:)) 00083 ! 00084 IF(OSNOWFALL(JJ1).and.OMODIFGRID) THEN 00085 ! IF(OSNOWFALL(JJ1)) THEN 00086 WRITE(*,*) 'ALERTE' 00087 ! ajout EB 00088 OMODIFGRID=.TRUE. 00089 ! 00090 ZTSTEP=PTSTEP/10.0 00091 PSNOWHMASS(JJ1)=0 00092 DO JJ2=1,10 00093 PSNOWHMASS(JJ1)=0 00094 CALL SNOWCROADDSNOW(ZTSTEP,PSR(JJ1),PTA(JJ1),PVMOD(JJ1),& 00095 PSNOW(JJ1),PSNOWRHO(JJ1,1),PSNOWDZ(JJ1,1),PSNOWHEAT(JJ1,1),& 00096 ZSNOWHMASS(JJ1),PSNOWGRAN1(JJ1,1),PSNOWGRAN2(JJ1,1),& 00097 PSNOWHIST(JJ1,1),INLVLS) 00098 PSNOWHMASS(JJ1)=PSNOWHMASS(JJ1)+ZSNOWHMASS(JJ1) 00099 ZSNOWRHON(JJ1,:) = PSNOWRHO(JJ1,:) 00100 ZSNOWHEATN(JJ1,:) = PSNOWHEAT(JJ1,:) 00101 !ajout EB 00102 ZSNOWGRAN1N(JJ1,:) = PSNOWGRAN1(JJ1,:) 00103 ZSNOWGRAN2N(JJ1,:) = PSNOWGRAN2(JJ1,:) 00104 ZSNOWHISTN(JJ1,:) = PSNOWHIST(JJ1,:) 00105 00106 CALL SNOW3LGRID(PSNOWDZN(JJ1,:), PSNOW(JJ1)) 00107 CALL SNOWCROTRANSF_1D(PSNOW(JJ1),PSNOWDZ(JJ1,:),PSNOWDZN(JJ1,:),& 00108 ZSNOWRHON(JJ1,:),ZSNOWHEATN(JJ1,:),ZSNOWGRAN1N(JJ1,:), & 00109 ZSNOWGRAN2N(JJ1,:),ZSNOWHISTN(JJ1,:)) 00110 END DO 00111 ! 00112 ELSE 00113 ! 00114 ZSNOWRHON(JJ1,:) = PSNOWRHOBIS(JJ1,:) 00115 ZSNOWHEATN(JJ1,:) = PSNOWHEATBIS(JJ1,:) 00116 !ajout EB 00117 ZSNOWGRAN1N(JJ1,:) = PSNOWGRAN1BIS(JJ1,:) 00118 ZSNOWGRAN2N(JJ1,:) = PSNOWGRAN2BIS(JJ1,:) 00119 ZSNOWHISTN(JJ1,:) = PSNOWHISTBIS(JJ1,:) 00120 ! ajout EB 00121 ! on change de grille seulement si il y a une trop petite couche 00122 PSNOWMIN(JJ1)=PSNOW(JJ1) 00123 ! 00124 DO JJ3=1, INLVLS 00125 IF (PSNOWDZ(JJ1,JJ3) < PSNOWMIN(JJ1)) PSNOWMIN(JJ1)=PSNOWDZ(JJ1,JJ3) 00126 ENDDO 00127 ! 00128 IF (PSNOWMIN(JJ1) < MIN(0.001,PSNOW(JJ1)/(2*INLVLS)) & 00129 .OR.PSR(JJ1) > 0.0) then 00130 OMODIFGRID=.TRUE. 00131 ! write (*,*) 'avant recalcul: snowmin=',psnowmin(jj1),'psr=', psr(jj1) 00132 ! write (*,*) PSNOW(JJ1), PSNOWBIS(JJ1) 00133 ! write (*,*) PSNOWRHO(JJ1,1), PSNOWRHOBIS(JJ1,1) 00134 ! write (*,*) PSNOWHEAT(JJ1,1), PSNOWHEATBIS(JJ1,1) 00135 ! write (*,*) PSNOWDZ(JJ1,1), PSNOWDZBIS(JJ1,1) 00136 CALL SNOW3LGRID(PSNOWDZN(JJ1,:),PSNOWBIS(JJ1)) 00137 00138 WRITE(*,*) 'psr, psnowmin,psnow', PSR(JJ1), PSNOWMIN(JJ1),PSNOW(JJ1) 00139 ! CALL SNOW3LTRANSF_1D(PSNOWBIS(JJ1),PSNOWDZBIS(JJ1,:),PSNOWDZN(JJ1,:), & 00140 ! ZSNOWRHON(JJ1,:),ZSNOWHEATN(JJ1,:),ZSNOWGRAN1N(JJ1,:), & 00141 ! ZSNOWGRAN2N(JJ1,:),ZSNOWHISTN(JJ1,:),OSNOW_METAMO) 00142 CALL SNOWNLTRANSFGRID_1D(PSNOWBIS(JJ1),PSNOWDZBIS(JJ1,:),PSNOWDZN(JJ1,:), & 00143 ZSNOWRHON(JJ1,:),ZSNOWHEATN(JJ1,:),ZSNOWGRAN1N(JJ1,:), & 00144 ZSNOWGRAN2N(JJ1,:),ZSNOWHISTN(JJ1,:)) 00145 ! write(*,*) 'après' 00146 ! write (*,*) PSNOW(JJ1), PSNOWBIS(JJ1) 00147 ! write (*,*) PSNOWRHO(JJ1,1), PSNOWRHOBIS(JJ1,1) 00148 ! write (*,*) PSNOWHEAT(JJ1,1), PSNOWHEATBIS(JJ1,1) 00149 ! write (*,*) PSNOWDZ(JJ1,1), PSNOWDZBIS(JJ1,1) 00150 ENDIF 00151 ! 00152 PSNOW(JJ1) = PSNOWBIS(JJ1) 00153 PSNOWRHO(JJ1,:) = PSNOWRHOBIS(JJ1,:) 00154 PSNOWHEAT(JJ1,:) = PSNOWHEATBIS(JJ1,:) 00155 PSNOWDZ(JJ1,:) = PSNOWDZBIS(JJ1,:) 00156 ! 00157 PSNOWGRAN1(JJ1,:) = PSNOWGRAN1BIS(JJ1,:) 00158 PSNOWGRAN2(JJ1,:) = PSNOWGRAN2BIS(JJ1,:) 00159 PSNOWHIST(JJ1,:) = PSNOWHISTBIS(JJ1,:) 00160 ! 00161 ENDIF 00162 00163 IF((PSNOWGRAN1(1,3)>80.0).AND.(PSNOWGRAN2(1,3)>2.E-2)) THEN 00164 WRITE(*,*) 'pb2 psnowgran',PSNOWGRAN1(1,3),PSNOWGRAN2(1,3) 00165 ENDIF 00166 IF((PSNOWGRAN1BIS(1,3)>80.0).AND.(PSNOWGRAN2BIS(1,3)>2.E-2)) THEN 00167 WRITE(*,*) 'pb2 psnowgranBIS',PSNOWGRAN1BIS(1,3),PSNOWGRAN2BIS(1,3) 00168 ENDIF 00169 IF((ZSNOWGRAN1N(1,3)>80.0).and.(ZSNOWGRAN2N(1,3)>2.E-2)) THEN 00170 WRITE(*,*) 'pb2 psnowgranN',ZSNOWGRAN1N(1,3),ZSNOWGRAN2N(1,3) & 00171 , ZSNOWHISTN(1,3),PSNOW(1),inlvls 00172 ENDIF 00173 ! 00174 END DO 00175 ! 00176 ! 2. update grid for thin snowpack<3 cm 00177 ! 00178 ! 00179 ZSUMHEAT(:) = 0.0 00180 ZSUMSWE(:) = 0.0 00181 ZSNOWMIX_DELTA(:) = 0.0 00182 ZNDENT(:) = 0.0 00183 ZNVIEU(:) = 0.0 00184 ! 00185 DO JJ1=1, SIZE(PSNOWHEAT,1) 00186 IF(PSNOW(JJ1)<XSNOWCRITD)THEN 00187 ! ajout EB 00188 OMODIFGRID=.TRUE. 00189 DO JJ2=1,INLVLS 00190 ZSUMHEAT(JJ1) = ZSUMHEAT(JJ1) + ZSNOWHEATN(JJ1,JJ2) 00191 ZSUMSWE(JJ1) = ZSUMSWE(JJ1) + ZSNOWRHON (JJ1,JJ2)* PSNOWDZ(JJ1,JJ2) 00192 ZSNOWMIX_DELTA(:) = 1.0 00193 00194 IF(PSNOWGRAN1(JJ1,JJ2)<0)THEN ! Dendritic snow 00195 ZNDENT(JJ1) = ZNDENT(JJ1)+1.0 00196 ELSE ! Non dendritic snow 00197 ZNVIEU(JJ1) = ZNVIEU(JJ1)+1.0 00198 ENDIF 00199 END DO 00200 ENDIF 00201 END DO 00202 ! 00203 ! Average properties for grains : determine which grain type is the most 00204 ! important in the snowpack. 00205 !IF(OSNOW_METAMO)THEN 00206 ! modifs EB pour changer variables de la subroutine suivante 00207 ! IF((PSNOWGRAN1(1,3)>80.0).and.(PSNOWGRAN2(1,3)>2.E-2))then 00208 ! write(*,*) 'pb2b psnowgran',PSNOWGRAN1(1,3),PSNOWGRAN2(1,3) & 00209 ! , PSNOWHIST(1,3),PSNOW(1),zndent(1),znvieu(1),inlvls 00210 !endif 00211 ! ajout EB suppression temporaire de cet appel pour vérif TRANSFGRID 00212 CALL SNOW3LAVGRAIN(PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST, & 00213 ZSNOWGRAN1N, ZSNOWGRAN2N, ZSNOWHISTN,ZNDENT, ZNVIEU) 00214 ! IF((ZSNOWGRAN1N(1,3)>80.0).and.(ZSNOWGRAN2N(1,3)>2.E-2))then 00215 ! write(*,*) 'pb2b psnowgranN',ZSNOWGRAN1N(1,3),ZSNOWGRAN2N(1,3) & 00216 ! , ZSNOWHISTN(1,3),PSNOW(1),zndent(1),znvieu(1),inlvls 00217 ! endif 00218 !ENDIF 00219 ! 00220 !IF(ZSNOWMIX_DELTA(1)>0.)THEN 00221 ! write(*,*) 'PG1_1',PSNOWGRAN1(1,1),'PG2_1',PSNOWGRAN2(1,1) 00222 !ENDIF 00223 ! 00224 DO JJ1=1,INLVLS 00225 ZSNOWHEATN(:,JJ1) = ZSNOWMIX_DELTA(:)*(ZSUMHEAT(:)/INLVLS) + & 00226 (1.0-ZSNOWMIX_DELTA(:))*ZSNOWHEATN(:,JJ1) 00227 ! 00228 PSNOWDZN(:,JJ1) = ZSNOWMIX_DELTA(:)*(PSNOW(:)/INLVLS) + & 00229 (1.0-ZSNOWMIX_DELTA(:))*PSNOWDZN(:,JJ1) 00230 ! 00231 ZSNOWRHON(:,JJ1) = ZSNOWMIX_DELTA(:)*(ZSUMSWE(:)/PSNOW(:)) + & 00232 (1.0-ZSNOWMIX_DELTA(:))*ZSNOWRHON(:,JJ1) 00233 ENDDO 00234 ! 00235 ! 3. Update mass (density and thickness) and heat: 00236 ! 00237 ! ajout EB pour ne faire cet update que pour les couches fines 00238 IF((ZSNOWGRAN1N(1,3)>80.0).and.(ZSNOWGRAN2N(1,3)>2.E-2))then 00239 write(*,*) 'pb3 psnowgran',ZSNOWGRAN1N(1,3),ZSNOWGRAN2N(1,3) 00240 ENDIF 00241 IF((PSNOWGRAN1BIS(1,3)>80.0).and.(PSNOWGRAN2BIS(1,3)>2.E-2))then 00242 write(*,*) 'pb3 psnowgranBIS',PSNOWGRAN1BIS(1,3),PSNOWGRAN2BIS(1,3) 00243 ENDIF 00244 IF(OMODIFGRID) THEN 00245 ! write(*,*) omodifgrid, psnowmin(1), psr(1), zsnowmix_delta(1) 00246 PSNOWRHO(:,:) = ZSNOWRHON(:,:) 00247 PSNOWDZ(:,:) = PSNOWDZN(:,:) 00248 PSNOWHEAT(:,:) = ZSNOWHEATN(:,:) 00249 00250 PSNOWGRAN1(:,:) = ZSNOWGRAN1N(:,:) 00251 PSNOWGRAN2(:,:) = ZSNOWGRAN2N(:,:) 00252 PSNOWHIST(:,:) = ZSNOWHISTN(:,:) 00253 00254 ENDIF 00255 ! 00256 ! 00257 !############################################################# 00258 !############################################################# 00259 !############################################################# 00260 !############################################################# 00261 ! 00262 IF (LHOOK) CALL DR_HOOK('SNOWCROUPGRID',1,ZHOOK_HANDLE) 00263 CONTAINS 00264 ! 00265 ! 00266 SUBROUTINE SNOWCROADDSNOW(PTSTEP,PSR,PTA,PVMOD, & 00267 PSNOW,PSNOWRHO,PSNOWDZ,PSNOWHEAT,PSNOWHMASS, & 00268 PSNOWGRAN1,PSNOWGRAN2,PSNOWHIST,KNLVLS) 00269 !! PURPOSE 00270 !! ------- 00271 ! Add snow to snowpack 00272 ! Update mass and heat content of uppermost layer. 00273 ! 00274 ! 00275 USE MODD_CSTS, ONLY : XLMTT, XTT, XCI 00276 USE MODD_SNOW_PAR, ONLY : XRHOSMIN_ES, XSNOWDMIN, XANSMAX,XSNOWCRITD 00277 USE MODD_SNOW_METAMO 00278 ! 00279 USE MODE_SNOW3L 00280 ! 00281 IMPLICIT NONE 00282 ! 00283 !* 0.1 declarations of arguments 00284 ! 00285 REAL, INTENT(IN) :: PTSTEP 00286 ! 00287 REAL, INTENT(IN) :: PSR, PTA, PVMOD 00288 ! 00289 REAL, INTENT(INOUT) :: PSNOW 00290 ! 00291 REAL, INTENT (INOUT) :: PSNOWRHO, PSNOWDZ, PSNOWHEAT 00292 ! 00293 REAL, INTENT(OUT) :: PSNOWHMASS 00294 ! 00295 REAL, INTENT(INOUT) :: PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST 00296 ! 00297 INTEGER :: KNLVLS 00298 ! 00299 !* 0.2 declarations of local variables 00300 ! 00301 INTEGER JJ 00302 ! 00303 ! 00304 REAL :: ZSNOWFALL, ZRHOSNEW, 00305 ZSNOW, ZSNOWTEMP, 00306 ZSNOWFALL_DELTA, ZSCAP, 00307 ZSDEN, ZSPHE, ZDIAMD,ZDIAMV, 00308 ZDIAMN,ZSPHERD,ZSPHERV, 00309 ZSPHERN, ZDENT 00310 ! 00311 ! ISBA-ES CROCUS (Pahaut 1976): snowfall density coefficients: 00312 ! 00313 REAL, PARAMETER :: ZSNOWFALL_A_SN = 109.0 ! kg/m3 00314 REAL, PARAMETER :: ZSNOWFALL_B_SN = 6.0 ! kg/(m3 K) 00315 REAL, PARAMETER :: ZSNOWFALL_C_SN = 26.0 ! kg/(m7/2 s1/2) 00316 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00317 ! 00318 !------------------------------------------------------------------------------- 00319 ! 00320 ! 0. Initialize: 00321 ! ------------------ 00322 ! 00323 IF (LHOOK) CALL DR_HOOK('SNOWCROADDSNOW',0,ZHOOK_HANDLE) 00324 ZRHOSNEW = XRHOSMIN_ES 00325 ZSNOWFALL = 0.0 00326 ZSCAP = 0.0 00327 ZSNOW = PSNOW 00328 ZSDEN = 0.0 00329 ZSPHE = 0.0 00330 ! 00331 PSNOWHMASS = 0.0 00332 ! 00333 ! 00334 ! 1. Add snow into snowpack: 00335 ! -------------------------- 00336 ! 00337 ! 00338 ! Heat content of newly fallen snow (J/m2): 00339 ! NOTE for now we assume the snowfall has 00340 ! the temperature of the snow surface upon reaching the snow. 00341 ! This is done as opposed to using the air temperature since 00342 ! this flux is quite small and has little to no impact 00343 ! on the time scales of interest. If we use the above assumption 00344 ! then, then the snowfall advective heat flux is zero. 00345 ! 00346 ZSNOWTEMP = XTT 00347 ! 00348 ZSCAP = PSNOWRHO*XCI 00349 ZSNOWTEMP = XTT + (PSNOWHEAT + & 00350 XLMTT*PSNOWRHO*PSNOWDZ)/ & 00351 (ZSCAP*MAX(XSNOWDMIN/KNLVLS,PSNOWDZ)) 00352 ZSNOWTEMP = MIN(XTT, ZSNOWTEMP) 00353 ! 00354 ! 00355 ! 00356 PSNOWHMASS = PSR*(XCI*(ZSNOWTEMP-XTT)-XLMTT)*PTSTEP 00357 ! 00358 ! Snowfall density: Following CROCUS (Pahaut 1976) 00359 ! 00360 ZRHOSNEW = MAX(XRHOSMIN_ES, ZSNOWFALL_A_SN + ZSNOWFALL_B_SN*(PTA-XTT)+ & 00361 ZSNOWFALL_C_SN*SQRT(PVMOD)) 00362 ! 00363 ZSDEN = MAX(MIN(XNDEN1*PVMOD-XNDEN2,XNDEN3),-XGRAN) 00364 ZSPHE = MIN(MAX(XNSPH1*PVMOD+XNSPH2,XNSPH3),XNSPH4) 00365 ! 00366 ! Augment total pack depth: 00367 ! 00368 ZSNOWFALL = PSR*PTSTEP/ZRHOSNEW ! snowfall thickness (m) 00369 ! 00370 ! 00371 PSNOW = PSNOW + ZSNOWFALL 00372 ! 00373 ! Fresh snowfall changes the snowpack 00374 ! density, increases the total liquid water 00375 ! equivalent: in uppermost snow layer: 00376 ! 00377 IF(PSNOWGRAN1<0.0)THEN 00378 PSNOWGRAN1 = (PSNOWDZ*PSNOWRHO*PSNOWGRAN1 + ZSNOWFALL*ZRHOSNEW*ZSDEN)/ & 00379 (PSNOWDZ*PSNOWRHO+ZSNOWFALL*ZRHOSNEW) 00380 PSNOWGRAN2 = (PSNOWDZ*PSNOWRHO*PSNOWGRAN2 + ZSNOWFALL*ZRHOSNEW*ZSPHE)/ & 00381 (PSNOWDZ*PSNOWRHO+ZSNOWFALL*ZRHOSNEW) 00382 ELSEIF(PSNOWGRAN1>=0.0)THEN 00383 ZDIAMD = -ZSDEN*XDIAET/XGRAN+(1+ZSDEN/XGRAN)*(ZSPHE & 00384 *XDIAGF/XGRAN+(1-ZSPHE/XGRAN)*XDIAFP) 00385 ZSPHERD = ZSPHE/XGRAN 00386 ZDIAMV = PSNOWGRAN2 00387 ZSPHERV = PSNOWGRAN1/XGRAN 00388 ZDIAMN = (ZDIAMD*ZRHOSNEW*ZSNOWFALL+ZDIAMV*PSNOWDZ*PSNOWRHO)/ & 00389 (PSNOWDZ*PSNOWRHO+ZSNOWFALL*ZRHOSNEW) 00390 ZSPHERN = (ZSPHERD*ZRHOSNEW*ZSNOWFALL+ZSPHERV*PSNOWDZ*PSNOWRHO)/ & 00391 (PSNOWDZ*PSNOWRHO+ZSNOWFALL*ZRHOSNEW) 00392 IF(ZDIAMN<ZSPHERN*XDIAGF+(1-ZSPHERN)*XDIAFP)THEN 00393 ZDENT=(ZDIAMN-(ZSPHERN*XDIAGF+(1-ZSPHERN)*XDIAFP))/ & 00394 (XDIAET-(ZSPHERN*XDIAGF+(1-ZSPHERN)*XDIAFP)) 00395 PSNOWGRAN1 = -XGRAN*ZDENT 00396 PSNOWGRAN2 = XGRAN*ZSPHERN 00397 ELSE 00398 PSNOWGRAN1 = XGRAN*ZSPHERN 00399 PSNOWGRAN2 = ZDIAMN 00400 ENDIF 00401 ENDIF 00402 PSNOWHIST = 0.0 00403 00404 PSNOWRHO = (PSNOWDZ*PSNOWRHO + ZSNOWFALL*ZRHOSNEW)/ & 00405 (PSNOWDZ+ZSNOWFALL) 00406 PSNOWDZ = PSNOWDZ + ZSNOWFALL 00407 ! 00408 ! Add energy of snowfall to snowpack: 00409 ! Update heat content (J/m2) (therefore the snow temperature 00410 ! and liquid content): 00411 ! 00412 PSNOWHEAT = PSNOWHEAT + PSNOWHMASS 00413 IF (LHOOK) CALL DR_HOOK('SNOWCROADDSNOW',1,ZHOOK_HANDLE) 00414 ! 00415 ! 00416 END SUBROUTINE SNOWCROADDSNOW 00417 ! 00418 ! 00419 !################################################################################ 00420 !################################################################################ 00421 !################################################################################ 00422 ! 00423 ! 00424 SUBROUTINE SNOWCROTRANSF_1D(PSNOW,PSNOWDZ,PSNOWDZN, & 00425 PSNOWRHO,PSNOWHEAT,PSNOWGRAN1, & 00426 PSNOWGRAN2, PSNOWHIST) 00427 ! 00428 !! PURPOSE 00429 !! ------- 00430 ! Snow mass and heat redistibution due to grid thickness 00431 ! configuration resetting. Total mass and heat content 00432 ! of the overall snowpack unchanged/conserved within this routine. 00433 ! 00434 ! 00435 USE MODD_SNOW_PAR, ONLY : XSNOWCRITD 00436 USE MODD_SNOW_METAMO 00437 USE MODE_SNOW3L 00438 ! 00439 IMPLICIT NONE 00440 ! 00441 ! 00442 !* 0.1 declarations of arguments 00443 ! 00444 REAL, INTENT(IN) :: PSNOW 00445 ! 00446 REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWHEAT, PSNOWRHO, PSNOWDZ, 00447 PSNOWDZN, PSNOWGRAN1, PSNOWGRAN2, 00448 PSNOWHIST 00449 ! 00450 !* 0.2 declarations of local variables 00451 ! 00452 INTEGER :: JJ, KILAYER1, KILAYER2 00453 ! 00454 INTEGER :: INLVLS 00455 ! 00456 REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZSNOWRHON,ZSNOWGRAN1,ZSNOWGRAN2, 00457 ZSNOWHEATN,ZSNOWHIST 00458 ! 00459 REAL, DIMENSION(SIZE(PSNOWRHO,1)-1) :: ZSNOWZO, ZSNOWZN, ZSNOWDDZ, ZDELTA 00460 ! ajout EB 00461 !integer :: jjj 00462 real :: htn_new, htn_old 00463 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00464 00465 ! 00466 !------------------------------------------------------------------------------- 00467 ! 00468 ! 0. Initialization: 00469 ! ------------------ 00470 ! 00471 IF (LHOOK) CALL DR_HOOK('SNOWCROTRANSF_1D',0,ZHOOK_HANDLE) 00472 INLVLS = SIZE(PSNOWDZ(:),1) 00473 00474 ZSNOWGRAN1(:)=PSNOWGRAN1(:) 00475 ZSNOWGRAN2(:)=PSNOWGRAN2(:) 00476 ZSNOWHIST(:)=PSNOWHIST(:) 00477 !ajout EB pour vérifier égalité des HTN 00478 00479 htn_new=0. 00480 htn_old=0. 00481 do jj=1,inlvls 00482 htn_new=htn_new+PSNOWDZ(JJ) 00483 htn_old=htn_old+PSNOWDZN(JJ) 00484 enddo 00485 if (abs(htn_new-htn_old) > 1.E-7) write(*,*) 'difhtn:', htn_new, htn_old 00486 ! 00487 ! 00488 ! 1. Calculate vertical grid depths (m): 00489 ! -------------------------------------- 00490 ! 00491 ZSNOWZO(1) = PSNOWDZ(1) 00492 ZSNOWZN(1) = PSNOWDZN(1) 00493 ! 00494 DO JJ=2,INLVLS-1 00495 ZSNOWZO(JJ) = ZSNOWZO(JJ-1) + PSNOWDZ(JJ) 00496 ZSNOWZN(JJ) = ZSNOWZN(JJ-1) + PSNOWDZN(JJ) 00497 ENDDO 00498 ! 00499 ! 2. Calculate thickness changes (m): 00500 ! ----------------------------------- 00501 ! 00502 ZSNOWDDZ(:) = ZSNOWZN(:) - ZSNOWZO(:) 00503 ! 00504 ! Calculate the delta function: 00505 ! 00506 ZDELTA(:) = 0.0 00507 WHERE(ZSNOWDDZ(:) > 0.0) ZDELTA(:) = 1.0 00508 ! 00509 ! 00510 ! 3. Calculate mass and heat transfers due to grid adjustment/changes: 00511 ! -------------------------------------------------------------------- 00512 ! Do transfers at boundaries first: 00513 ! Upper layer: 00514 ! 00515 !write(*,*) 'AV_AGREG1', PSNOWGRAN1(1) 00516 IF(ZDELTA(1)==1.0)THEN 00517 KILAYER1=1 00518 KILAYER2=2 00519 CALL SNOW3LAGREG(PSNOWDZN,PSNOWDZ,PSNOWRHO,PSNOWGRAN1,PSNOWGRAN2, & 00520 PSNOWHIST,ZSNOWGRAN1,ZSNOWGRAN2,ZSNOWHIST, & 00521 KILAYER1,KILAYER2,ZSNOWDDZ) 00522 00523 ENDIF 00524 !write(*,*) 'AP_AGREG1', PSNOWGRAN1(1) 00525 ! 00526 ZSNOWRHON(1) = ( PSNOWDZ(1)*PSNOWRHO(1) + ZSNOWDDZ(1)* & 00527 ( ZDELTA(1) *PSNOWRHO(2) + & 00528 (1.0-ZDELTA(1))*PSNOWRHO(1) ) ) & 00529 /PSNOWDZN(1) 00530 00531 ! 00532 ZSNOWHEATN(1) = PSNOWHEAT(1) + ZSNOWDDZ(1)* & 00533 (( ZDELTA(1) *PSNOWHEAT(2)/PSNOWDZ(2)) + & 00534 ((1.0-ZDELTA(1))*PSNOWHEAT(1)/PSNOWDZ(1)) ) 00535 ! 00536 !IF(ZSNOWGRAN1(1)>99.OR.ZSNOWGRAN1(1)<-99.)THEN 00537 ! write(*,*) 'ZG1',ZSNOWGRAN1(1) 00538 ! read(*,*) 00539 !ENDIF 00540 ! Lowest layer: 00541 ! 00542 IF(ZDELTA(INLVLS-1)==0.0)THEN 00543 KILAYER1=INLVLS 00544 KILAYER2=INLVLS-1 00545 CALL SNOW3LAGREG(PSNOWDZN,PSNOWDZ,PSNOWRHO,PSNOWGRAN1,PSNOWGRAN2, & 00546 PSNOWHIST,ZSNOWGRAN1,ZSNOWGRAN2,ZSNOWHIST, & 00547 KILAYER1,KILAYER2,ZSNOWDDZ) 00548 ENDIF 00549 ! 00550 ZSNOWRHON(INLVLS) = ( PSNOWDZ(INLVLS)*PSNOWRHO(INLVLS) - & 00551 ZSNOWDDZ(INLVLS-1)* & 00552 ( ZDELTA(INLVLS-1) *PSNOWRHO(INLVLS) + & 00553 (1.0-ZDELTA(INLVLS-1))*PSNOWRHO(INLVLS-1) ) ) & 00554 /PSNOWDZN(INLVLS) 00555 ! 00556 00557 ZSNOWHEATN(INLVLS) = PSNOWHEAT(INLVLS) - ZSNOWDDZ(INLVLS-1)* & 00558 (( ZDELTA(INLVLS-1) *PSNOWHEAT(INLVLS)/ & 00559 PSNOWDZ(INLVLS)) + & 00560 ((1.0-ZDELTA(INLVLS-1))*PSNOWHEAT(INLVLS-1) & 00561 /PSNOWDZ(INLVLS-1)) ) 00562 ! 00563 ! 00564 ! Update interior layer mass and heat : 00565 ! 00566 !write(*,*) 'AV_AGREG8', PSNOWGRAN1(8),'ZD7',ZDELTA(7),'ZD9',ZDELTA(9) 00567 DO JJ=2,INLVLS-1 00568 IF(ZDELTA(JJ-1)==0.0)THEN 00569 KILAYER1=JJ 00570 KILAYER2=JJ-1 00571 CALL SNOW3LAGREG(PSNOWDZN,PSNOWDZ,PSNOWRHO,PSNOWGRAN1,PSNOWGRAN2, & 00572 PSNOWHIST,ZSNOWGRAN1,ZSNOWGRAN2,ZSNOWHIST, & 00573 KILAYER1,KILAYER2,ZSNOWDDZ) 00574 ! if (zsnowgran1(2) > 900.or. psnowgran1(2)>900.) then 00575 ! write (*,*) 'agr',PSNOWGRAN1(2),PSNOWGRAN1(2), & 00576 ! zSNOWGRAN1(2),zSNOWGRAN1(2), KILAYER1,KILAYER2 00577 ! write(*,*) 'dzold:',(psnowdz(jjj),jjj=1, INLVLS) 00578 ! write(*,*) 'dznew:',(psnowdzn(jjj),jjj=1, INLVLS) 00579 ! stop 00580 ! endif 00581 ENDIF 00582 ! 00583 !code initial vincent IF(OSNOW_METAMO.AND.ZDELTA(JJ+1)==1.0)THEN 00584 !code initial vincent KILAYER1=JJ 00585 !code initial vincent KILAYER2=JJ+1 00586 !code initial vincent CALL SNOW3LAGREG(PSNOWDZN,PSNOWDZ,PSNOWRHO,PSNOWGRAN1,PSNOWGRAN2, & 00587 !code initial vincent PSNOWHIST,ZSNOWGRAN1,ZSNOWGRAN2,ZSNOWHIST, & 00588 !code initial vincent KILAYER1,KILAYER2,ZSNOWDDZ) 00589 !code initial vincent ENDIF 00590 00591 !plm 00592 IF(ZDELTA(JJ)==1.0)THEN 00593 KILAYER1=JJ-1 00594 KILAYER2=JJ 00595 CALL SNOW3LAGREG(PSNOWDZN,PSNOWDZ,PSNOWRHO,PSNOWGRAN1,PSNOWGRAN2, & 00596 PSNOWHIST,ZSNOWGRAN1,ZSNOWGRAN2,ZSNOWHIST, & 00597 KILAYER1,KILAYER2,ZSNOWDDZ) 00598 ENDIF 00599 !plm 00600 ! 00601 ZSNOWRHON(JJ) = ( PSNOWDZ(JJ)*PSNOWRHO(JJ) & 00602 - ZSNOWDDZ(JJ-1)* & 00603 ( ZDELTA(JJ-1) *PSNOWRHO(JJ) + & 00604 (1.0-ZDELTA(JJ-1))*PSNOWRHO(JJ-1) ) & 00605 + ZSNOWDDZ(JJ)* & 00606 ( ZDELTA(JJ) *PSNOWRHO(JJ+1) + & 00607 (1.0-ZDELTA(JJ)) *PSNOWRHO(JJ) ) ) & 00608 /PSNOWDZN(JJ) 00609 00610 ! 00611 ZSNOWHEATN(JJ) = PSNOWHEAT(JJ) & 00612 - ZSNOWDDZ(JJ-1)* & 00613 (( ZDELTA(JJ-1) *PSNOWHEAT(JJ) & 00614 /PSNOWDZ(JJ)) + & 00615 ((1.0-ZDELTA(JJ-1))*PSNOWHEAT(JJ-1) & 00616 /PSNOWDZ(JJ-1)) ) & 00617 + ZSNOWDDZ(JJ)* & 00618 (( ZDELTA(JJ) *PSNOWHEAT(JJ+1) & 00619 /PSNOWDZ(JJ+1)) + & 00620 ((1.0-ZDELTA(JJ))*PSNOWHEAT(JJ) & 00621 /PSNOWDZ(JJ)) ) 00622 ENDDO 00623 !write(*,*) 'AP_AGREG8', PSNOWGRAN1(8) 00624 ! 00625 ! 00626 ! 5. Update mass (density and thickness) and heat: 00627 ! ------------------------------------------------ 00628 ! 00629 PSNOWRHO(:) = ZSNOWRHON(:) 00630 !PSNOWDZ(:) = PSNOWDZN(:) 00631 PSNOWHEAT(:) = ZSNOWHEATN(:) 00632 PSNOWGRAN1(:) = ZSNOWGRAN1(:) 00633 PSNOWGRAN2(:) = ZSNOWGRAN2(:) 00634 PSNOWHIST(:) = ZSNOWHIST(:) 00635 IF (LHOOK) CALL DR_HOOK('SNOWCROTRANSF_1D',1,ZHOOK_HANDLE) 00636 ! 00637 ! 00638 !------------------------------------------------------------------------------- 00639 ! 00640 END SUBROUTINE SNOWCROTRANSF_1D 00641 !################################################################################ 00642 !################################################################################ 00643 !################################################################################ 00644 ! 00645 ! 00646 SUBROUTINE SNOWNLTRANSFGRID_1D(PSNOW,PSNOWDZ,PSNOWDZN, & 00647 PSNOWRHO,PSNOWHEAT,PSNOWGRAN1, & 00648 PSNOWGRAN2, PSNOWHIST) 00649 ! 00650 !! PURPOSE 00651 !! ------- 00652 ! Snow mass and heat redistibution due to grid thickness 00653 ! configuration resetting. Total mass and heat content 00654 ! of the overall snowpack unchanged/conserved within this routine. 00655 ! 00656 ! 00657 USE MODD_SNOW_PAR, ONLY : XSNOWCRITD 00658 USE MODD_SNOW_METAMO 00659 USE MODE_SNOW3L 00660 ! 00661 IMPLICIT NONE 00662 ! 00663 ! 00664 !* 0.1 declarations of arguments 00665 ! 00666 REAL, INTENT(IN) :: PSNOW 00667 ! 00668 REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWHEAT, PSNOWRHO, PSNOWDZ, 00669 PSNOWDZN, PSNOWGRAN1, PSNOWGRAN2, 00670 PSNOWHIST 00671 ! 00672 !* 0.2 declarations of local variables 00673 ! 00674 INTEGER JJ, KILAYER1, KILAYER2 00675 ! 00676 INTEGER :: INLVLS,INLVLS_OLD, INLVLS_NEW 00677 ! 00678 REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZSNOWRHON,ZSNOWGRAN1N,ZSNOWGRAN2N, 00679 ZSNOWHEATN,ZSNOWHISTN 00680 , ZSNOWZTOP_OLD, ZSNOWZTOP_NEW, ZSNOWZBOT_OLD, ZSNOWZBOT_NEW 00681 ! 00682 00683 REAL, PARAMETER :: D1=1., D2=3., D3=4., X=99., COEFALB2=15.4 00684 INTEGER :: JJ_OLD,JJ_NEW 00685 REAL :: ZDENTMOYN ,ZSPHERMOYN, ZALBMOYN, ZMASTOTN, ZSNOWHEAN, 00686 ZPROPOR,ZMASDZ_OLD, ZDIAM,ZHISTMOYN 00687 REAL :: ZPSNOW_OLD, ZPSNOW_NEW 00688 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00689 00690 ! 00691 !------------------------------------------------------------------------------- 00692 ! 00693 ! 0. Initialization: 00694 ! ------------------ 00695 ! 00696 IF (LHOOK) CALL DR_HOOK('SNOWNLTRANSFGRID_1D',0,ZHOOK_HANDLE) 00697 INLVLS = SIZE(PSNOWDZ(:),1) 00698 ! a ce stade, les couches restent identiques 00699 INLVLS_OLD=INLVLS 00700 INLVLS_NEW=INLVLS 00701 ZPSNOW_OLD=PSNOW 00702 ZPSNOW_NEW=PSNOW 00703 00704 ! 00705 ! 1. Calculate vertical grid limits (m): 00706 ! -------------------------------------- 00707 ! 00708 ZSNOWZTOP_OLD(1) = ZPSNOW_OLD 00709 ZSNOWZTOP_NEW(1) = ZPSNOW_NEW 00710 ZSNOWZBOT_OLD(1) = ZSNOWZTOP_OLD(1)-PSNOWDZ(1) 00711 ZSNOWZBOT_NEW(1) = ZSNOWZTOP_NEW(1)-PSNOWDZN(1) 00712 00713 ! 00714 DO JJ_OLD=2,INLVLS_OLD 00715 ZSNOWZTOP_OLD(JJ_OLD) = ZSNOWZBOT_OLD(JJ_OLD-1) 00716 ZSNOWZBOT_OLD(JJ_OLD) = ZSNOWZTOP_OLD(JJ_OLD)-PSNOWDZ(JJ_OLD) 00717 ENDDO 00718 DO JJ_NEW=2,INLVLS_NEW 00719 ZSNOWZTOP_NEW(JJ_NEW) = ZSNOWZBOT_NEW(JJ_NEW-1) 00720 ZSNOWZBOT_NEW(JJ_NEW) = ZSNOWZTOP_NEW(JJ_NEW)-PSNOWDZN(JJ_NEW) 00721 ENDDO 00722 ! 00723 ! 00724 ! 3. Calculate mass and heat transfers due to grid adjustment/changes: 00725 ! -------------------------------------------------------------------- 00726 ! 00727 00728 ! on boucle sur les couches de la nouvelle grille et pour chaque couche 00729 ! on somme ou on moyenne les quantités des couches totales ou partielles 00730 ! des couches anciennes qui la constituent 00731 00732 DO JJ_NEW=1,INLVLS_NEW 00733 ZSNOWHEAN=0. 00734 ZMASTOTN=0. 00735 00736 ZDENTMOYN=0. 00737 ZSPHERMOYN=0. 00738 ZALBMOYN=0. 00739 ZDIAM=0. 00740 ZHISTMOYN=0. 00741 00742 ! on balaye les couches anciennes pour identifier celles qui constituent les 00743 ! nouvelles et on somme leurs contribs à la nouvelle couche JJ_NEW 00744 DO JJ_OLD=1, INLVLS_OLD 00745 IF( ZSNOWZTOP_OLD(JJ_OLD) <= ZSNOWZBOT_NEW(JJ_NEW)) THEN 00746 ! haut de JJ_O plus bas que bas de JJ_N ==> pas contrib 00747 ELSEIF ( ZSNOWZBOT_OLD(JJ_OLD) >= ZSNOWZTOP_NEW(JJ_NEW)) THEN 00748 ! bas de JJ_O plus haut que bas de JJ_N ==> pas contrib 00749 ELSE 00750 ! ancienne couche à cheval ou englobant nouvelle 00751 ZPROPOR= (MIN(ZSNOWZTOP_OLD(JJ_OLD), ZSNOWZTOP_NEW(JJ_NEW))& 00752 - MAX(ZSNOWZBOT_OLD(JJ_OLD), ZSNOWZBOT_NEW(JJ_NEW))) & 00753 / PSNOWDZ(JJ_OLD) 00754 ZMASDZ_OLD= ZPROPOR*PSNOWRHO(JJ_OLD)*PSNOWDZ(JJ_OLD) 00755 ZMASTOTN=ZMASTOTN + ZMASDZ_OLD 00756 ZSNOWHEAN=ZSNOWHEAN+ZPROPOR*PSNOWHEAT(JJ_OLD) 00757 00758 IF(PSNOWGRAN1(JJ_OLD)<0.) THEN 00759 ! calcul dimametre optique en 1/10 mmm 00760 ZDIAM=-PSNOWGRAN1(JJ_OLD)*D1/X+(1.+PSNOWGRAN1(JJ_OLD)/X)* & 00761 (PSNOWGRAN2(JJ_OLD)*D2/X+(1.-PSNOWGRAN2(JJ_OLD)/X)*D3) 00762 ZDIAM=ZDIAM/10000. 00763 ZDENTMOYN= ZDENTMOYN-ZMASDZ_OLD*PSNOWGRAN1(JJ_OLD)/X 00764 ZSPHERMOYN=ZSPHERMOYN+ZMASDZ_OLD*PSNOWGRAN2(JJ_OLD)/X 00765 ELSE 00766 ZDIAM=PSNOWGRAN2(JJ_OLD) 00767 ZDENTMOYN= ZDENTMOYN+ZMASDZ_OLD*0. 00768 ZSPHERMOYN=ZSPHERMOYN+ZMASDZ_OLD*PSNOWGRAN1(JJ_OLD)/X 00769 ENDIF 00770 ZALBMOYN=ZALBMOYN+MAX(0.,ZMASDZ_OLD*(1.-COEFALB2*SQRT(ZDIAM))) 00771 ZHISTMOYN=ZHISTMOYN+ZMASDZ_OLD*PSNOWHIST(JJ_OLD) 00772 ENDIF 00773 ENDDO 00774 ! on affecte à la nouvelle couche ses propriétés moyennes 00775 00776 ZSNOWHEATN(JJ_NEW)= ZSNOWHEAN 00777 ZSNOWRHON(JJ_NEW)= ZMASTOTN/PSNOWDZN(JJ_NEW) 00778 ZALBMOYN=ZALBMOYN/ZMASTOTN 00779 ZSPHERMOYN=MAX(0.,ZSPHERMOYN/ZMASTOTN) 00780 ZDENTMOYN=MAX(0.,ZDENTMOYN/ZMASTOTN) 00781 ZDIAM=((1.-ZALBMOYN)/COEFALB2)**2 00782 write(*,*) 'zdiam=', zdiam, zalbmoyn, zdentmoyn, zsphermoyn 00783 ! ZDIAM=MAX(1.E-4, ZDIAM) 00784 IF (ZDIAM <3.E-4-0.0000001) THEN 00785 ! on préserve dendricite puis on calcule sphericite 00786 ZSNOWGRAN1N(JJ_NEW)=-X*ZDENTMOYN 00787 IF(ABS(ZSNOWGRAN1N(JJ_NEW)+X)< 0.01) THEN 00788 ZSNOWGRAN2N(JJ_NEW)=X*ZSPHERMOYN 00789 ELSE 00790 ZSNOWGRAN2N(JJ_NEW)=X*((ZDIAM*10000.+ZSNOWGRAN1N(JJ_NEW)*D1/X) & 00791 / (1.+ZSNOWGRAN1N(JJ_NEW)/X)-D3)/(D2-D3) 00792 IF (ZSNOWGRAN2N(JJ_NEW)<0.) THEN 00793 IF(ZSNOWGRAN2N(JJ_NEW)<-0.1) write(*,*) 'pb av1a',ZDIAM,ZDENTMOYN,ZSPHERMOYN, & 00794 ZSNOWGRAN1N(JJ_NEW),ZSNOWGRAN2N(JJ_NEW) 00795 ZSNOWGRAN2N(JJ_NEW)=0. 00796 ENDIF 00797 IF (ZSNOWGRAN2N(JJ_NEW)> X + 0.0000001) THEN 00798 IF(ZSNOWGRAN2N(JJ_NEW)>99.1) write(*,*) 'pb av1b',ZDIAM,ZDENTMOYN,ZSPHERMOYN, & 00799 ZSNOWGRAN1N(JJ_NEW),ZSNOWGRAN2N(JJ_NEW) 00800 ZSNOWGRAN2N(JJ_NEW)=X 00801 ENDIF 00802 ENDIF 00803 ELSEIF (ZDIAM >4.E-4) THEN 00804 ZSNOWGRAN1N(JJ_NEW)=X*ZSPHERMOYN 00805 ZSNOWGRAN2N(JJ_NEW)=ZDIAM 00806 ELSEIF(ZDENTMOYN<= 0.+0.0000001) THEN 00807 ! taille entre 3.E-4 et 4E-4 et dendricite nulle 00808 ZSNOWGRAN1N(JJ_NEW)=X*ZSPHERMOYN 00809 ZSNOWGRAN2N(JJ_NEW)=ZDIAM 00810 ELSE 00811 ! taille entre 3.E-4 et 4E-4 et dendricite <0 00812 ! on preserve d'abord sphericite. Si impossible on met dendit a 0 et on 00813 ! preserve sphericite 00814 ZSNOWGRAN1N(JJ_NEW)=-X*ZDENTMOYN 00815 ZSNOWGRAN2N(JJ_NEW)=X*((ZDIAM*10000.+ZSNOWGRAN1N(JJ_NEW)*D1/X) & 00816 / (1.+ZSNOWGRAN1N(JJ_NEW)/X)-D3)/(D2-D3) 00817 IF ( ZSNOWGRAN2N(JJ_NEW)<0..OR. ZSNOWGRAN2N(JJ_NEW)> X) THEN 00818 ! incompatible avec ZDIAM on met dendicite a 0 et on preserve sphericite 00819 IF ( ZSNOWGRAN2N(JJ_NEW)<-0.1.OR. ZSNOWGRAN2N(JJ_NEW)>99.1) & 00820 write(*,*) 'pb av2', ZDIAM, ZDENTMOYN, ZSPHERMOYN, & 00821 ZSNOWGRAN1N(JJ_NEW),ZSNOWGRAN2N(JJ_NEW) 00822 00823 ZSNOWGRAN1N(JJ_NEW)=X*ZSPHERMOYN 00824 ZSNOWGRAN2N(JJ_NEW)=ZDIAM 00825 ENDIF 00826 ENDIF 00827 ZSNOWHISTN(JJ_NEW)=NINT(ZHISTMOYN/ZMASTOTN) 00828 ! ZSNOWGRAN2N(JJ_NEW)=X*ZSPHERMOYN 00829 ! ZSNOWGRAN1N(JJ_NEW)=X*(ZDIAM*10000.-(ZSNOWGRAN2N(JJ_NEW)*D2/X+& 00830 ! (1.-ZSNOWGRAN2N(JJ_NEW)/X)*D3))/& 00831 ! (ZSNOWGRAN2N(JJ_NEW)*D2/X+(1.-ZSNOWGRAN2N(JJ_NEW)/X)*D3) 00832 ENDDO 00833 ! 00834 !verifs 00835 write (*,*) 'verifs chgt grille INLVLS=',INLVLS 00836 ZSNOWHEAN=0. 00837 ZMASTOTN=0. 00838 00839 DO JJ=1,INLVLS 00840 ZSNOWHEAN=ZSNOWHEAN+PSNOWHEAT(JJ)- ZSNOWHEATN(JJ) 00841 ZMASTOTN=ZMASTOTN+PSNOWRHO(JJ)*PSNOWDZ(JJ)- ZSNOWRHON(JJ)*PSNOWDZN(JJ) 00842 write(*,*) JJ,'DZ', PSNOWDZ(JJ),PSNOWDZN(JJ) 00843 write (*,*) 'RHO', PSNOWRHO(JJ) , ZSNOWRHON(JJ) 00844 write (*,*) 'HEAT',PSNOWHEAT(JJ) , ZSNOWHEATN(JJ) 00845 write (*,*) 'GR1', PSNOWGRAN1(JJ) , ZSNOWGRAN1N(JJ) 00846 write (*,*) 'GR2',PSNOWGRAN2(JJ) , ZSNOWGRAN2N(JJ) 00847 write (*,*) 'HIST',PSNOWHIST(JJ) , ZSNOWHISTN(JJ) 00848 ENDDO 00849 write(*,*) 'diff', ZSNOWHEAN,ZMASTOTN 00850 00851 00852 00853 ! 00854 ! 5. Update mass (density and thickness) and heat: 00855 ! ------------------------------------------------ 00856 ! 00857 PSNOWRHO(:) = ZSNOWRHON(:) 00858 PSNOWHEAT(:) = ZSNOWHEATN(:) 00859 PSNOWGRAN1(:) = ZSNOWGRAN1N(:) 00860 PSNOWGRAN2(:) = ZSNOWGRAN2N(:) 00861 PSNOWHIST(:) = ZSNOWHISTN(:) 00862 IF (LHOOK) CALL DR_HOOK('SNOWNLTRANSFGRID_1D',1,ZHOOK_HANDLE) 00863 ! 00864 ! 00865 !------------------------------------------------------------------------------- 00866 ! 00867 END SUBROUTINE SNOWNLTRANSFGRID_1D 00868 00869 !#################################################################### 00870 !############################################################################ 00871 END SUBROUTINE SNOWCROUPGRID
1.8.0
