Skip to content

Commit

Permalink
updated the radiation code based on review's suggestions
Browse files Browse the repository at this point in the history
  • Loading branch information
Qingfu-Liu committed Feb 22, 2022
1 parent 0ea0fd0 commit 242dcc9
Show file tree
Hide file tree
Showing 8 changed files with 630 additions and 1,453 deletions.
124 changes: 27 additions & 97 deletions physics/GFS_cloud_diagnostics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -46,44 +46,44 @@ subroutine GFS_cloud_diagnostics_run(nCol, nLev, iovr_rand, iovr_maxrand, iovr_m
implicit none

! Inputs
integer, intent(in) :: &
nCol, & ! Number of horizontal grid-points
nLev ! Number of vertical-layers
integer, intent(in) :: &
integer, intent(in) :: &
nCol, & ! Number of horizontal grid-points
nLev ! Number of vertical-layers
integer, intent(in) :: &
iovr_rand, & ! Flag for random cloud overlap method
iovr_maxrand, & ! Flag for maximum-random cloud overlap method
iovr_max, & ! Flag for maximum cloud overlap method
iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method
iovr_exp, & ! Flag for exponential cloud overlap method
iovr_exprand ! Flag for exponential-random cloud overlap method
logical, intent(in) :: &
lsswr, & ! Call SW radiation?
lslwr ! Call LW radiation
real(kind_phys), intent(in) :: &
con_pi ! Physical constant: pi
real(kind_phys), dimension(:), intent(in) :: &
lat, & ! Latitude
de_lgth ! Decorrelation length
lsswr, & ! Call SW radiation?
lslwr ! Call LW radiation
real(kind_phys), intent(in) :: &
con_pi ! Physical constant: pi
real(kind_phys), dimension(:), intent(in) :: &
lat, & ! Latitude
de_lgth ! Decorrelation length
real(kind_phys), dimension(:,:), intent(in) :: &
p_lay, & ! Pressure at model-layer
cld_frac ! Total cloud fraction
p_lay, & ! Pressure at model-layer
cld_frac ! Total cloud fraction
real(kind_phys), dimension(:,:), intent(in) :: &
p_lev ! Pressure at model interfaces
p_lev ! Pressure at model interfaces
real(kind_phys), dimension(:,:), intent(in) :: &
deltaZ, & ! Layer thickness (km)
cloud_overlap_param, & ! Cloud-overlap parameter
precip_overlap_param ! Precipitation overlap parameter
deltaZ, & ! Layer thickness (km)
cloud_overlap_param, & ! Cloud-overlap parameter
precip_overlap_param ! Precipitation overlap parameter

! Outputs
character(len=*), intent(out) :: &
errmsg ! Error message
integer, intent(out) :: &
errflg ! Error flag
integer,dimension(:,:),intent(out) :: &
mbota, & ! Vertical indices for cloud tops
mtopa ! Vertical indices for cloud bases
real(kind_phys), dimension(:,:), intent(out) :: &
cldsa ! Fraction of clouds for low, middle, high, total and BL
character(len=*), intent(out) :: &
errmsg ! Error message
integer, intent(out) :: &
errflg ! Error flag
integer,dimension(:,:),intent(out) :: &
mbota, & ! Vertical indices for cloud tops
mtopa ! Vertical indices for cloud bases
real(kind_phys),dimension(:,:), intent(out) :: &
cldsa ! Fraction of clouds for low, middle, high, total and BL

! Local variables
integer i,id,iCol,iLay,icld
Expand Down Expand Up @@ -125,76 +125,6 @@ subroutine GFS_cloud_diagnostics_finalize()
end subroutine GFS_cloud_diagnostics_finalize

! ######################################################################################
! Initialization routine for High/Mid/Low cloud diagnostics.
! Subroutine hml_cloud_diagnostics_initialize is removed (refer to GFS_rrtmgp_setup.F90)
! ######################################################################################
subroutine hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, &
imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, &
imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, nLev, &
mpi_rank, sigmainit, errflg)
implicit none
! Inputs
integer, intent(in) :: &
imp_physics, & ! Flag for MP scheme
imp_physics_fer_hires, & ! Flag for fer-hires scheme
imp_physics_gfdl, & ! Flag for gfdl scheme
imp_physics_thompson, & ! Flag for thompsonscheme
imp_physics_wsm6, & ! Flag for wsm6 scheme
imp_physics_zhao_carr, & ! Flag for zhao-carr scheme
imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme
imp_physics_mg ! Flag for MG scheme
integer, intent(in) :: &
nLev, & ! Number of vertical-layers
mpi_rank
real(kind_phys), dimension(:), intent(in) :: &
sigmainit
! Outputs
integer, intent(out) :: &
errflg

