Skip to content

Code update for radiation_clouds.f and GFS_rrtmg_pre.F90 #858

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
Qingfu-Liu wants to merge 3 commits into from
Closed

Code update for radiation_clouds.f and GFS_rrtmg_pre.F90 #858

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
def1b9f
Code update for radiation_clouds.f and GFS_rrtmg_pre.F90
Qingfu-Liu Feb 9, 2022
5ddc065
Code update for radiation_clouds.f and GFS_rrtmg_pre.F90 GFS_cloud_di…
Qingfu-Liu Feb 13, 2022
ef3ce8b
resolved merge conflict by incorporating the new changes
Qingfu-Liu Feb 15, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 11 additions & 2 deletions physics/GFS_cloud_diagnostics.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,8 @@ end subroutine GFS_cloud_diagnostics_init
!! \section arg_table_GFS_cloud_diagnostics_run
!! \htmlinclude GFS_cloud_diagnostics_run.html
!!
subroutine GFS_cloud_diagnostics_run(nCol, nLev, lsswr, lslwr, lat, de_lgth, p_lay, &
subroutine GFS_cloud_diagnostics_run(nCol, nLev, iovr_rand, iovr_maxrand, iovr_max, &
iovr_dcorr, iovr_exp, iovr_exprand, lsswr, lslwr, lat, de_lgth, p_lay, &
cld_frac, p_lev, deltaZ, cloud_overlap_param, precip_overlap_param, con_pi, &
mtopa, mbota, cldsa, errmsg, errflg)
implicit none
Expand All @@ -48,6 +49,13 @@ subroutine GFS_cloud_diagnostics_run(nCol, nLev, lsswr, lslwr, lat, de_lgth, p_l
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
Expand Down Expand Up @@ -106,7 +114,8 @@ subroutine GFS_cloud_diagnostics_run(nCol, nLev, lsswr, lslwr, lat, de_lgth, p_l
! defined by ptopc. The cloud overlapping method is defined by control flag 'iovr', which may
! be different for lw and sw radiation programs.
call gethml(p_lay/100., ptop1, cld_frac, cldcnv, deltaZ, de_lgth, cloud_overlap_param,&
nCol, nLev, cldsa, mtopa, mbota)
nCol, nLev, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, iovr_exp, &
iovr_exprand, cldsa, mtopa, mbota)

end subroutine GFS_cloud_diagnostics_run

Expand Down
42 changes: 42 additions & 0 deletions physics/GFS_cloud_diagnostics.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,48 @@
dimensions = ()
type = integer
intent = in
[iovr_rand]
standard_name = flag_for_random_cloud_overlap_method
long_name = choice of random cloud overlap method
units = flag
dimensions = ()
type = integer
intent = in
[iovr_maxrand]
standard_name = flag_for_maximum_random_cloud_overlap_method
long_name = choice of maximum-random cloud overlap method
units = flag
dimensions = ()
type = integer
intent = in
[iovr_max]
standard_name = flag_for_maximum_cloud_overlap_method
long_name = choice of maximum cloud overlap method
units = flag
dimensions = ()
type = integer
intent = in
[iovr_dcorr]
standard_name = flag_for_decorrelation_length_cloud_overlap_method
long_name = choice of decorrelation-length cloud overlap method
units = flag
dimensions = ()
type = integer
intent = in
[iovr_exp]
standard_name = flag_for_exponential_cloud_overlap_method
long_name = choice of exponential cloud overlap method
units = flag
dimensions = ()
type = integer
intent = in
[iovr_exprand]
standard_name = flag_for_exponential_random_cloud_overlap_method
long_name = choice of exponential-random cloud overlap method
units = flag
dimensions = ()
type = integer
intent = in
[lsswr]
standard_name = flag_for_calling_shortwave_radiation
long_name = logical flags for sw radiation calls
Expand Down
206 changes: 55 additions & 151 deletions physics/GFS_rrtmg_pre.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
ntclamt, nleffr, nieffr, nseffr, lndp_type, kdt, imp_physics, &
imp_physics_thompson, imp_physics_gfdl, imp_physics_zhao_carr, &
imp_physics_zhao_carr_pdf, imp_physics_mg, imp_physics_wsm6, &
imp_physics_fer_hires, julian, yearlen, lndp_var_list, lsswr, lslwr, &
imp_physics_fer_hires, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, &
iovr_exp, iovr_exprand, idcor_con, idcor_hogan, idcor_oreopoulos, &
julian, yearlen, lndp_var_list, lsswr, lslwr, &
ltaerosol, lgfdlmprad, uni_cld, effr_in, do_mynnedmf, lmfshal, &
lmfdeep2, fhswr, fhlwr, solhr, sup, con_eps, epsm1, fvirt, &
rog, rocp, con_rd, xlat_d, xlat, xlon, coslat, sinlat, tsfc, slmsk, &
Expand Down Expand Up @@ -51,12 +53,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update,
& NSPC1
use module_radiation_clouds, only: NF_CLDS, & ! cld_init
& progcld1, progcld3, &
& progcld2, &
& progcld4, progcld5, &
& progcld6, &
& progcld_thompson, &
& progclduni, &
& radiation_clouds_prop, &
& cal_cldfra3, &
& find_cloudLayers, &
& adjust_cloudIce, &
Expand Down Expand Up @@ -98,6 +95,17 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
imp_physics_fer_hires, &
yearlen, icloud

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
idcor_con, &
idcor_hogan, &
idcor_oreopoulos

character(len=3), dimension(:), intent(in) :: lndp_var_list

logical, intent(in) :: lsswr, lslwr, ltaerosol, lgfdlmprad, &
Expand Down Expand Up @@ -206,7 +214,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &

real(kind=kind_phys), dimension(im,lm+LTP,min(4,ncnd)) :: ccnd
real(kind=kind_phys), dimension(im,lm+LTP,2:ntrac) :: tracer1
real(kind=kind_phys), dimension(im,lm+LTP,NF_CLDS) :: clouds
real(kind=kind_phys), dimension(im,lm+LTP) :: &
& cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, &
& cld_rwp, cld_rerain, cld_swp, cld_resnow
real(kind=kind_phys), dimension(im,lm+LTP,NF_VGAS) :: gasvmr
real(kind=kind_phys), dimension(im,lm+LTP,NBDSW,NF_AESW) :: faersw
real(kind=kind_phys), dimension(im,lm+LTP,NBDLW,NF_AELW) :: faerlw
Expand Down Expand Up @@ -613,9 +623,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
!! (clouds,cldsa,mtopa,mbota)
!!\n for prognostic cloud:
!! - For Zhao/Moorthi's prognostic cloud scheme,
!! call module_radiation_clouds::progcld1()
!! call module_radiation_clouds::progcld_zhao_carr()
!! - For Zhao/Moorthi's prognostic cloud+pdfcld,
!! call module_radiation_clouds::progcld3()
!! call module_radiation_clouds::progcld_zhao_carr_pdf()
!! call module_radiation_clouds::progclduni() for unified cloud and ncnd>=2

! --- ... obtain cloud information for radiation calculations
Expand Down Expand Up @@ -882,135 +892,29 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
ccnd(1:IM,1:LMK,1) = ccnd(1:IM,1:LMK,1) + cnvw(1:IM,1:LMK)
endif

if (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_mg) then ! zhao/moorthi's prognostic cloud scheme
! or unified cloud and/or with MG microphysics

if (uni_cld .and. ncndl >= 2) then
call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs
xlat, xlon, slmsk, dz, delp, &
IM, LMK, LMP, cldcov, &
effrl, effri, effrr, effrs, effr_in, &
dzb, xlat_d, julian, yearlen, &
clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs
else
call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs
ccnd(1:IM,1:LMK,1), xlat, xlon, slmsk, dz, &
delp, IM, LMK, LMP, uni_cld, lmfshal, lmfdeep2,&
cldcov, effrl, effri, effrr, effrs, effr_in, &
dzb, xlat_d, julian, yearlen, &
clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs
endif

elseif(imp_physics == imp_physics_zhao_carr_pdf) then ! zhao/moorthi's prognostic cloud+pdfcld

call progcld3 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs
ccnd(1:IM,1:LMK,1), cnvw, cnvc, xlat, xlon, &
slmsk, dz, delp, im, lmk, lmp, deltaq, sup, kdt, &
me, dzb, xlat_d, julian, yearlen, &
clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs

elseif (imp_physics == imp_physics_gfdl) then ! GFDL cloud scheme

if (.not. lgfdlmprad) then
call progcld4 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs
ccnd(1:IM,1:LMK,1), cnvw, cnvc, xlat, xlon, &
slmsk, cldcov, dz, delp, im, lmk, lmp, &
dzb, xlat_d, julian, yearlen, &
clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs
else

call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, xlat, & ! --- inputs
xlon, slmsk, dz,delp, IM, LMK, LMP, cldcov, &
effrl, effri, effrr, effrs, effr_in, &
dzb, xlat_d, julian, yearlen, &
clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs
! call progcld4o (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs
! tracer1, xlat, xlon, slmsk, dz, delp, &
! ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
! ntsw-1,ntgl-1,ntclamt-1, &
! im, lmk, lmp, &
! dzb, xlat_d, julian, yearlen, &
! clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs
endif

elseif(imp_physics == imp_physics_fer_hires) then
if (kdt == 1) then
effrl_inout(:,:) = 10.
effri_inout(:,:) = 50.
effrs_inout(:,:) = 250.
endif

call progcld5 (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,tracer1, & ! --- inputs
xlat,xlon,slmsk,dz,delp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
im, lmk, lmp, icloud, uni_cld, lmfshal, lmfdeep2, &
cldcov(:,1:LMK),effrl_inout(:,:), &
effri_inout(:,:), effrs_inout(:,:), &
dzb, xlat_d, julian, yearlen, &
clouds,cldsa,mtopa,mbota, de_lgth, alpha) ! --- outputs

elseif(imp_physics == imp_physics_thompson) then ! Thompson MP

if(do_mynnedmf .or. imfdeepcnv == imfdeepcnv_gf ) then ! MYNN PBL or GF conv

if (icloud == 3) then
call progcld_thompson (plyr,plvl,tlyr,qlyr,qstl,rhly, & ! --- inputs
tracer1,xlat,xlon,slmsk,dz,delp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
ntsw-1,ntgl-1, &
im, lm, lmp, uni_cld, lmfshal, lmfdeep2, &
cldcov(:,1:LM), effrl, effri, effrs, &
lwp_ex, iwp_ex, lwp_fc, iwp_fc, &
dzb, xlat_d, julian, yearlen, gridkm, &
clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs
else

!-- MYNN PBL or convective GF
!-- use cloud fractions with SGS clouds
do k=1,lmk
do i=1,im
clouds(i,k,1) = clouds1(i,k)
enddo
enddo

! --- use clduni as with the GFDL microphysics.
! --- make sure that effr_in=.true. in the input.nml!
call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs
xlat, xlon, slmsk, dz, delp, IM, LMK, LMP, &
clouds(:,1:LMK,1), &
effrl, effri, effrr, effrs, effr_in , &
dzb, xlat_d, julian, yearlen, &
clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs
endif

else
! MYNN PBL or GF convective are not used

if (icloud == 3) then
call progcld_thompson (plyr,plvl,tlyr,qlyr,qstl,rhly, & ! --- inputs
tracer1,xlat,xlon,slmsk,dz,delp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
ntsw-1,ntgl-1, &
im, lm, lmp, uni_cld, lmfshal, lmfdeep2, &
cldcov(:,1:LM), effrl, effri, effrs, &
lwp_ex, iwp_ex, lwp_fc, iwp_fc, &
dzb, xlat_d, julian, yearlen, gridkm, &
clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs

else
call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly, & ! --- inputs
tracer1,xlat,xlon,slmsk,dz,delp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
ntsw-1,ntgl-1, &
im, lmk, lmp, uni_cld, lmfshal, lmfdeep2, &
cldcov(:,1:LMK), cnvw, effrl, effri, effrs,&
lwp_ex, iwp_ex, lwp_fc, iwp_fc, &
dzb, xlat_d, julian, yearlen, &
clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs
endif
endif ! MYNN PBL or GF
call radiation_clouds_prop &
& ( plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs:
& ccnd, ncndl, cnvw, cnvc, tracer1, &
& xlat, xlon, slmsk, dz, delp, IM, LM, LMK, LMP, &
& deltaq, sup, me, icloud, kdt, &
& ntrac, ntcw, ntiw, ntrw, ntsw, ntgl, ntclamt, &
& 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, iovr_rand, iovr_maxrand, iovr_max, &
& iovr_dcorr, iovr_exp, iovr_exprand, idcor_con, &
& idcor_hogan, idcor_oreopoulos, &
& imfdeepcnv, imfdeepcnv_gf, do_mynnedmf, lgfdlmprad, &
& uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, &
& effrl, effri, effrr, effrs, effr_in, &
& effrl_inout, effri_inout, effrs_inout, &
& lwp_ex, iwp_ex, lwp_fc, iwp_fc, &
& dzb, xlat_d, julian, yearlen, gridkm, &
& cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & ! --- outputs:
& cld_rwp, cld_rerain, cld_swp, cld_resnow, & ! --- outputs:
& cldsa, mtopa, mbota, de_lgth, alpha & ! --- outputs:
& )

endif ! end if_imp_physics

! endif ! end_if_ntcw

Expand All @@ -1024,33 +928,33 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
do k = 1, LMK
do i = 1, IM
! compute beta distribution parameters
m = clouds(i,k,1)
m = cld_frac(i,k)
if (m<0.99 .AND. m > 0.01) then
s = sppt_amp*m*(1.-m)
alpha0 = m*m*(1.-m)/(s*s)-m
beta0 = alpha0*(1.-m)/m
! compute beta distribution value corresponding
! to the given percentile albPpert to use as new albedo
call ppfbet(cldp1d(i),alpha0,beta0,iflag,cldtmp)
clouds(i,k,1) = cldtmp
cld_frac(i,k) = cldtmp
else
clouds(i,k,1) = m
cld_frac(i,k) = m
endif
enddo ! end_do_i_loop
enddo ! end_do_k_loop
endif
do k = 1, LM
do i = 1, IM
clouds1(i,k) = clouds(i,k,1)
clouds2(i,k) = clouds(i,k,2)
clouds3(i,k) = clouds(i,k,3)
clouds4(i,k) = clouds(i,k,4)
clouds5(i,k) = clouds(i,k,5)
clouds6(i,k) = clouds(i,k,6)
clouds7(i,k) = clouds(i,k,7)
clouds8(i,k) = clouds(i,k,8)
clouds9(i,k) = clouds(i,k,9)
cldfra(i,k) = clouds(i,k,1)
clouds1(i,k) = cld_frac(i,k)
clouds2(i,k) = cld_lwp(i,k)
clouds3(i,k) = cld_reliq(i,k)
clouds4(i,k) = cld_iwp(i,k)
clouds5(i,k) = cld_reice(i,k)
clouds6(i,k) = cld_rwp(i,k)
clouds7(i,k) = cld_rerain(i,k)
clouds8(i,k) = cld_swp(i,k)
clouds9(i,k) = cld_resnow(i,k)
cldfra(i,k) = cld_frac(i,k)
enddo
enddo
do i = 1, IM
Expand Down
Loading