Skip to content

Commit

Permalink
Updating snow cloud fractions in MYNN-EDMF and removing redundant log…
Browse files Browse the repository at this point in the history 
…ic in sgscloud_radpre.F90
  • Loading branch information
@joeolson42
joeolson42 committed Oct 27, 2023
1 parent 4541893 commit dbfd4e6
Show file tree
Hide file tree
Showing 3 changed files with 32 additions and 28 deletions.
26 changes: 14 additions & 12 deletions physics/module_bl_mynn.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -519,7 +519,7 @@ SUBROUTINE mynn_bl_driver( &
real(kind_phys), dimension(kts:kte) :: &
&thl,tl,qv1,qc1,qi1,qs1,sqw, &
&el, dfm, dfh, dfq, tcd, qcd, pdk, pdt, pdq, pdc, &
&vt, vq, sgm
&vt, vq, sgm, kzero
real(kind_phys), dimension(kts:kte) :: &
&thetav,sh,sm,u1,v1,w1,p1, &
&ex1,dz1,th1,tk1,rho1,qke1,tsq1,qsq1,cov1, &
Expand Down Expand Up @@ -635,6 +635,7 @@ SUBROUTINE mynn_bl_driver( &
maxwidth(its:ite)=0.
maxmf(its:ite)=0.
maxKHtopdown(its:ite)=0.
kzero(kts:kte)=0.

! DH* CHECK HOW MUCH OF THIS INIT IF-BLOCK IS ACTUALLY NEEDED FOR RESTARTS
!> - Within the MYNN-EDMF, there is a dependecy check for the first time step,
Expand Down Expand Up @@ -743,7 +744,7 @@ SUBROUTINE mynn_bl_driver( &
!keep snow out for now - increases ceiling bias
sqw(k)=sqv(k)+sqc(k)+sqi(k)!+sqs(k)
thl(k)=th1(k) - xlvcp/ex1(k)*sqc(k) &
& - xlscp/ex1(k)*(sqi(k)+sqs(k))
& - xlscp/ex1(k)*(sqi(k))!+sqs(k))
!Use form from Tripoli and Cotton (1981) with their
!suggested min temperature to improve accuracy.
!thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) &
Expand Down Expand Up @@ -990,10 +991,10 @@ SUBROUTINE mynn_bl_driver( &
else
zw(k)=zw(k-1)+dz(i,k-1)
endif
!keep snow out for now - increases ceiling bias
!keep snow out for now - increases ceiling bias
sqw(k)= sqv(k)+sqc(k)+sqi(k)!+sqs(k)
thl(k)= th1(k) - xlvcp/ex1(k)*sqc(k) &
& - xlscp/ex1(k)*(sqi(k)+sqs(k))
& - xlscp/ex1(k)*(sqi(k))!+sqs(k))
!Use form from Tripoli and Cotton (1981) with their
!suggested min temperature to improve accuracy.
!thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) &
Expand Down Expand Up @@ -1223,9 +1224,9 @@ SUBROUTINE mynn_bl_driver( &
call mynn_tendencies(kts,kte,i, &
&delt, dz1, rho1, &
&u1, v1, th1, tk1, qv1, &
&qc1, qi1, qs1, qnc1, qni1, &
&qc1, qi1, kzero, qnc1, qni1, & !kzero replaces qs1 - not mixing snow
&ps(i), p1, ex1, thl, &
&sqv, sqc, sqi, sqs, sqw, &
&sqv, sqc, sqi, kzero, sqw, & !kzero replaces sqs - not mixing snow
&qnwfa1, qnifa1, qnbca1, ozone1, &
&ust(i),flt,flq,flqv,flqc, &
&wspd(i),uoce(i),voce(i), &
Expand Down Expand Up @@ -3850,11 +3851,11 @@ SUBROUTINE mym_condensation (kts,kte, &
q1(k) = qmq / sgm(k) ! Q1, the normalized saturation

!Add condition for falling/settling into low-RH layers, so at least
!some cloud fraction is applied for all qc and qi.
!some cloud fraction is applied for all qc, qs, and qi.
rh_hack= rh(k)
!ensure adequate RH & q1 when qi is at least 1e-9
if (qi(k)>1.e-9) then
rh_hack =min(1.0, rhcrit + 0.06*(9.0 + log10(qi(k))))
rh_hack =min(1.0, rhcrit + 0.07*(9.0 + log10(qi(k))))
rh(k) =max(rh(k), rh_hack)
!add rh-based q1
q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit)
Expand All @@ -3869,8 +3870,8 @@ SUBROUTINE mym_condensation (kts,kte, &
q1(k) =max(q1_rh, q1(k) )
endif
!ensure adequate RH & q1 when qs is at least 1e-7 (above the PBLH)
if (qs(k)>1.e-7 .and. zagl .gt. pblh2) then
rh_hack =min(1.0, rhcrit + 0.08*(7.0 + log10(qs(k))))
if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then
rh_hack =min(1.0, rhcrit + 0.07*(8.0 + log10(qs(k))))
rh(k) =max(rh(k), rh_hack)
!add rh-based q1
q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit)
Expand Down Expand Up @@ -4614,7 +4615,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, &
!============================================
! MIX SNOW ( sqs )
!============================================
IF (bl_mynn_cloudmix > 0 .AND. FLAG_QS) THEN
!hard-code to not mix snow
IF (bl_mynn_cloudmix > 0 .AND. .false.) THEN

k=kts
!rho-weighted:
Expand Down Expand Up @@ -4981,7 +4983,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, &
!===================
! CLOUD SNOW TENDENCY
!===================
IF (FLAG_QS) THEN
IF (.false.) THEN !disabled
DO k=kts,kte
Dqs(k)=(sqs2(k)/(1.-sqs2(k)) - qs(k))/delt
ENDDO
Expand Down
28 changes: 15 additions & 13 deletions physics/mynnedmf_wrapper.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -326,6 +326,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
integer :: idtend
real(kind_phys), dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1
real(kind_phys), allocatable :: save_qke_adv(:,:)
real(kind_phys), dimension(levs) :: kzero

! Initialize CCPP error handling variables
errmsg = ''
Expand Down Expand Up @@ -356,6 +357,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
!print*,"in MYNN, initflag=",initflag
endif

kzero = zero !generic zero array
!initialize arrays for test
EMIS_ANT_NO = 0.

Expand Down Expand Up @@ -392,7 +394,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
FLAG_QNI= .true.
FLAG_QC = .true.
FLAG_QNC= .true.
FLAG_QS = .false. !.true.
FLAG_QS = .true.
FLAG_QNWFA= nssl_ccn_on ! ERM: Perhaps could use this field for CCN field?
FLAG_QNIFA= .false.
FLAG_QNBCA= .false.
Expand All @@ -401,7 +403,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
sqv(i,k) = qgrs_water_vapor(i,k)
sqc(i,k) = qgrs_liquid_cloud(i,k)
sqi(i,k) = qgrs_ice(i,k)
sqs(i,k) = 0.0 !qgrs_snow(i,k)
sqs(i,k) = qgrs_snow(i,k)
ozone(i,k) = qgrs_ozone(i,k)
qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k)
qni(i,k) = qgrs_cloud_ice_num_conc(i,k)
Expand All @@ -419,7 +421,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
FLAG_QI = .true.
FLAG_QNI= .true.
FLAG_QC = .true.
FLAG_QS = .false.
FLAG_QS = .true. !pipe it in, but do not mix
FLAG_QNC= .true.
FLAG_QNWFA= .true.
FLAG_QNIFA= .true.
Expand All @@ -429,7 +431,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
sqv(i,k) = qgrs_water_vapor(i,k)
sqc(i,k) = qgrs_liquid_cloud(i,k)
sqi(i,k) = qgrs_ice(i,k)
sqs(i,k) = 0. !qgrs_snow(i,k)
sqs(i,k) = qgrs_snow(i,k)
qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k)
qni(i,k) = qgrs_cloud_ice_num_conc(i,k)
ozone(i,k) = qgrs_ozone(i,k)
Expand All @@ -442,7 +444,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
FLAG_QI = .true.
FLAG_QNI= .true.
FLAG_QC = .true.
FLAG_QS = .false.
FLAG_QS = .true.
FLAG_QNC= .true.
FLAG_QNWFA= .false.
FLAG_QNIFA= .false.
Expand All @@ -452,7 +454,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
sqv(i,k) = qgrs_water_vapor(i,k)
sqc(i,k) = qgrs_liquid_cloud(i,k)
sqi(i,k) = qgrs_ice(i,k)
sqs(i,k) = 0. !qgrs_snow(i,k)
sqs(i,k) = qgrs_snow(i,k)
qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k)
qni(i,k) = qgrs_cloud_ice_num_conc(i,k)
ozone(i,k) = qgrs_ozone(i,k)
Expand All @@ -465,7 +467,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
FLAG_QI = .true.
FLAG_QNI= .true.
FLAG_QC = .true.
FLAG_QS = .false.
FLAG_QS = .true.
FLAG_QNC= .false.
FLAG_QNWFA= .false.
FLAG_QNIFA= .false.
Expand All @@ -475,7 +477,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
sqv(i,k) = qgrs_water_vapor(i,k)
sqc(i,k) = qgrs_liquid_cloud(i,k)
sqi(i,k) = qgrs_ice(i,k)
sqs(i,k) = 0. !qgrs_snow(i,k)
sqs(i,k) = qgrs_snow(i,k)
qnc(i,k) = 0.
qni(i,k) = qgrs_cloud_ice_num_conc(i,k)
ozone(i,k) = qgrs_ozone(i,k)
Expand Down Expand Up @@ -566,7 +568,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
call moisture_check2(levs, delt, &
delp(i,:), exner(i,:), &
sqv(i,:), sqc(i,:), &
sqi(i,:), sqs(i,:), &
sqi(i,:), kzero(:), &
t3d(i,:) )
enddo

