Skip to content

Commit

Permalink
Added ability to provide cloudy profile to radiation (RRTMG and RRTMGP).
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Apr 16, 2019
1 parent 80e70c1 commit 9414a90
Show file tree
Hide file tree
Showing 4 changed files with 918 additions and 785 deletions.
122 changes: 97 additions & 25 deletions physics/GFS_rrtmg_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ module GFS_rrtmg_pre
!! \section arg_table_GFS_rrtmg_pre_init Argument Table
!!
subroutine GFS_rrtmg_pre_init ()
open(58,file='GFS_rrtmg_aux_dump.txt',status='unknown')
end subroutine GFS_rrtmg_pre_init

!> \section arg_table_GFS_rrtmg_pre_run Argument Table
Expand Down Expand Up @@ -205,6 +206,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, &
cldcov, deltaq, cnvc, cnvw, &
effrl, effri, effrr, effrs
real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, tem1, tem2, tem3
real (kind=kind_phys), parameter :: xrc3 = 100.

real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db
! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: hz
Expand Down Expand Up @@ -640,31 +643,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
enddo
endif
!
if (Model%uni_cld) then
if (Model%effr_in) then
do k=1,lm
k1 = k + kd
do i=1,im
cldcov(i,k1) = Tbd%phy_f3d(i,k,Model%indcld)
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)
effrs(i,k1) = Tbd%phy_f3d(i,k,5)
enddo
enddo
else
do k=1,lm
k1 = k + kd
do i=1,im
cldcov(i,k1) = Tbd%phy_f3d(i,k,Model%indcld)
enddo
enddo
endif
elseif (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL MP
cldcov(1:IM,1+kd:LM+kd) = tracer1(1:IM,1:LM,Model%ntclamt)
else ! neither of the other two cases
cldcov = 0.0
endif

!
! --- add suspended convective cloud water to grid-scale cloud water
Expand Down Expand Up @@ -722,6 +700,90 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
ccnd(1:IM,1:LMK,1) = ccnd(1:IM,1:LMK,1) + cnvw(1:IM,1:LMK)
endif

if (Model%imp_physics == 10) then
ccnd(1:IM,1:LMK,1) = ccnd(1:IM,1:LMK,1) + cnvw(1:IM,1:LMK) + ccnd(1:IM,1:LMK,2)
endif

! DJS2019: START
! Compute layer cloud fraction.
clwmin = 0.0
if (.not. Model%lmfshal) then
do k = 1, LMK
do i = 1, IM
clwt = 1.0e-6 * (plyr(i,k)*0.001)
if (ccnd(i,k,1) > 0.) then
onemrh= max( 1.e-10, 1.0-rhly(i,k) )
clwm = clwmin / max( 0.01, plyr(i,k)*0.001 )
tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0)
tem1 = 2000.0 / tem1
value = max( min( tem1*(ccnd(i,k,1)-clwm), 50.0 ), 0.0 )
tem2 = sqrt( sqrt(rhly(i,k)) )
cldcov(i,k) = max( tem2*(1.0-exp(-value)), 0.0 )
endif
enddo
enddo
else
do k = 1, LMK
do i = 1, IM
clwt = 1.0e-6 * (plyr(i,k)*0.001)
if (ccnd(i,k,1) > 0.) then
onemrh= max( 1.e-10, 1.0-rhly(i,k) )
clwm = clwmin / max( 0.01, plyr(i,k)*0.001 )
tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan
if (Model%lmfdeep2) then
tem1 = xrc3 / tem1
else
tem1 = 100.0 / tem1
endif
value = max( min( tem1*(ccnd(i,k,1)-clwm), 50.0 ), 0.0 )
tem2 = sqrt( sqrt(rhly(i,k)) )
cldcov(i,k) = max( tem2*(1.0-exp(-value)), 0.0 )
endif
enddo
enddo
endif
! DJS2019: END

