Skip to content

Commit

Permalink
LW RRTMGP cloud-optics working. Also, RRTMGP cloud sampling has been …
Browse files Browse the repository at this point in the history
…implemented (in progress).
  • Loading branch information
dustinswales committed Apr 29, 2019
1 parent 67c2e26 commit 3c861b0
Show file tree
Hide file tree
Showing 5 changed files with 711 additions and 91 deletions.
8 changes: 6 additions & 2 deletions physics/GFS_rrtmg_pre.F90
Original file line number Diff line number Diff line change
Expand Up @@ -707,6 +707,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
! DJS2019: START
! Compute layer cloud fraction.
clwmin = 0.0
cldcov(:,:) = 0.0
if (.not. Model%lmfshal) then
do k = 1, LMK
do i = 1, IM
Expand Down Expand Up @@ -749,9 +750,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
do k=1,lm
k1 = k + kd
do i=1,im
! DJS2019: Tbd%phy_f3d(:,:,1) is mean layer temperature, not cloud amount
cldcov(i,k1) = Tbd%phy_f3d(i,k,Model%indcld)
cldcov(i,k1) = tracer1(i,k,Model%ntclamt)
effrl(i,k1) = Tbd%phy_f3d(i,k,2)
effri(i,k1) = Tbd%phy_f3d(i,k,3)
effrr(i,k1) = Tbd%phy_f3d(i,k,4)
Expand Down Expand Up @@ -784,6 +783,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
write(58,*) "Model%lgfdlmprad: ",Model%lgfdlmprad
write(58,*) "Model%lmfshal: ",Model%lmfshal
write(58,*) "Model%lmfdeep2: ",Model%lmfdeep2
do k = 1, LMK
do i = 1, IM
write(58,'(a19,2i8,f10.2)') " Cloud-cover: ",k,i,cldcov(i,k)
end do
enddo

if (Model%imp_physics == 99 .or. Model%imp_physics == 10) then ! zhao/moorthi's prognostic cloud scheme
! or unified cloud and/or with MG microphysics
Expand Down
13 changes: 7 additions & 6 deletions physics/rrtmgp_lw_cloud_optics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -573,7 +573,7 @@ subroutine rrtmgp_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cl
cld_ref_snow ! Effective radius (snow-flake) (micron)

! Outputs
real(kind_phys),dimension(nBandsLW,ncol,nlay),intent(out) :: &
real(kind_phys),dimension(ncol,nlay,nBandsLW),intent(out) :: &
tau_cld

! Local variables
Expand Down Expand Up @@ -654,7 +654,7 @@ subroutine rrtmgp_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cl
endif
! Cloud optical depth
do ib = 1, nBandsLW
tau_cld(ib,ij,ik) = tau_ice(ib) + tau_liq(ib) + tau_rain + tau_snow
tau_cld(ij,ik,ib) = tau_ice(ib) + tau_liq(ib) + tau_rain + tau_snow
enddo
end do
end do
Expand All @@ -677,7 +677,8 @@ subroutine mcica_subcol_lw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth,
cld_frac, & ! Cloud-fraction
dzlyr ! Layer thinkness (km)
! Outputs
real(kind_phys),dimension(ngpts,ncol,nlay),intent(out) :: &
!real(kind_phys),dimension(ncol,nlay,ngpts),intent(out) :: &
logical,dimension(ncol,nlay,ngpts),intent(out) :: &
cld_frac_mcica
! Local variables
type(random_stat) :: stat
Expand Down Expand Up @@ -800,16 +801,16 @@ subroutine mcica_subcol_lw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth,
end select

! ###################################################################################
! Generate subcolumn cloud mask (0/1 for clear/cloudy)
! Generate subcolumn cloud mask (.false./.true. for clear/cloudy)
! ###################################################################################
do k = 1, nlay
tem1 = 1._kind_phys - cld_frac(icol,k)
do n = 1, ngpts
lcloudy(n,k) = cdfunc(n,k) >= tem1
if (lcloudy(n,k)) then
cld_frac_mcica(n,icol,k) = 1._kind_phys
cld_frac_mcica(icol,k,n) = .true.
else
cld_frac_mcica(n,icol,k) = 0._kind_phys
cld_frac_mcica(icol,k,n) = .false.
endif
enddo
enddo
Expand Down
Loading

0 comments on commit 3c861b0

Please sign in to comment.