Skip to content

Commit

Permalink
Some housekeeping
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Oct 27, 2023
1 parent 1db5691 commit cf0fa79
Show file tree
Hide file tree
Showing 7 changed files with 62 additions and 146 deletions.
19 changes: 1 addition & 18 deletions physics/GFS_rrtmgp_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,10 +25,6 @@ module GFS_rrtmgp_pre
real(kind_phys), parameter :: oneminus = 1.0_kind_phys - eps
real(kind_phys), parameter :: ftiny = 1.0e-12_kind_phys

! Save trace gas indices.
integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, &
iStr_cfc11, iStr_cfc12, iStr_cfc22

public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init
contains

Expand Down Expand Up @@ -86,16 +82,6 @@ subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg,
! Now extract the gas names
do ij=1,nGases
active_gases_array(ij) = active_gases(gasIndices(ij,1):gasIndices(ij,2))
if(trim(active_gases_array(ij)) .eq. 'h2o') istr_h2o = ij
if(trim(active_gases_array(ij)) .eq. 'co2') istr_co2 = ij
if(trim(active_gases_array(ij)) .eq. 'o3') istr_o3 = ij
if(trim(active_gases_array(ij)) .eq. 'n2o') istr_n2o = ij
if(trim(active_gases_array(ij)) .eq. 'ch4') istr_ch4 = ij
if(trim(active_gases_array(ij)) .eq. 'o2') istr_o2 = ij
if(trim(active_gases_array(ij)) .eq. 'ccl4') istr_ccl4 = ij
if(trim(active_gases_array(ij)) .eq. 'cfc11') istr_cfc11 = ij
if(trim(active_gases_array(ij)) .eq. 'cfc12') istr_cfc12 = ij
if(trim(active_gases_array(ij)) .eq. 'cfc22') istr_cfc22 = ij
enddo

end subroutine GFS_rrtmgp_pre_init
Expand All @@ -114,8 +100,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl
xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, coslat, sinlat, con_g, con_rd, &
con_eps, con_epsm1, con_fvirt, con_epsqs, solhr, raddt, p_lay, t_lay, p_lev, t_lev, &
vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, &
vmr_n2o, vmr_co2, tsfg, tsfa, qs_lay, q_lay, tv_lay, &
relhum, deltaZ, deltaZc, deltaP, active_gases_array, &
vmr_n2o, vmr_co2, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, deltaZ, deltaZc, deltaP,&
tsfc_radtime, coszen, coszdg, top_at_1, iSFC, iTOA, nDay, idxday, semis, &
sfc_emiss_byband, ico2, con_pi, errmsg, errflg)

Expand Down Expand Up @@ -155,8 +140,6 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl
prsi ! Pressure at model-interfaces (Pa)
real(kind_phys), dimension(:,:,:), intent(in) :: &
qgrs ! Tracer concentrations (kg/kg)
character(len=*), dimension(:), intent(in) :: &
active_gases_array ! List of active gases from namelist as array

! Outputs
character(len=*), intent(out) :: &
Expand Down
8 changes: 0 additions & 8 deletions physics/GFS_rrtmgp_pre.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -449,14 +449,6 @@
type = real
kind = kind_phys
intent = inout
[active_gases_array]
standard_name = list_of_active_gases_used_by_RRTMGP
long_name = list of active gases used by RRTMGP
units = none
dimensions = (number_of_active_gases_used_by_RRTMGP)
type = character
kind = len=*
intent = in
[coszdg]
standard_name = cosine_of_solar_zenith_angle_on_radiation_timestep
long_name = daytime mean cosz over rad call period
Expand Down
2 changes: 2 additions & 0 deletions physics/physcons.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,8 @@ module physcons
real(kind=kind_phys),parameter:: con_rhw0 =1022.0_kind_phys !< sea water reference density (\f$kg/m^{3}\f$)
real(kind=kind_phys),parameter:: con_epsq =1.0E-12_kind_phys !< min q for computing precip type
real(kind=kind_phys),parameter:: con_epsqs =1.0E-10_kind_phys
real(kind=kind_phys),parameter:: con_mincf =1.0E-6_kind_phys !< minimum cloud-fraction see by RRTMGP radiation

