Skip to content

Commit

Permalink
Merge pull request #795 from climbfuji/greg_new_thompson_cloud_fracti…
Browse files Browse the repository at this point in the history
…on_with_ruiyu_cloud_cover_change_xu_randall

Wrapper PR for #781 (New Thompson cloud fraction) and #800 (Remove Laurie from CODEOWNERS)
  • Loading branch information
climbfuji authored Dec 10, 2021
2 parents cbc7e36 + 6788593 commit fb752d4
Show file tree
Hide file tree
Showing 8 changed files with 785 additions and 406 deletions.
7 changes: 7 additions & 0 deletions CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -195,6 +195,13 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
list(APPEND SCHEMES_SFX_OPT ${LOCAL_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90)
endif()

if (${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 IN_LIST SCHEMES)
# Reduce optimization for mo_gas_optics_kernels.F90 (to avoid an apparent compiler bug with Intel 19+)
SET_SOURCE_FILES_PROPERTIES(${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90
PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_OPT} -O1")
list(APPEND SCHEMES_SFX_OPT ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90)
endif()

# Remove files with special compiler flags from list of files with standard compiler flags
if (SCHEMES_SFX_OPT)
list(REMOVE_ITEM SCHEMES ${SCHEMES_SFX_OPT})
Expand Down
2 changes: 1 addition & 1 deletion CODEOWNERS
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@

# These owners will be the default owners for everything in the repo.
#* @defunkt
* @climbfuji @llpcarson @grantfirl @mzhangw @panll @mkavulich
* @climbfuji @grantfirl @mzhangw @panll @mkavulich

# Order is important. The last matching pattern has the most precedence.
# So if a pull request only touches javascript files, only these owners
Expand Down
9 changes: 8 additions & 1 deletion physics/GFS_rrtmg_post.F90
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ subroutine GFS_rrtmg_post_run (im, km, kmp1, lm, ltp, kt, kb, kd, nspc1, &
nfxr, nday, lsswr, lslwr, lssav, fhlwr, fhswr, raddt, coszen, &
coszdg, prsi, tgrs, aerodp, cldsa, mtopa, mbota, clouds1, &
cldtaulw, cldtausw, sfcflw, sfcfsw, topflw, topfsw, scmpsw, &
fluxr, errmsg, errflg)
fluxr, total_albedo, errmsg, errflg)

use machine, only: kind_phys
use module_radsw_parameters, only: topfsw_type, sfcfsw_type, &
Expand All @@ -43,6 +43,7 @@ subroutine GFS_rrtmg_post_run (im, km, kmp1, lm, ltp, kt, kb, kd, nspc1, &
real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: clouds1
real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtausw
real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtaulw
real(kind=kind_phys), dimension(im), intent(inout) :: total_albedo

type(sfcflw_type), dimension(im), intent(in) :: sfcflw
type(sfcfsw_type), dimension(im), intent(in) :: sfcfsw
Expand Down Expand Up @@ -196,6 +197,12 @@ subroutine GFS_rrtmg_post_run (im, km, kmp1, lm, ltp, kt, kb, kd, nspc1, &
endif

endif ! end_if_lssav

! --- The total sky (with clouds) shortwave albedo
total_albedo = 0.0
if (lsswr) then
where(topfsw(:)%dnfxc>0) total_albedo(:) = topfsw(:)%upfxc/topfsw(:)%dnfxc
endif
!
end subroutine GFS_rrtmg_post_run

Expand Down
10 changes: 9 additions & 1 deletion physics/GFS_rrtmg_post.meta
Original file line number Diff line number Diff line change
Expand Up @@ -195,7 +195,7 @@
standard_name = total_cloud_fraction
long_name = layer total cloud fraction
units = frac
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation)
type = real
kind = kind_phys
intent = in
Expand Down Expand Up @@ -258,6 +258,14 @@
type = real
kind = kind_phys
intent = inout
[total_albedo]
standard_name = total_sky_albedo
long_name = total sky albedo at toa
units = frac
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = inout
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down
157 changes: 67 additions & 90 deletions physics/GFS_rrtmg_pre.F90
Original file line number Diff line number Diff line change
Expand Up @@ -34,8 +34,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
plvl, plyr, tlvl, tlyr, qlyr, olyr, gasvmr_co2, gasvmr_n2o, gasvmr_ch4,&
gasvmr_o2, gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, &
gasvmr_ccl4, gasvmr_cfc113, aerodp, clouds6, clouds7, clouds8, &
clouds9, cldsa, cldfra, faersw1, faersw2, faersw3, faerlw1, faerlw2, &
faerlw3, alpha, errmsg, errflg)
clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, &
faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, &
errmsg, errflg)

use machine, only: kind_phys

Expand All @@ -54,6 +55,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
& progcld2, &
& progcld4, progcld5, &
& progcld6, &
& progcld_thompson, &
& progclduni, &
& cal_cldfra3, &
& find_cloudLayers, &
Expand Down Expand Up @@ -125,6 +127,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
real(kind=kind_phys), dimension(:,:), intent(inout) :: clouds1, &
clouds2, clouds3, &
clouds4, clouds5
real(kind=kind_phys), dimension(:), intent(out) :: lwp_ex,iwp_ex, &
& lwp_fc,iwp_fc

integer, intent(out) :: kd, kt, kb

Expand Down Expand Up @@ -158,6 +162,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
clouds8, &
clouds9, &
cldfra
real(kind=kind_phys), dimension(:), intent(out) :: cldfra2d
real(kind=kind_phys), dimension(:,:), intent(out) :: cldsa

real(kind=kind_phys), dimension(:,:,:), intent(out) :: faersw1,&
Expand Down Expand Up @@ -191,9 +196,10 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
real(kind=kind_phys), dimension(im,lm+LTP) :: &
re_cloud, re_ice, re_snow, qv_mp, qc_mp, &
qi_mp, qs_mp, nc_mp, ni_mp, nwfa
real (kind=kind_phys), dimension(lm) :: cldfra1d, qv1d, &
& qc1d, qi1d, qs1d, dz1d, p1d, t1d

! for F-A MP
real(kind=kind_phys), dimension(im,lm+LTP) :: qc_save, qi_save, qs_save
real(kind=kind_phys), dimension(im,lm+LTP+1) :: tem2db, hz

real(kind=kind_phys), dimension(im,lm+LTP,min(4,ncnd)) :: ccnd
Expand All @@ -206,6 +212,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
! for stochastic cloud perturbations
real(kind=kind_phys), dimension(im) :: cldp1d
real (kind=kind_phys) :: alpha0,beta0,m,s,cldtmp,tmp_wt,cdfz
real (kind=kind_phys) :: max_relh
integer :: iflag

integer :: ids, ide, jds, jde, kds, kde, &
Expand All @@ -228,6 +235,21 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
LP1 = LM + 1 ! num of in/out levels


gridkm = sqrt(2.0)*sqrt(dx(1)*0.001*dx(1)*0.001)

if (imp_physics == imp_physics_thompson) then
max_relh = 1.5
else
max_relh = 1.1
endif

do i = 1, IM
lwp_ex(i) = 0.0
iwp_ex(i) = 0.0
lwp_fc(i) = 0.0
iwp_fc(i) = 0.0
enddo

! --- ... set local /level/layer indexes corresponding to in/out
! variables

Expand Down Expand Up @@ -854,88 +876,6 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
enddo
endif

!mz HWRF physics: icloud=3
if(icloud == 3) then

! Set internal dimensions
ids = 1
ims = 1
its = 1
ide = size(xlon,1)
ime = size(xlon,1)
ite = size(xlon,1)
jds = 1
jms = 1
jts = 1
jde = 1
jme = 1
jte = 1
kds = 1
kms = 1
kts = 1
kde = lm+LTP ! should this be lmk instead of lm? no, or?
kme = lm+LTP
kte = lm+LTP

do k = 1, LMK
do i = 1, IM
rho(i,k)=plyr(i,k)*100./(con_rd*tlyr(i,k))
plyrpa(i,k)=plyr(i,k)*100. !hPa->Pa
end do
end do

do i=1,im
if (slmsk(i)==1. .or. slmsk(i)==2.) then ! sea/land/ice mask (=0/1/2) in FV3
xland(i)=1.0 ! but land/water = (1/2) in HWRF
else
xland(i)=2.0
endif
enddo

gridkm = sqrt(2.0)*sqrt(dx(1)*0.001*dx(1)*0.001)

do i =1, im
do k =1, lmk
qc_save(i,k) = ccnd(i,k,1)
qi_save(i,k) = ccnd(i,k,2)
qs_save(i,k) = ccnd(i,k,4)
enddo
enddo


call cal_cldfra3(cldcov,qlyr,ccnd(:,:,1),ccnd(:,:,2), &
ccnd(:,:,4),plyrpa,tlyr,rho,xland,gridkm, &
ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)

!mz* back to micro-only qc qi,qs
do i =1, im
do k =1, lmk
ccnd(i,k,1) = qc_save(i,k)
ccnd(i,k,2) = qi_save(i,k)
ccnd(i,k,4) = qs_save(i,k)
enddo
enddo

endif ! icloud == 3

if (lextop) then
do i=1,im
cldcov(i,lyb) = cldcov(i,lya)
deltaq(i,lyb) = deltaq(i,lya)
cnvw (i,lyb) = cnvw (i,lya)
cnvc (i,lyb) = cnvc (i,lya)
enddo
if (effr_in) then
do i=1,im
effrl(i,lyb) = effrl(i,lya)
effri(i,lyb) = effri(i,lya)
effrr(i,lyb) = effrr(i,lya)
effrs(i,lyb) = effrs(i,lya)
enddo
endif
endif

if (imp_physics == imp_physics_zhao_carr) then
ccnd(1:IM,1:LMK,1) = ccnd(1:IM,1:LMK,1) + cnvw(1:IM,1:LMK)
Expand Down Expand Up @@ -1012,6 +952,20 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
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_inout, &
effri_inout, effrs_inout, &
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
Expand All @@ -1028,18 +982,35 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
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
call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs
xlat,xlon,slmsk,dz,delp, &

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_inout, &
effri_inout, effrs_inout, &
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), effrl_inout(:,:), &
effri_inout(:,:), effrs_inout(:,:), &
cldcov(:,1:LMK), effrl_inout, &
effri_inout, effrs_inout, &
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

