Skip to content

Commit

Permalink
LW working
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Apr 30, 2024
1 parent cc92ab7 commit 5b30fd1
Show file tree
Hide file tree
Showing 3 changed files with 93 additions and 15 deletions.
93 changes: 85 additions & 8 deletions physics/Radiation/RRTMG/radlw_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -659,7 +659,7 @@ subroutine rrtmg_lw_run &
& intent(inout) :: flxprf

! --- locals:
real (kind=kind_phys), dimension(0:nlp1) :: cldfrc
real (kind=kind_phys), dimension(0:nlp1) :: cldfrc, cldfrc_cnv

real (kind=kind_phys), dimension(0:nlay) :: totuflux, totdflux, &
& totuclfl, totdclfl, tz
Expand All @@ -670,7 +670,7 @@ subroutine rrtmg_lw_run &
& clwp, ciwp, relw, reiw, cda1, cda2, cda3, cda4, &
& coldry, colbrd, h2ovmr, o3vmr, fac00, fac01, fac10, fac11, &
& selffac, selffrac, forfac, forfrac, minorfrac, scaleminor, &
& scaleminorn2, temcol, dz, cda5, cda6, cda7, cda8, cldfrc_cnv
& scaleminorn2, temcol, dz, cda5, cda6, cda7, cda8

real (kind=kind_phys), dimension(nbands,0:nlay) :: pklev, pklay

Expand Down Expand Up @@ -914,7 +914,9 @@ subroutine rrtmg_lw_run &

cldfrc(0) = f_one ! padding value only
cldfrc(nlp1) = f_zero ! padding value only

cldfrc_cnv(0) = f_one
cldfrc_cnv(nlp1) = f_zero

!> -# Compute precipitable water vapor for diffusivity angle adjustments.

tem1 = f_zero
Expand Down Expand Up @@ -1010,6 +1012,12 @@ subroutine rrtmg_lw_run &
cda2(k) = cld_ref_rain(iplon,k)
cda3(k) = cld_swp(iplon,k)
cda4(k) = cld_ref_snow(iplon,k)
! Radiatively active convective cloud?
cda5(k) = cld_cnv_lwp(iplon,k)
cda6(k) = cld_cnv_reliq(iplon,k)
cda7(k) = cld_cnv_iwp(iplon,k)
cda8(k) = cld_cnv_reice(iplon,k)
cldfrc_cnv(k) = cld_cnv_frac(iplon,k)
enddo
else ! use diagnostic cloud method
do k = 1, nlay
Expand All @@ -1021,6 +1029,8 @@ subroutine rrtmg_lw_run &
cldfrc(0) = f_one ! padding value only
cldfrc(nlp1) = f_zero ! padding value only

cldfrc_cnv(0) = f_one
cldfrc_cnv(nlp1) = f_zero
! --- ... compute precipitable water vapor for diffusivity angle adjustments

tem1 = f_zero
Expand Down Expand Up @@ -1649,10 +1659,10 @@ subroutine cldprop &
integer, intent(in) :: nlay, nlp1, ipseed, iovr, ilwcliq, ilwcice,&
isubclw

real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac
real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac,cnv_cfrac
real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, &
& reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz, &
& cnv_cfrac, cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice
& cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice
real (kind=kind_phys), intent(in) :: de_lgth
real (kind=kind_phys), dimension(nlay), intent(in) :: alpha

Expand Down Expand Up @@ -1797,10 +1807,77 @@ subroutine cldprop &
do ib = 1, nbands
taucld(ib,k) = tauice(ib) + tauliq(ib) + tauran + tausnw
enddo
write(*,'(a10,i5,5f15.8)') 'cloudmp - ',k,cfrac(k),cliqp(k),reliq(k),cicep(k),reice(k)
endif lab_if_cld
lab_if_cnvcld : if (cnv_cfrac(k) > cldmin) then
write(*,'(a10,i5,5f15.8)') 'cloudcnv - ',k,cnv_cfrac(k),cnv_cliqp(k),cnv_reliq(k),cnv_cicep(k),cnv_reice(k)
! #####################################################################################
!
! Do we have any convective clouds in this layer?
! If so,
! - Compute cloud-optical properties using the convective condensate, and assumed size.
! - Add radiative contribution from convective cloud to total cloud radiative properties.
!
! #####################################################################################
lab_if_cnvcld : if (cnv_cliqp(k)+cnv_cliqp(k) > 0._kind_phys) then
! calculation of absorption coefficients due to convective water clouds.
if ( cnv_cliqp(k) <= f_zero ) then
do ib = 1, nbands
tauliq(ib) = f_zero
enddo
else
if ( ilwcliq == 1 ) then
factor = cnv_reliq(k) - 1.5
index = max( 1, min( 57, int( factor ) ))
fint = factor - float(index)
do ib = 1, nbands
tauliq(ib) = max(f_zero, cnv_cliqp(k)*(absliq1(index,ib) + fint*(absliq1(index+1,ib)-absliq1(index,ib)) ))
enddo
endif ! end if_ilwcliq_block
endif ! end if_cldliq_block