! Selected thermodynamics constants with kind=kind_dyn
real(kind=kind_dyn), parameter:: con_rd_dyn =2.8705e+2_kind_dyn !< gas constant air (\f$J/kg/K\f$)
real(kind=kind_dyn), parameter:: con_rv_dyn =4.6150e+2_kind_dyn !< gas constant H2O (\f$J/kg/K\f$)
Expand Down
52 changes: 20 additions & 32 deletions physics/rrtmgp_lw_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,9 +20,6 @@ module rrtmgp_lw_main
use rrtmgp_lw_cloud_optics, only: lw_cloud_props, rrtmgp_lw_cloud_optics_init, abssnow0, &
abssnow1, absrain
use module_radiation_gases, only: NF_VGAS, getgases, getozn
use GFS_rrtmgp_pre, only: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, &
iStr_o2, iStr_ccl4, iStr_cfc11, iStr_cfc12, iStr_cfc22, &
eps, oneminus, ftiny
use mersenne_twister, only: random_setseed, random_number, random_stat
use rrtmgp_sampling, only: sampled_mask, draw_samples
implicit none
Expand All @@ -41,9 +38,8 @@ module rrtmgp_lw_main
!> @{
! #########################################################################################
subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_file_clouds,&
active_gases_array, doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_sgs_pbl, &
doGP_sgs_cnv, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, &
errmsg, errflg)
active_gases_array, doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, &
mpirank, mpiroot, nLay, errmsg, errflg)

! Inputs
character(len=128),intent(in) :: &
Expand All @@ -53,20 +49,16 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi
rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute
! gaseous optical properties
character(len=*), dimension(:), intent(in) :: &
active_gases_array ! List of active gases from namelist as array)
active_gases_array ! List of active gases from namelist as array)
logical, intent(in) :: &
doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation?
doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs?
doGP_sgs_pbl, & ! Flag to include sgs PBL clouds
doGP_sgs_cnv ! Flag to include sgs convective clouds
doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs?
integer, intent(inout) :: &
nrghice ! Number of ice-roughness categories
integer,intent(in) :: &
mpicomm, & ! MPI communicator
mpirank, & ! Current MPI rank
mpiroot, & ! Master MPI rank
rrtmgp_phys_blksz, & ! Number of horizontal points to process at once.
nLay
mpiroot ! Master MPI rank

! Outputs
character(len=*), intent(out) :: &
Expand Down Expand Up @@ -108,7 +100,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, &
cld_rwp, cld_rerain, precip_frac, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, &
cld_cnv_reice, cld_pbl_lwp, cld_pbl_reliq, cld_pbl_iwp, cld_pbl_reice, &
cloud_overlap_param, active_gases_array, aerlw_tau, aerlw_ssa, aerlw_g, &
cloud_overlap_param, active_gases_array, aerlw_tau, aerlw_ssa, aerlw_g, con_mincf,&
fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, &
fluxlwUP_jac, fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg)

Expand Down Expand Up @@ -138,6 +130,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
isubc_lw ! Flag for cloud-seeding (rng) for cloud-sampling
integer,intent(in),dimension(:) :: &
icseed_lw ! Seed for random number generation for longwave radiation
real(kind_phys), intent(in) :: &
con_mincf ! Minimum cloud-fraction for all-sky calculation
real(kind_phys), dimension(:), intent(in) :: &
semis, & ! Surface-emissivity (1)
tsfg ! Skin temperature (K)
Expand Down Expand Up @@ -299,18 +293,12 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
! Set gas-concentrations
!
! ###################################################################################
call check_error_msg('rrtmgp_lw_main_set_vmr_o2', &
gas_concs%set_vmr(trim(active_gases_array(istr_o2)), vmr_o2(iCol:iCol2,:)))
call check_error_msg('rrtmgp_lw_main_set_vmr_co2', &
gas_concs%set_vmr(trim(active_gases_array(istr_co2)),vmr_co2(iCol:iCol2,:)))
call check_error_msg('rrtmgp_lw_main_set_vmr_ch4', &
gas_concs%set_vmr(trim(active_gases_array(istr_ch4)),vmr_ch4(iCol:iCol2,:)))
call check_error_msg('rrtmgp_lw_main_set_vmr_n2o', &
gas_concs%set_vmr(trim(active_gases_array(istr_n2o)),vmr_n2o(iCol:iCol2,:)))
call check_error_msg('rrtmgp_lw_main_set_vmr_h2o', &
gas_concs%set_vmr(trim(active_gases_array(istr_h2o)),vmr_h2o(iCol:iCol2,:)))
call check_error_msg('rrtmgp_lw_main_set_vmr_o3', &
gas_concs%set_vmr(trim(active_gases_array(istr_o3)), vmr_o3(iCol:iCol2,:)))
call check_error_msg('rrtmgp_sw_main_set_vmr_o2', gas_concs%set_vmr('o2', vmr_o2(iCol:iCol2,:)))
call check_error_msg('rrtmgp_sw_main_set_vmr_co2', gas_concs%set_vmr('co2',vmr_co2(iCol:iCol2,:)))
call check_error_msg('rrtmgp_sw_main_set_vmr_ch4', gas_concs%set_vmr('ch4',vmr_ch4(iCol:iCol2,:)))
call check_error_msg('rrtmgp_sw_main_set_vmr_n2o', gas_concs%set_vmr('n2o',vmr_n2o(iCol:iCol2,:)))
call check_error_msg('rrtmgp_sw_main_set_vmr_h2o', gas_concs%set_vmr('h2o',vmr_h2o(iCol:iCol2,:)))
call check_error_msg('rrtmgp_sw_main_set_vmr_o3', gas_concs%set_vmr('o3', vmr_o3(iCol:iCol2,:)))