if (Model%uni_cld) then
if (Model%effr_in) then
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)
effrs(i,k1) = Tbd%phy_f3d(i,k,5)
enddo
enddo
else
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)
!if (tracer1(i,k,ntcw) .gt. 0 .or. tracer1(i,k,ntiw) .gt. 0) then
! cldcov(i,k1) = 0.1
!else
! cldcov(i,k1) = 0.0
!endif
enddo
enddo
endif
elseif (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL MP
cldcov(1:IM,1+kd:LM+kd) = tracer1(1:IM,1:LM,Model%ntclamt)
else ! neither of the other two cases
!cldcov = 0.0
endif

write(58,*) "Model%imp_physics: ",Model%imp_physics
write(58,*) "Model%uni_cld: ",Model%uni_cld
write(58,*) "Model%ncld: ",Model%ncld
write(58,*) "Model%lgfdlmprad: ",Model%lgfdlmprad
write(58,*) "Model%lmfshal: ",Model%lmfshal
write(58,*) "Model%lmfdeep2: ",Model%lmfdeep2

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 All @@ -736,6 +798,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs
ccnd(1:IM,1:LMK,1), Grid%xlat,Grid%xlon, &
Sfcprop%slmsk, dz, delp, IM, LMK, LMP, &
!DJS2019: Pass uni_cld=true to use prescribed cloud-cover amount
! .true., Model%lmfshal, &
Model%uni_cld, Model%lmfshal, &
Model%lmfdeep2, cldcov, &
effrl, effri, effrr, effrs, Model%effr_in, &
Expand Down Expand Up @@ -812,6 +876,13 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
enddo
enddo

write(58,*) "#"
do k=1,Model%levr+LTP
write(58,"(5F10.3)") plyr(1,k),tlyr(1,k),clouds2(1,k), &
& clouds4(1,k), clouds1(1,k)
enddo


! mg, sfc-perts
! --- scale random patterns for surface perturbations with
! perturbation size
Expand All @@ -831,6 +902,7 @@ end subroutine GFS_rrtmg_pre_run
!> \section arg_table_GFS_rrtmg_pre_finalize Argument Table
!!
subroutine GFS_rrtmg_pre_finalize ()
close(58)
end subroutine GFS_rrtmg_pre_finalize

!! @}
Expand Down
22 changes: 20 additions & 2 deletions physics/radlw_main.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -354,6 +354,9 @@ module rrtmg_lw
! ================
subroutine rrtmg_lw_init ()
open(59,file='rrtmg_aux_dump.txt',status='unknown')
open(60,file='rrtmg_aux_tautot.txt',status='unknown')
open(61,file='rrtmg_aux_taucld.txt',status='unknown')
end subroutine rrtmg_lw_init
!> \defgroup module_radlw_main GFS radlw Main
Expand Down Expand Up @@ -1286,14 +1289,28 @@ subroutine rrtmg_lw_run &
endif
endif ! if_ivflip
write(59,*) "#"
write(60,*) "#"
do j=1,nLay
write(59,"(9F10.3)") plyr(1,j),tlyr(1,j),cld_lwp(1,j), &
& cld_iwp(1,j), cld_cf(1,j), sum(totuclfl(j-1:j))/2., &
& sum(totdclfl(j-1:j))/2., sum(totuflux(j-1:j))/2., &
& sum(totdflux(j-1:j))/2.
write(60,*) tautot(:,j)
write(61,*) taucld(:,j)
enddo
enddo lab_do_iplon
!...................................
end subroutine rrtmg_lw_run
!-----------------------------------
!> @}
subroutine rrtmg_lw_finalize ()
close(59)
close(60)
close(61)
end subroutine rrtmg_lw_finalize
Expand Down Expand Up @@ -1725,6 +1742,7 @@ subroutine cldprop &
do ib = 1, nbands
tauliq(ib) = max(f_zero, cldliq*(absliq1(index,ib) &
& + fint*(absliq1(index+1,ib)-absliq1(index,ib)) ))

enddo
endif ! end if_ilwcliq_block
endif ! end if_cldliq_block
Expand Down Expand Up @@ -1784,7 +1802,7 @@ subroutine cldprop &
endif ! end if_cldice_block
do ib = 1, nbands
taucld(ib,k) = tauice(ib) + tauliq(ib) + tauran + tausnw
taucld(ib,k) = tauice(ib) + tauliq(ib) + tauran + tausnw
enddo
endif lab_if_cld
Expand Down
Loading

0 comments on commit 9414a90

Please sign in to comment.