endif ! end if_imp_physics
Expand Down Expand Up @@ -1071,7 +1042,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
enddo ! end_do_i_loop
enddo ! end_do_k_loop
endif
do k = 1, LMK
do k = 1, LM
do i = 1, IM
clouds1(i,k) = clouds(i,k,1)
clouds2(i,k) = clouds(i,k,2)
Expand All @@ -1085,6 +1056,12 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, &
cldfra(i,k) = clouds(i,k,1)
enddo
enddo
do i = 1, IM
cldfra2d(i) = 0.0
do k = 1, LM-1
cldfra2d(i) = max(cldfra2d(i), cldfra(i,k))
enddo
enddo

! mg, sfc-perts
! --- scale random patterns for surface perturbations with
Expand Down
42 changes: 41 additions & 1 deletion physics/GFS_rrtmg_pre.meta
Original file line number Diff line number Diff line change
Expand Up @@ -570,7 +570,7 @@
intent = in
[sppt_amp]
standard_name = total_amplitude_of_sppt_perturbation
long_name = toal ampltidue of stochastic sppt perturbation
long_name = total ampltidue of stochastic sppt perturbation
units = none
dimensions = ()
type = real
Expand Down Expand Up @@ -978,6 +978,46 @@
type = real
kind = kind_phys
intent = out
[cldfra2d]
standard_name = max_in_column_cloud_fraction
long_name = instantaneous 2D (max-in-column) cloud fraction
units = frac
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
[lwp_ex]
standard_name = liq_water_path_from_microphysics
long_name = total liquid water path from explicit microphysics
units = kg m-2
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
[iwp_ex]
standard_name = ice_water_path_from_microphysics
long_name = total ice water path from explicit microphysics
units = kg m-2
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
[lwp_fc]
standard_name = liq_water_path_from_cloud_fraction
long_name = total liquid water path from cloud fraction scheme
units = kg m-2
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
[iwp_fc]
standard_name = ice_water_path_from_cloud_fraction
long_name = total ice water path from cloud fraction scheme
units = kg m-2
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
[faersw1]
standard_name = aerosol_optical_depth_for_shortwave_bands_01_16
long_name = aerosol optical depth for shortwave bands 01-16
Expand Down
Loading

0 comments on commit fb752d4

Please sign in to comment.