! Local variables
integer :: iLay, kl

! Initialize error flag
errflg = 0

if (mpi_rank == 0) print *, VTAGCLD !print out version tag

if ( icldflg == 0 ) then
print *,' - Diagnostic Cloud Method has been discontinued'
errflg = 1
else
if (mpi_rank == 0) then
print *,' - Using Prognostic Cloud Method'
if (imp_physics == imp_physics_zhao_carr) then
print *,' --- Zhao/Carr/Sundqvist microphysics'
elseif (imp_physics == imp_physics_zhao_carr_pdf) then
print *,' --- zhao/carr/sundqvist + pdf cloud'
elseif (imp_physics == imp_physics_gfdl) then
print *,' --- GFDL Lin cloud microphysics'
elseif (imp_physics == imp_physics_thompson) then
print *,' --- Thompson cloud microphysics'
elseif (imp_physics == imp_physics_wsm6) then
print *,' --- WSM6 cloud microphysics'
elseif (imp_physics == imp_physics_mg) then
print *,' --- MG cloud microphysics'
elseif (imp_physics == imp_physics_fer_hires) then
print *,' --- Ferrier-Aligo cloud microphysics'
else
print *,' !!! ERROR in cloud microphysc specification!!!', &
' imp_physics (NP3D) =',imp_physics
errflg = 1
endif
endif
endif

! Compute the top of BL cld (llyr), which is the topmost non cld(low) layer for
! stratiform (at or above lowest 0.1 of the atmosphere).
lab_do_k0 : do iLay = nLev, 2, -1
kl = iLay
if (sigmainit(iLay) < 0.9e0) exit lab_do_k0
enddo lab_do_k0
llyr = kl

return
end subroutine hml_cloud_diagnostics_initialize
end module GFS_cloud_diagnostics
29 changes: 15 additions & 14 deletions physics/GFS_rrtmgp_cloud_overlap_pre.F90
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
module GFS_rrtmgp_cloud_overlap_pre
use machine, only: kind_phys
use radiation_tools, only: check_error_msg
use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp
use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exper

public GFS_rrtmgp_cloud_overlap_pre_init, GFS_rrtmgp_cloud_overlap_pre_run, GFS_rrtmgp_cloud_overlap_pre_finalize

Expand Down Expand Up @@ -149,24 +149,25 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra
! Cloud overlap parameter
!
if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then
call get_alpha_exp(nCol, nLev, deltaZc, de_lgth, cloud_overlap_param)
call get_alpha_exper(nCol, nLev, iovr, iovr_exprand, deltaZc, &
de_lgth, cld_frac, cloud_overlap_param)
else
de_lgth(:) = 0.
cloud_overlap_param(:,:) = 0.
endif

! For exponential random overlap...
! Decorrelate layers when a clear layer follows a cloudy layer to enforce
! random correlation between non-adjacent blocks of cloudy layers
if (iovr == iovr_exprand) then
do iLay = 1, nLev
do iCol = 1, nCol
if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then
cloud_overlap_param(iCol,iLay) = 0._kind_phys
endif
enddo
enddo
endif
! ! For exponential random overlap...
! ! Decorrelate layers when a clear layer follows a cloudy layer to enforce
! ! random correlation between non-adjacent blocks of cloudy layers
! if (iovr == iovr_exprand) then
! do iLay = 1, nLev
! do iCol = 1, nCol
! if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then
! cloud_overlap_param(iCol,iLay) = 0._kind_phys
! endif
! enddo
! enddo
! endif