Expand Down Expand Up @@ -835,7 +837,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k)
dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k))
dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k)
dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k))
dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k))
!dqdt_ozone(i,k) = 0.0
dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k)
dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k)
Expand Down Expand Up @@ -870,7 +872,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k)
dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k))
dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k)
dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k))
dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k))
enddo
enddo
if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then
Expand All @@ -888,7 +890,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k))
dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k))
dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k)
dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k))
dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k))
!dqdt_ozone(i,k) = 0.0
enddo
enddo
Expand Down Expand Up @@ -918,7 +920,7 @@ SUBROUTINE mynnedmf_wrapper_run( &
dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k)
dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k))
dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k)
!dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k))
dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k))
IF ( nssl_ccn_on ) THEN !
dqdt_cccn(i,k) = RQNWFABLTEN(i,k)
ENDIF
Expand Down
6 changes: 3 additions & 3 deletions physics/sgscloud_radpre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -216,10 +216,10 @@ subroutine sgscloud_radpre_run( &
qi(i,k) = ice_frac*qi_bl(i,k)

!eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b)
if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.)
clouds5(i,k)=max(173.45 + 2.14*Tc, 20.)
!eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 8b)
!iwc = qi(i,k)*1.0e6*rho(i,k)
!IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.)
!clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.)

!calculate the ice water path using additional BL clouds
clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k))
Expand All @@ -229,7 +229,7 @@ subroutine sgscloud_radpre_run( &
qs(i,k) = snow_frac*qi_bl(i,k)

!eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b)
if(qs(i,k)>1.E-8)clouds9(i,k)=max(2.*(173.45 + 2.14*Tc), 50.)
clouds9(i,k)=max(2.*(173.45 + 2.14*Tc), 50.)

!calculate the snow water path using additional BL clouds
clouds8(i,k) = max(0.0, qs(i,k) * gfac * delp(i,k))
Expand Down

0 comments on commit dbfd4e6

Please sign in to comment.