7 plaicv,psnowrho,psnowswe,psnowheat, &
8 psnowtemp,psnowdz,pscond,pheatcaps,pemisnow,psigma_f,pchip, &
9 ptstep,psr,pta,pvmod,psnowage,ppermsnowfrac )
64 USE yomhook
,ONLY : lhook, dr_hook
65 USE parkind1
,ONLY : jprb
73 REAL,
DIMENSION(:),
INTENT(IN) :: plaicv
74 REAL,
DIMENSION(:),
INTENT(IN) :: pps
75 REAL,
DIMENSION(:),
INTENT(IN) :: psr
76 REAL,
DIMENSION(:),
INTENT(IN) :: pta
77 REAL,
DIMENSION(:),
INTENT(IN) :: pvmod
78 REAL,
DIMENSION(:),
INTENT(IN) :: ppermsnowfrac
79 REAL,
DIMENSION(:,:),
INTENT(IN) :: psnowheat
81 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: psnowswe, psnowage, psnowrho
83 REAL,
DIMENSION(:),
INTENT(OUT) :: psigma_f, pchip
84 REAL,
DIMENSION(:),
INTENT(OUT) :: pemisnow
85 REAL,
DIMENSION(:,:),
INTENT(OUT) :: psnowdz, pscond, pheatcaps, psnowtemp
91 REAL,
DIMENSION(SIZE(PLAICV,1)) :: zpsna
92 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowliq, zsnowheat, zsnowdzn
93 REAL,
DIMENSION(SIZE(PTA)) :: zsnow, zsnowhmass
95 REAL(KIND=JPRB) :: zhook_handle
99 IF (lhook) CALL dr_hook(
'PREPS_FOR_MEB_EBUD_RAD',0,zhook_handle)
110 WHERE(psnowrho(:,:)==xundef)
111 psnowrho(:,:) = xrhosmin_es
114 psnowdz(:,:) = psnowswe(:,:)/psnowrho(:,:)
118 zsnowheat(:,:) = psnowheat(:,:)*psnowswe(:,:)/psnowrho(:,:)
121 DO jk=1,
SIZE(psnowdz,2)
122 DO ji=1,
SIZE(psnowdz,1)
123 zsnow(ji) = zsnow(ji) + psnowdz(ji,jk)
127 CALL
snow3lfall(ptstep,psr,pta,pvmod,zsnow,psnowrho,psnowdz, &
128 zsnowheat,zsnowhmass,psnowage,ppermsnowfrac )
130 CALL
snow3lgrid(zsnowdzn,zsnow,psnowdz_old=psnowdz)
132 CALL
snow3ltransf(zsnow,psnowdz,zsnowdzn,psnowrho,zsnowheat,psnowage)
140 psnowtemp(:,:) = xtt + ( ((zsnowheat(:,:)/max(1.e-10,psnowdz(:,:))) &
141 + xlmtt*psnowrho(:,:))/pheatcaps(:,:) )
143 zsnowliq(:,:) = max(0.0,psnowtemp(:,:)-xtt)*pheatcaps(:,:)* &
144 psnowdz(:,:)/(xlmtt*xrholw)
146 psnowtemp(:,:) = min(xtt,psnowtemp(:,:))
150 psnowswe(:,:) = psnowdz(:,:)*psnowrho(:,:)
152 CALL
snow3lcompactn(ptstep,xsnowdzmin,psnowrho,psnowdz,psnowtemp,zsnow,zsnowliq)
156 CALL
snow3lthrm(psnowrho,pscond,psnowtemp,pps)
162 psigma_f(:) = 1.0 - pchip(:)
166 pemisnow(:) = xemissn
168 IF (lhook) CALL dr_hook(
'PREPS_FOR_MEB_EBUD_RAD',1,zhook_handle)
172 SUBROUTINE snow3lfall(PTSTEP,PSR,PTA,PVMOD,PSNOW,PSNOWRHO,PSNOWDZ, &
173 psnowheat,psnowhmass,psnowage,ppermsnowfrac)
193 REAL,
INTENT(IN) :: ptstep
195 REAL,
DIMENSION(:),
INTENT(IN) :: psr, pta, pvmod, ppermsnowfrac
197 REAL,
DIMENSION(:),
INTENT(INOUT) :: psnow
199 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: psnowrho, psnowdz, psnowheat, psnowage
201 REAL,
DIMENSION(:),
INTENT(OUT) :: psnowhmass
211 REAL,
DIMENSION(SIZE(PTA)) :: zsnowfall, zrhosnew, &
213 zsnowfall_delta, zscap, &
216 REAL(KIND=JPRB) :: zhook_handle
223 IF (lhook) CALL dr_hook(
'SNOW3LFALL',0,zhook_handle)
225 ini =
SIZE(psnowdz(:,:),1)
226 inlvls =
SIZE(psnowdz(:,:),2)
228 zrhosnew(:) = xrhosmin_es
251 WHERE (psr(:) > 0.0 .AND. psnowdz(:,1)>0.)
252 zsnowtemp(:) = xtt + (psnowheat(:,1) + &
253 xlmtt*psnowrho(:,1)*psnowdz(:,1))/ &
254 (zscap(:)*max(xsnowdmin/inlvls,psnowdz(:,1)))
255 zsnowtemp(:) = min(xtt, zsnowtemp(:))
260 psnowhmass(:) = psr(:)*(xci*(zsnowtemp(:)-xtt)-xlmtt)*ptstep
264 zrhosnew(:) = max(xrhosmin_es, xsnowfall_a_sn + xsnowfall_b_sn*(pta(:)-xtt)+ &
265 xsnowfall_c_sn*sqrt(pvmod(:)))
271 psnowage(:,1) = (psnowage(:,1)*psnowdz(:,1)*psnowrho(:,1)+zagenew(:)*psr(:)*ptstep) / &
272 (psnowdz(:,1)*psnowrho(:,1)+psr(:)*ptstep)
276 zsnowfall(:) = psr(:)*ptstep/zrhosnew(:)
278 psnow(:) = psnow(:) + zsnowfall(:)
284 psnowrho(:,1) = (psnowdz(:,1)*psnowrho(:,1) + zsnowfall(:)*zrhosnew(:))/ &
285 (psnowdz(:,1)+zsnowfall(:))
287 psnowdz(:,1) = psnowdz(:,1) + zsnowfall(:)
293 psnowheat(:,1) = psnowheat(:,1) + psnowhmass(:)
306 zsnowfall_delta(:) = 0.0
307 WHERE(zsnow(:) == 0.0 .AND. psr(:) > 0.0)
308 zsnowfall_delta(:) = 1.0
314 psnowdz(ji,jj) = zsnowfall_delta(ji)*(zsnowfall(ji) /inlvls) + &
315 (1.0-zsnowfall_delta(ji))*psnowdz(ji,jj)
317 psnowheat(ji,jj) = zsnowfall_delta(ji)*(psnowhmass(ji)/inlvls) + &
318 (1.0-zsnowfall_delta(ji))*psnowheat(ji,jj)
320 psnowrho(ji,jj) = zsnowfall_delta(ji)*zrhosnew(ji) + &
321 (1.0-zsnowfall_delta(ji))*psnowrho(ji,jj)
323 psnowage(ji,jj) = zsnowfall_delta(ji)*(zagenew(ji)/inlvls) + &
324 (1.0-zsnowfall_delta(ji))*psnowage(ji,jj)
329 IF (lhook) CALL dr_hook(
'SNOW3LFALL',1,zhook_handle)
335 psnowrho,psnowheat,psnowage)
351 REAL,
DIMENSION(: ),
INTENT(IN) :: psnow
353 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: psnowdzn
354 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: psnowheat
355 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: psnowrho
356 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: psnowdz
357 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: psnowage
361 INTEGER :: ji, jl, jlo
366 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowrhon
367 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowheatn
368 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowagen
369 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowztop_new
370 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowzbot_new
371 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowrhoo
372 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowheato
373 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowageo
374 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowdzo
375 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowztop_old
376 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowzbot_old
377 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowhean
378 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowagn
379 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zmastotn
380 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zmassdzo
382 REAL,
DIMENSION(SIZE(PSNOW)) :: zpsnow_old, zpsnow_new
383 REAL,
DIMENSION(SIZE(PSNOW)) :: zsumheat, zsumswe, zsumage, zsnowmix_delta
387 REAL(KIND=JPRB) :: zhook_handle
395 IF (lhook) CALL dr_hook(
'SNOW3LTRANSF',0,zhook_handle)
397 ini =
SIZE(psnowrho,1)
398 inlvls =
SIZE(psnowrho,2)
401 zpsnow_old(:) = psnow(:)
405 zpsnow_new(ji)=zpsnow_new(ji)+psnowdzn(ji,jl)
411 zsnowdzo(:,:) = psnowdz(:,:)
412 zsnowrhoo(:,:) = psnowrho(:,:)
413 zsnowheato(:,:) = psnowheat(:,:)
414 zsnowageo(:,:) = psnowage(:,:)
415 zmassdzo(:,:) = xundef
420 zsnowztop_old(:,1) = zpsnow_old(:)
421 zsnowztop_new(:,1) = zpsnow_new(:)
422 zsnowzbot_old(:,1) = zsnowztop_old(:,1)-zsnowdzo(:,1)
423 zsnowzbot_new(:,1) = zsnowztop_new(:,1)-psnowdzn(:,1)
427 zsnowztop_old(ji,jl) = zsnowzbot_old(ji,jl-1)
428 zsnowztop_new(ji,jl) = zsnowzbot_new(ji,jl-1)
429 zsnowzbot_old(ji,jl) = zsnowztop_old(ji,jl )-zsnowdzo(ji,jl)
430 zsnowzbot_new(ji,jl) = zsnowztop_new(ji,jl )-psnowdzn(ji,jl)
433 zsnowzbot_old(:,inlvls)=0.0
434 zsnowzbot_new(:,inlvls)=0.0
436 WHERE(psnowdzn(:,:)==0.)
437 zsnowztop_old(:,:) = 0.
438 zsnowztop_new(:,:) = 0.
439 zsnowzbot_old(:,:) = 0.
440 zsnowzbot_new(:,:) = 0.
458 IF((zsnowztop_old(ji,jlo)>zsnowzbot_new(ji,jl)).AND.(zsnowzbot_old(ji,jlo)<zsnowztop_new(ji,jl)))
THEN
460 zpropor = (min(zsnowztop_old(ji,jlo), zsnowztop_new(ji,jl)) &
461 - max(zsnowzbot_old(ji,jlo), zsnowzbot_new(ji,jl)))&
464 zmassdzo(ji,jlo)=zsnowrhoo(ji,jlo)*zsnowdzo(ji,jlo)*zpropor
466 zmastotn(ji,jl)=zmastotn(ji,jl)+zmassdzo(ji,jlo)
467 zsnowagn(ji,jl)=zsnowagn(ji,jl)+zsnowageo(ji,jlo)*zmassdzo(ji,jlo)
469 zsnowhean(ji,jl)=zsnowhean(ji,jl)+zsnowheato(ji,jlo)*zpropor
479 zsnowheatn(:,:)= zsnowhean(:,:)
480 WHERE(psnowdzn(:,:)==0.)
481 zsnowagen(:,:)= psnowage(:,:)
482 zsnowrhon(:,:)= psnowrho(:,:)
483 zsnowheatn(:,:)= psnowheat(:,:)
485 zsnowagen(:,:)= zsnowagn(:,:)/zmastotn(:,:)
486 zsnowrhon(:,:)= zmastotn(:,:)/psnowdzn(:,:)
501 zsnowmix_delta(:) = 0.0
505 IF(psnow(ji) < xsnowcritd)
THEN
506 zsumheat(ji) = zsumheat(ji) + psnowheat(ji,jl)
507 zsumswe(ji) = zsumswe(ji) + psnowrho(ji,jl)*psnowdz(ji,jl)
508 zsumage(ji) = zsumage(ji) + psnowage(ji,jl)
509 zsnowmix_delta(ji) = 1.0
521 IF(psnowdzn(ji,jl)>0.)
THEN
524 zsnowheatn(ji,jl) = zsnowmix_delta(ji)*(zsumheat(ji)/inlvls) + &
525 (1.0-zsnowmix_delta(ji))*zsnowheatn(ji,jl)
527 psnowdzn(ji,jl) = zsnowmix_delta(ji)*(psnow(ji)/inlvls) + &
528 (1.0-zsnowmix_delta(ji))*psnowdzn(ji,jl)
530 zsnowrhon(ji,jl) = zsnowmix_delta(ji)*(zsumswe(ji)/psnow(ji)) + &
531 (1.0-zsnowmix_delta(ji))*zsnowrhon(ji,jl)
533 zsnowagen(ji,jl) = zsnowmix_delta(ji)*(zsumage(ji)/inlvls) + &
534 (1.0-zsnowmix_delta(ji))*zsnowagen(ji,jl)
543 psnowdz(:,:) = psnowdzn(:,:)
544 psnowrho(:,:) = zsnowrhon(:,:)
545 psnowheat(:,:) = zsnowheatn(:,:)
546 psnowage(:,:) = zsnowagen(:,:)
548 IF (lhook) CALL dr_hook(
'SNOW3LTRANSF',1,zhook_handle)
576 USE yomhook
,ONLY : lhook, dr_hook
577 USE parkind1
,ONLY : jprb
583 REAL,
DIMENSION(: ),
INTENT(IN ) :: psnow
584 REAL,
DIMENSION(:,:),
INTENT(OUT) :: psnowdz
585 REAL,
DIMENSION(:,:),
INTENT(IN ),
OPTIONAL :: psnowdz_old
591 INTEGER :: inlvls, ini
593 REAL,
DIMENSION(SIZE(PSNOW)) :: zwork
595 LOGICAL ,
DIMENSION(SIZE(PSNOW)) :: gregrid
599 REAL,
PARAMETER,
DIMENSION(3) :: zsgcoef1 = (/0.25, 0.50, 0.25/)
600 REAL,
PARAMETER,
DIMENSION(2) :: zsgcoef2 = (/0.05, 0.34/)
602 REAL,
PARAMETER,
DIMENSION(3) :: zsgcoef = (/0.3, 0.4, 0.3/)
606 REAL,
PARAMETER :: zsnowtrans = 0.20
610 REAL,
PARAMETER :: zdz1=0.01
611 REAL,
PARAMETER :: zdz2=0.05
612 REAL,
PARAMETER :: zdz3=0.15
613 REAL,
PARAMETER :: zdz4=0.50
614 REAL,
PARAMETER :: zdz5=1.00
615 REAL,
PARAMETER :: zdzn0=0.02
616 REAL,
PARAMETER :: zdzn1=0.1
617 REAL,
PARAMETER :: zdzn2=0.5
618 REAL,
PARAMETER :: zdzn3=1.0
620 REAL,
PARAMETER :: zcoef1 = 0.5
621 REAL,
PARAMETER :: zcoef2 = 1.5
623 REAL(KIND=JPRB) :: zhook_handle
630 IF (lhook) CALL dr_hook(
'MODE_SNOW3L:SNOW3LGRID_2D',0,zhook_handle)
632 inlvls =
SIZE(psnowdz(:,:),2)
633 ini =
SIZE(psnowdz(:,:),1)
649 psnowdz(ji,1) = psnow(ji)
652 ELSEIF(inlvls == 3)
THEN
654 WHERE(psnow <= xsnowcritd+0.01)
655 psnowdz(:,1) = min(0.01, psnow(:)/inlvls)
656 psnowdz(:,3) = min(0.01, psnow(:)/inlvls)
657 psnowdz(:,2) = psnow(:) - psnowdz(:,1) - psnowdz(:,3)
660 WHERE(psnow <= zsnowtrans .AND. psnow > xsnowcritd+0.01)
661 psnowdz(:,1) = psnow(:)*zsgcoef1(1)
662 psnowdz(:,2) = psnow(:)*zsgcoef1(2)
663 psnowdz(:,3) = psnow(:)*zsgcoef1(3)
666 WHERE(psnow > zsnowtrans)
667 psnowdz(:,1) = zsgcoef2(1)
668 psnowdz(:,2) = (psnow(:)-zsgcoef2(1))*zsgcoef2(2) + zsgcoef2(1)
673 psnowdz(:,2) = min(10*zsgcoef2(1), psnowdz(:,2))
674 psnowdz(:,3) = psnow(:) - psnowdz(:,2) - psnowdz(:,1)
681 ELSEIF(inlvls == 6)
THEN
685 IF(present(psnowdz_old))
THEN
686 gregrid(:) = psnowdz_old(:,1) < zcoef1 * min(zdz1 ,psnow(:)/inlvls) .OR. &
687 & psnowdz_old(:,1) > zcoef2 * min(zdz1 ,psnow(:)/inlvls) .OR. &
688 & psnowdz_old(:,2) < zcoef1 * min(zdz2 ,psnow(:)/inlvls) .OR. &
689 & psnowdz_old(:,2) > zcoef2 * min(zdz2 ,psnow(:)/inlvls) .OR. &
690 & psnowdz_old(:,6) < zcoef1 * min(zdzn1,psnow(:)/inlvls) .OR. &
691 & psnowdz_old(:,6) > zcoef2 * min(zdzn1,psnow(:)/inlvls)
696 psnowdz(:,1) = min(zdz1,psnow(:)/inlvls)
697 psnowdz(:,2) = min(zdz2,psnow(:)/inlvls)
699 psnowdz(:,6) = min(zdzn1,psnow(:)/inlvls)
701 zwork(:) = psnow(:) - psnowdz(:,1) - psnowdz(:,2) - psnowdz(:,6)
702 psnowdz(:,3) = zwork(:)*zsgcoef(1)
703 psnowdz(:,4) = zwork(:)*zsgcoef(2)
704 psnowdz(:,5) = zwork(:)*zsgcoef(3)
706 zwork(:)=min(0.0,psnowdz(:,3)-psnowdz(:,2))
707 psnowdz(:,3)=psnowdz(:,3)-zwork(:)
708 psnowdz(:,4)=psnowdz(:,4)+zwork(:)
710 zwork(:)=min(0.0,psnowdz(:,5)-psnowdz(:,6))
711 psnowdz(:,5)=psnowdz(:,5)-zwork(:)
712 psnowdz(:,4)=psnowdz(:,4)+zwork(:)
718 ELSEIF(inlvls == 9)
THEN
722 IF(present(psnowdz_old))
THEN
723 gregrid(:) = psnowdz_old(:,1) < zcoef1 * min(zdz1 ,psnow(:)/inlvls) .OR. &
724 & psnowdz_old(:,1) > zcoef2 * min(zdz1 ,psnow(:)/inlvls) .OR. &
725 & psnowdz_old(:,2) < zcoef1 * min(zdz2 ,psnow(:)/inlvls) .OR. &
726 & psnowdz_old(:,2) > zcoef2 * min(zdz2 ,psnow(:)/inlvls) .OR. &
727 & psnowdz_old(:,9) < zcoef1 * min(zdzn0,psnow(:)/inlvls) .OR. &
728 & psnowdz_old(:,9) > zcoef2 * min(zdzn0,psnow(:)/inlvls)
733 psnowdz(:,1) = min(zdz1,psnow(:)/inlvls)
734 psnowdz(:,2) = min(zdz2,psnow(:)/inlvls)
735 psnowdz(:,3) = min(zdz3,psnow(:)/inlvls)
737 psnowdz(:,9)= min(zdzn0,psnow(:)/inlvls)
738 psnowdz(:,8)= min(zdzn1,psnow(:)/inlvls)
739 psnowdz(:,7)= min(zdzn2,psnow(:)/inlvls)
741 zwork(:) = psnow(:) - psnowdz(:, 1) - psnowdz(:, 2) - psnowdz(:, 3) &
742 - psnowdz(:, 7) - psnowdz(:, 8) - psnowdz(:, 9)
743 psnowdz(:,4) = zwork(:)*zsgcoef(1)
744 psnowdz(:,5) = zwork(:)*zsgcoef(2)
745 psnowdz(:,6) = zwork(:)*zsgcoef(3)
747 zwork(:)=min(0.0,psnowdz(:,4)-psnowdz(:,3))
748 psnowdz(:,4)=psnowdz(:,4)-zwork(:)
749 psnowdz(:,5)=psnowdz(:,5)+zwork(:)
751 zwork(:)=min(0.0,psnowdz(:,6)-psnowdz(:,7))
752 psnowdz(:,6)=psnowdz(:,6)-zwork(:)
753 psnowdz(:,5)=psnowdz(:,5)+zwork(:)
759 ELSEIF(inlvls == 12)
THEN
763 IF(present(psnowdz_old))
THEN
764 gregrid(:) = psnowdz_old(:, 1) < zcoef1 * min(zdz1 ,psnow(:)/inlvls) .OR. &
765 & psnowdz_old(:, 1) > zcoef2 * min(zdz1 ,psnow(:)/inlvls) .OR. &
766 & psnowdz_old(:, 2) < zcoef1 * min(zdz2 ,psnow(:)/inlvls) .OR. &
767 & psnowdz_old(:, 2) > zcoef2 * min(zdz2 ,psnow(:)/inlvls) .OR. &
768 & psnowdz_old(:,12) < zcoef1 * min(zdzn0,psnow(:)/inlvls) .OR. &
769 & psnowdz_old(:,12) > zcoef2 * min(zdzn0,psnow(:)/inlvls)
774 psnowdz(:,1) = min(zdz1,psnow(:)/inlvls)
775 psnowdz(:,2) = min(zdz2,psnow(:)/inlvls)
776 psnowdz(:,3) = min(zdz3,psnow(:)/inlvls)
777 psnowdz(:,4) = min(zdz4,psnow(:)/inlvls)
778 psnowdz(:,5) = min(zdz5,psnow(:)/inlvls)
780 psnowdz(:,12)= min(zdzn0,psnow(:)/inlvls)
781 psnowdz(:,11)= min(zdzn1,psnow(:)/inlvls)
782 psnowdz(:,10)= min(zdzn2,psnow(:)/inlvls)
783 psnowdz(:, 9)= min(zdzn3,psnow(:)/inlvls)
785 zwork(:) = psnow(:) - psnowdz(:, 1) - psnowdz(:, 2) - psnowdz(:, 3) &
786 - psnowdz(:, 4) - psnowdz(:, 5) - psnowdz(:, 9) &
787 - psnowdz(:,10) - psnowdz(:,11) - psnowdz(:,12)
788 psnowdz(:,6) = zwork(:)*zsgcoef(1)
789 psnowdz(:,7) = zwork(:)*zsgcoef(2)
790 psnowdz(:,8) = zwork(:)*zsgcoef(3)
792 zwork(:)=min(0.0,psnowdz(:,6)-psnowdz(:,5))
793 psnowdz(:,6)=psnowdz(:,6)-zwork(:)
794 psnowdz(:,7)=psnowdz(:,7)+zwork(:)
796 zwork(:)=min(0.0,psnowdz(:,8)-psnowdz(:,9))
797 psnowdz(:,8)=psnowdz(:,8)-zwork(:)
798 psnowdz(:,7)=psnowdz(:,7)+zwork(:)
804 ELSEIF(inlvls<10.AND.inlvls/=3.AND.inlvls/=6.AND.inlvls/=9)
THEN
808 psnowdz(ji,jj) = psnow(ji)/inlvls
812 psnowdz(:,inlvls) = psnowdz(:,inlvls) + (psnowdz(:,1) - min(0.05, psnowdz(:,1)))
813 psnowdz(:,1) = min(0.05, psnowdz(:,1))
819 IF(present(psnowdz_old))
THEN
820 gregrid(:) = psnowdz_old(:, 1) < zcoef1 * min(zdz1 ,psnow(:)/inlvls) .OR. &
821 & psnowdz_old(:, 1) > zcoef2 * min(zdz1 ,psnow(:)/inlvls) .OR. &
822 & psnowdz_old(:, 2) < zcoef1 * min(zdz2 ,psnow(:)/inlvls) .OR. &
823 & psnowdz_old(:, 2) > zcoef2 * min(zdz2 ,psnow(:)/inlvls) .OR. &
824 & psnowdz_old(:,inlvls) < zcoef1 * min(0.05*psnow(:),psnow(:)/inlvls) .OR. &
825 & psnowdz_old(:,inlvls) > zcoef2 * min(0.05*psnow(:),psnow(:)/inlvls)
829 psnowdz(:,1 ) = min(zdz1 ,psnow(:)/inlvls)
830 psnowdz(:,2 ) = min(zdz2 ,psnow(:)/inlvls)
831 psnowdz(:,3 ) = min(zdz3 ,psnow(:)/inlvls)
832 psnowdz(:,4 ) = min(zdz4 ,psnow(:)/inlvls)
833 psnowdz(:,5 ) = min(zdz5 ,psnow(:)/inlvls)
834 psnowdz(:,inlvls) = min(0.05*psnow(:),psnow(:)/inlvls)
840 zwork(ji) = psnowdz(ji,1)+psnowdz(ji,2)+psnowdz(ji,3)+psnowdz(ji,4)+psnowdz(ji,5)
841 psnowdz(ji,jj) = (psnow(ji)-zwork(ji)-psnowdz(ji,inlvls))/(inlvls-6)
850 IF(psnow(ji)==xundef)
THEN
851 psnowdz(ji,jj) = xundef
852 ELSEIF(.NOT.gregrid(ji))
THEN
853 psnowdz(ji,jj)=psnowdz_old(ji,jj)
858 IF (lhook) CALL dr_hook(
'MODE_SNOW3L:SNOW3LGRID_2D',1,zhook_handle)
862 SUBROUTINE snow3lcompactn(PTSTEP,PSNOWDZMIN,PSNOWRHO,PSNOWDZ,PSNOWTEMP,PSNOW,PSNOWLIQ)
878 xvvisc5,xvvisc6,xvro11
886 REAL,
INTENT(IN) :: ptstep
887 REAL,
INTENT(IN) :: psnowdzmin
889 REAL,
DIMENSION(:,:),
INTENT(IN) :: psnowtemp, psnowliq
891 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: psnowrho, psnowdz
893 REAL,
DIMENSION(:),
INTENT(OUT) :: psnow
903 REAL,
DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zsnowrho2, zviscocity, zf1, &
904 ztemp, zsmass, zsnowdz, &
908 REAL(KIND=JPRB) :: zhook_handle
915 IF (lhook) CALL dr_hook(
'SNOW3LCOMPACTN',0,zhook_handle)
917 ini =
SIZE(psnowdz(:,:),1)
918 inlvls =
SIZE(psnowdz(:,:),2)
920 zsnowrho2(:,:) = psnowrho(:,:)
921 zsnowdz(:,:) = max(psnowdzmin,psnowdz(:,:))
922 zviscocity(:,:) = 0.0
931 zsmass(ji,jj) = zsmass(ji,jj-1) + psnowdz(ji,jj-1)*psnowrho(ji,jj-1)
935 zsmass(:,1) = 0.5 * psnowdz(:,1) * psnowrho(:,1)
943 zwholdmax(:,:) = max(1.e-10, zwholdmax(:,:))
944 zf1(:,:) = 1.0/(xvvisc5+10.*min(1.0,psnowliq(:,:)/zwholdmax(:,:)))
951 IF(psnowrho(ji,jj) < xrhosmax_es)
THEN
954 ztemp(ji,jj) = xvvisc4*min(10.,abs(xtt-psnowtemp(ji,jj)))
957 zviscocity(ji,jj) = xvvisc1*zf1(ji,jj)*exp(xvvisc3*psnowrho(ji,jj)+ztemp(ji,jj))*psnowrho(ji,jj)/xvro11
960 zsnowrho2(ji,jj) = psnowrho(ji,jj) + psnowrho(ji,jj)*ptstep &
961 * ( (xg*zsmass(ji,jj)/zviscocity(ji,jj)) )
964 psnowdz(ji,jj) = psnowdz(ji,jj)*(psnowrho(ji,jj)/zsnowrho2(ji,jj))
979 psnow(ji) = psnow(ji) + psnowdz(ji,jj)
985 psnowrho(:,:) = zsnowrho2(:,:)
987 IF (lhook) CALL dr_hook(
'SNOW3LCOMPACTN',1,zhook_handle)
subroutine snow3lcompactn(PTSTEP, PSNOWDZMIN, PSNOWRHO, PSNOWDZ, PSNOWTEMP, PSNOW, PSNOWLIQ)
subroutine preps_for_meb_ebud_rad(PPS, PLAICV, PSNOWRHO, PSNOWSWE, PSNOWHEAT, PSNOWTEMP, PSNOWDZ, PSCOND, PHEATCAPS, PEMISNOW, PSIGMA_F, PCHIP, PTSTEP, PSR, PTA, PVMOD, PSNOWAGE, PPERMSNOWFRAC)
subroutine snow3lfall(PTSTEP, PSR, PTA, PVMOD, PSNOW, PSNOWRHO, PSNOWDZ, PSNOWHEAT, PSNOWHMASS, PSNOWAGE, PPERMSNOWFRAC)
subroutine snow3ltransf(PSNOW, PSNOWDZ, PSNOWDZN, PSNOWRHO, PSNOWHEAT, PSNOWAGE)