!
! Compute precipitation overlap parameter (Hack. Using same as cloud for now)
Expand Down
2 changes: 1 addition & 1 deletion physics/GFS_rrtmgp_gfdlmp_pre.F90
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
module GFS_rrtmgp_gfdlmp_pre
use machine, only: kind_phys
use radiation_tools, only: check_error_msg
use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp
use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exper
use rrtmgp_lw_cloud_optics, only: radliq_lwr => radliq_lwrLW, radliq_upr => radliq_uprLW,&
radice_lwr => radice_lwrLW, radice_upr => radice_uprLW

Expand Down
10 changes: 5 additions & 5 deletions physics/GFS_rrtmgp_setup.F90
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ module GFS_rrtmgp_setup
use module_radiation_astronomy, only : sol_init, sol_update
use module_radiation_aerosols, only : aer_init, aer_update
use module_radiation_gases, only : gas_init, gas_update
use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize
! use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize
! *NOTE* These parameters below are required radiation_****** modules. They are not
! directly used by the RRTMGP routines.
use physparam, only : isolar, ictmflg, ico2flg, ioznflg, iaerflg, &
Expand Down Expand Up @@ -130,10 +130,10 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires,
call sol_init ( me )
call aer_init ( levr, me )
call gas_init ( me )
call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, &
imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, &
imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, levr, me, si,&
errflg)
!call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, &
! imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, &
! imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, levr, me, si,&
! errflg)

if ( me == 0 ) then
print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit'
Expand Down
25 changes: 22 additions & 3 deletions physics/radiation_cloud_overlap.F90
Original file line number Diff line number Diff line change
Expand Up @@ -84,16 +84,22 @@ end subroutine cmp_dcorr_lgth_oreopoulos
! ######################################################################################
!
! ######################################################################################
subroutine get_alpha_exp(nCol, nLay, dzlay, dcorr_lgth, alpha)
subroutine get_alpha_exper(nCol, nLay, iovr, iovr_exprand, dzlay, &
dcorr_lgth, cld_frac, alpha)

! Inputs
integer, intent(in) :: &
nCol, & ! Number of horizontal grid points
nLay ! Number of vertical grid points
integer, intent(in) :: &
iovr, &
iovr_exprand
real(kind_phys), dimension(nCol), intent(in) :: &
dcorr_lgth ! Decorrelation length (km)
real(kind_phys), dimension(nCol,nLay), intent(in) :: &
dzlay !
real(kind_phys), dimension(:,:), intent(in) :: &
cld_frac

! Outputs
real(kind_phys), dimension(nCol,nLay) :: &
Expand All @@ -108,9 +114,22 @@ subroutine get_alpha_exp(nCol, nLay, dzlay, dcorr_lgth, alpha)
alpha(iCol,iLay) = exp( -(dzlay(iCol,iLay)) / dcorr_lgth(iCol))
enddo
enddo


! Revise alpha for exponential-random cloud overlap
! Decorrelate layers when a clear layer follows a cloudy layer to enforce
! random correlation between non-adjacent blocks of cloudy layers
if (iovr == iovr_exprand) then
do iLay = 2, nLay
do iCol = 1, nCol
if (cld_frac(iCol,iLay) == 0.0 .and. cld_frac(iCol,iLay-1) > 0.0) then
alpha(iCol,iLay) = 0.0
endif
enddo
enddo
endif

return

end subroutine get_alpha_exp
end subroutine get_alpha_exper

end module module_radiation_cloud_overlap
Loading

0 comments on commit 242dcc9

Please sign in to comment.