! calculation of absorption coefficients due to ice clouds.
if ( cnv_cicep(k) <= f_zero ) then
do ib = 1, nbands
tauice(ib) = f_zero
enddo
else
! ebert and curry approach for all particle sizes though somewhat
! unjustified for large ice particles
if ( ilwcice == 1 ) then
refice = min(130.0, max(13.0, real(cnv_reice(k)) ))

do ib = 1, nbands
ia = ipat(ib) ! eb_&_c band index for ice cloud coeff
tauice(ib) = max(f_zero, cnv_cicep(k)*(absice1(1,ia) + absice1(2,ia)/refice) )
enddo

! streamer approach for ice effective radius between 5.0 and 131.0 microns
! and ebert and curry approach for ice eff radius greater than 131.0 microns.
! no smoothing between the transition of the two methods.
elseif ( ilwcice == 2 ) then
factor = (cnv_reice(k) - 2.0) / 3.0
index = max( 1, min( 42, int( factor ) ))
fint = factor - float(index)

do ib = 1, nbands
tauice(ib) = max(f_zero, cnv_cicep(k)*(absice2(index,ib) + fint*(absice2(index+1,ib) - absice2(index,ib)) ))
enddo

! fu's approach for ice effective radius between 4.8 and 135 microns
! (generalized effective size from 5 to 140 microns)
elseif ( ilwcice == 3 ) then
dgeice = max(5.0, 1.0315*cnv_reice(k))
factor = (dgeice - 2.0) / 3.0
index = max( 1, min( 45, int( factor ) ))
fint = factor - float(index)

do ib = 1, nbands
tauice(ib) = max(f_zero, cnv_cicep(k)*(absice3(index,ib) + fint*(absice3(index+1,ib) - absice3(index,ib)) ))
enddo
endif ! end if_ilwcice_block
endif ! end if_cnv_cicep_block
!
do ib = 1, nbands
taucld(ib,k) = taucld(ib,k) + tauice(ib) + tauliq(ib)
enddo
endif lab_if_cnvcld
enddo lab_do_k

Expand Down
8 changes: 5 additions & 3 deletions physics/Radiation/radiation_cloud_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -52,11 +52,12 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs
relhum, & ! Relative-humidity (1)
cnv_mixratio ! Convective cloud mixing-ratio (kg/kg)
! Outputs
real(kind_phys), dimension(:,:),intent(inout) :: &
real(kind_phys), dimension(:,:),intent(out) :: &
cld_cnv_lwp, & ! Convective cloud liquid water path
cld_cnv_reliq, & ! Convective cloud liquid effective radius
cld_cnv_iwp, & ! Convective cloud ice water path
cld_cnv_reice, & ! Convective cloud ice effecive radius
cld_cnv_reice ! Convective cloud ice effecive radius
real(kind_phys), dimension(:,:),intent(inout) :: &
cld_cnv_frac ! Convective cloud-fraction
! Local
integer :: iCol, iLay
Expand All @@ -72,7 +73,7 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs
clwc = max(0.0, cnv_mixratio(iCol,iLay)) * tem0 * deltaP
cld_cnv_iwp(iCol,iLay) = clwc * tem1
cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay)

! Assign particles size(s).
if (cmp_Re) then
! do something here a bit more fancy?
Expand All @@ -89,6 +90,7 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs
else
! Otherwise, cloud-fraction from convection scheme will pass through and
! be used by the radiation.
!cld_cnv_frac(iCol,iLay) = 1._kind_phys
endif
endif ! No juice.
enddo ! Columns
Expand Down
7 changes: 3 additions & 4 deletions physics/Radiation/radiation_clouds.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2122,11 +2122,10 @@ subroutine progcld_thompson_wsm6 &
! clwf(i,k) = clw(i,k)
! enddo
! enddo
! endif
! endif
!> - Include grid-mean suspended cloud condensate in Xu-Randall cloud fraction
!> if xr_cnvcld is true:
if(xr_cnvcld)then
do k = 1, NLAY
do i = 1, IX
Expand All @@ -2142,7 +2141,7 @@ subroutine progcld_thompson_wsm6 &
enddo
enddo
endif
!> - Compute total-cloud liquid/ice condensate path in \f$ g/m^2 \f$.
!> The total condensate includes convective condensate.
do k = 1, NLAY-1
Expand Down

0 comments on commit 5b30fd1

Please sign in to comment.