! ###################################################################################
!
Expand All @@ -319,7 +307,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
! ###################################################################################
! Assign same emissivity to all band
do iblck=1,rrtmgp_phys_blksz
if (semis(iCol+iblck-1) > eps .and. semis(iCol+iblck-1) <= 1._kind_phys) then
if (semis(iCol+iblck-1) > con_mincf .and. semis(iCol+iblck-1) <= 1._kind_phys) then
do iBand=1,lw_gas_props%get_nband()
sfc_emiss_byband(iBand,iblck) = semis(iCol+iblck-1)
enddo
Expand Down Expand Up @@ -355,12 +343,12 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
do iLay=1,nLay
zcf0(iblck) = min(zcf0(iblck), 1._kind_phys - cld_frac(iCol+iblck-1,iLay))
enddo
if (zcf0(iblck) <= ftiny) zcf0(iblck) = 0._kind_phys
if (zcf0(iblck) > oneminus) zcf0(iblck) = 1._kind_phys
if (zcf0(iblck) <= 1.0e-12_kind_phys) zcf0(iblck) = 0._kind_phys
if (zcf0(iblck) > (1._kind_phys-con_mincf)) zcf0(iblck) = 1._kind_phys
zcf1(iblck) = 1._kind_phys - zcf0(iblck)
enddo

if (any(zcf1 .gt. eps)) then
if (any(zcf1 .gt. con_mincf)) then
! Microphysical (gridmean) cloud optics
call check_error_msg('rrtmgp_lw_main_cloud_optics',lw_cloud_props%cloud_optics(&
cld_lwp(iCol:iCol2,:), & ! IN - Cloud liquid water path (g/m2)
Expand Down Expand Up @@ -409,7 +397,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
tau_snow(:) = 0._kind_phys
do ix=1,rrtmgp_phys_blksz
do iLay=1,nLay
if (cld_frac(iCol+ix-1,iLay) .gt. eps) then
if (cld_frac(iCol+ix-1,iLay) .gt. con_mincf) then
! Rain optical-depth (No band dependence)
tau_rain(ix) = absrain*cld_rwp(iCol+ix-1,iLay)

Expand All @@ -435,7 +423,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
! *Note* All of the included cloud-types are sampled together, not independently.
!
! ###################################################################################
if (any(zcf1 .gt. eps)) then
if (any(zcf1 .gt. con_mincf)) then
! Change random number seed value for each radiation invocation (isubc_lw =1 or 2).
if(isubc_lw == 1) then ! advance prescribed permutation seed
do ix=1,rrtmgp_phys_blksz
Expand Down
39 changes: 10 additions & 29 deletions physics/rrtmgp_lw_main.meta
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,8 @@
[ccpp-table-properties]
name = rrtmgp_lw_main
type = scheme
dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90
dependencies = machine.F,radiation_tools.F90
dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90
dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90
dependencies = rte-rrtmgp/rte/mo_source_functions.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90
dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90
Expand Down Expand Up @@ -50,20 +51,6 @@
dimensions = ()
type = logical
intent = in
[doGP_sgs_cnv]
standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP
long_name = logical flag to control sgs convective cloud in RRTMGP
units = flag
dimensions = ()
type = logical
intent = in
[doGP_sgs_pbl]
standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP
long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP
units = flag
dimensions = ()
type = logical
intent = in
[nrghice]
standard_name = number_of_ice_roughness_categories
long_name = number of ice-roughness categories in RRTMGP calculation
Expand Down Expand Up @@ -92,20 +79,6 @@
dimensions = ()
type = integer
intent = in
[rrtmgp_phys_blksz]
standard_name = number_of_columns_per_RRTMGP_LW_block
long_name = number of columns to process at a time by RRTMGP LW scheme
units = count
dimensions = ()
type = integer
intent = in
[nLay]
standard_name = vertical_layer_dimension
long_name = number of vertical levels
units = count
dimensions = ()
type = integer
intent = in
[active_gases_array]
standard_name = list_of_active_gases_used_by_RRTMGP
long_name = list of active gases used by RRTMGP
Expand Down Expand Up @@ -183,6 +156,14 @@
dimensions = ()
type = logical
intent = in
[con_mincf]
standard_name = minimum_value_of_cloud_fraction_used_in_radiation
long_name = minimum cloud fraction for all sky calculation
units = none
dimensions = ()
type = real
kind = kind_phys
intent = in
[ncol]
standard_name = horizontal_loop_extent
long_name = horizontal dimension
Expand Down
Loading

0 comments on commit cf0fa79

Please sign in to comment.