Skip to content

Changes to ensure RRTMGP for use on multiple threads. #568

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

Merged
climbfuji merged 14 commits into from
Feb 24, 2021
Merged

Changes to ensure RRTMGP for use on multiple threads. #568

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
14 commits
Select commit Hold shift + click to select a range
5e50bdf
Cleanup for MPI implementation.
dustinswales Feb 10, 2021
ab9d45b
Working on multiple threads.
dustinswales Feb 11, 2021
de38fb4
Merge branch 'master' of https://github.com/NCAR/ccpp-physics into ho…
dustinswales Feb 11, 2021
7fe6ab4
Define interstitial for minimum temperature allowed by GP.
dustinswales Feb 16, 2021
1ba6619
MPI broadcast working in sw gas optics init. Error later in _run rout…
dustinswales Feb 17, 2021
7cb5d21
Removed error checking calls.
dustinswales Feb 17, 2021
f3e963f
Making progress. Not all fields being broadcast correctly.
dustinswales Feb 17, 2021
994166a
MPI Broadcast working in SW gas-optics.
dustinswales Feb 17, 2021
0586868
MPI broadcast working in LW gas-optics initialization.
dustinswales Feb 18, 2021
f3393f4
MPI broadcast working in SW/LW cloud-optics initialization.
dustinswales Feb 18, 2021
f17ea6f
Merge branch 'master' of https://github.com/NCAR/ccpp-physics into ho…
dustinswales Feb 23, 2021
cea4252
Changes from code review.
dustinswales Feb 23, 2021
2a39342
Fixed whitespace.
dustinswales Feb 23, 2021
f215731
Remove mpi_bcast for unallocated fields.
dustinswales Feb 23, 2021
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
3 changes: 2 additions & 1 deletion physics/GFS_rrtmgp_gfdlmp_pre.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,8 @@ module GFS_rrtmgp_gfdlmp_pre
use machine, only: kind_phys
use rrtmgp_aux, only: check_error_msg
use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp
use rrtmgp_lw_cloud_optics, only: radliq_lwr, radliq_upr, radice_lwr, radice_upr
use rrtmgp_lw_cloud_optics, only: radliq_lwr => radliq_lwrLW, radliq_upr => radliq_uprLW,&
radice_lwr => radice_lwrLW, radice_upr => radice_uprLW

! Parameters
real(kind_phys), parameter :: &
Expand Down
132 changes: 41 additions & 91 deletions physics/GFS_rrtmgp_pre.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ module GFS_rrtmgp_pre
getgases, & ! Routine to setup trace gases
getozn ! Routine to setup ozone
! RRTMGP types
use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp
use mo_gas_concentrations, only: ty_gas_concs
use rrtmgp_aux, only: check_error_msg

Expand All @@ -19,22 +18,11 @@ module GFS_rrtmgp_pre
amdw = amd/amw, & ! Molecular weight of dry air / water vapor
amdo3 = amd/amo3 ! Molecular weight of dry air / ozone

! Some common trace gas on/off flags.
! This allows for control over which trace gases are used in RRTMGP radiation scheme via
! namelist.
logical :: &
isActive_h2o = .false., & !
isActive_co2 = .false., & !
isActive_o3 = .false., & !
isActive_n2o = .false., & !
isActive_ch4 = .false., & !
isActive_o2 = .false., & !
isActive_ccl4 = .false., & !
isActive_cfc11 = .false., & !
isActive_cfc12 = .false., & !
isActive_cfc22 = .false. !
! 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
character(len=32),dimension(:),allocatable :: &
active_gases_array

public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize
contains
Expand All @@ -45,19 +33,17 @@ module GFS_rrtmgp_pre
!! \section arg_table_GFS_rrtmgp_pre_init
!! \htmlinclude GFS_rrtmgp_pre_init.html
!!
subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, errflg)
subroutine GFS_rrtmgp_pre_init(nGases, active_gases, errmsg, errflg)
! Inputs
integer, intent(in) :: &
nGases ! Number of active gases in RRTMGP
character(len=*), intent(in) :: &
active_gases ! List of active gases from namelist.
integer, intent(in) :: &
nGases ! Number of active gases in RRTMGP
character(len=*), intent(in) :: &
active_gases ! List of active gases from namelist.
! Outputs
character(len=*),dimension(nGases), intent(out) :: &
active_gases_array ! Character array containing trace gases to include in RRTMGP
character(len=*), intent(out) :: &
errmsg ! Error message
errmsg ! Error message
integer, intent(out) :: &
errflg ! Error flag
errflg ! Error flag

! Local variables
character(len=1) :: tempstr
Expand Down Expand Up @@ -87,52 +73,19 @@ subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg,
gasIndices(nGases,2)=len(trim(active_gases))

! Now extract the gas names
allocate(active_gases_array(nGases))
do ij=1,nGases
active_gases_array(ij) = active_gases(gasIndices(ij,1):gasIndices(ij,2))
enddo

! Which gases are active? (This is purely for flexibility)
do ij=1,nGases
if(trim(active_gases_array(ij)) .eq. 'h2o') then
isActive_h2o = .true.
istr_h2o = ij
endif
if(trim(active_gases_array(ij)) .eq. 'co2') then
isActive_co2 = .true.
istr_co2 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'o3') then
isActive_o3 = .true.
istr_o3 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'n2o') then
isActive_n2o = .true.
istr_n2o = ij
endif
if(trim(active_gases_array(ij)) .eq. 'ch4') then
isActive_ch4 = .true.
istr_ch4 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'o2') then
isActive_o2 = .true.
istr_o2 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'ccl4') then
isActive_ccl4 = .true.
istr_ccl4 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'cfc11') then
isActive_cfc11 = .true.
istr_cfc11 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'cfc12') then
isActive_cfc12 = .true.
istr_cfc12 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'cfc22') then
isActive_cfc22 = .true.
istr_cfc22 = ij
endif
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 @@ -143,25 +96,23 @@ end subroutine GFS_rrtmgp_pre_init
!> \section arg_table_GFS_rrtmgp_pre_run
!! \htmlinclude GFS_rrtmgp_pre_run.html
!!
subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, &
fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, con_eps,&
con_epsm1, con_fvirt, con_epsqs, lw_gas_props, &
raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer,&
gas_concentrations, errmsg, errflg)
subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, &
xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt, &
con_epsqs, minGPpres, minGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, &
qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg)

! Inputs
integer, intent(in) :: &
nCol, & ! Number of horizontal grid points
nLev, & ! Number of vertical layers
nGases, & ! Number of active gases in RRTMGP.
nTracers, & ! Number of tracers from model.
i_o3 ! Index into tracer array for ozone
logical, intent(in) :: &
lsswr, & ! Call SW radiation?
lslwr ! Call LW radiation
character(len=*),dimension(nGases), intent(in) :: &
active_gases_array ! Character array containing trace gases to include in RRTMGP
real(kind_phys), intent(in) :: &
minGPtemp, & ! Minimum temperature allowed in RRTMGP.
minGPpres, & ! Minimum pressure allowed in RRTMGP.
fhswr, & ! Frequency of SW radiation call.
fhlwr ! Frequency of LW radiation call.
real(kind_phys), intent(in) :: &
Expand All @@ -181,8 +132,6 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr,
prsi ! Pressure at model-interfaces (Pa)
real(kind_phys), dimension(nCol,nLev,nTracers) :: &
qgrs ! Tracer concentrations (kg/kg)
type(ty_gas_optics_rrtmgp),intent(in) :: &
lw_gas_props ! RRTMGP DDT:

! Outputs
character(len=*), intent(out) :: &
Expand Down Expand Up @@ -216,6 +165,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr,
real(kind_phys) :: es, tem1, tem2
real(kind_phys), dimension(nCol,nLev) :: o3_lay, tem2da, tem2db
real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr
character(len=32), dimension(gas_concentrations%get_num_gases()) :: active_gases

! Initialize CCPP error handling variables
errmsg = ''
Expand Down Expand Up @@ -255,8 +205,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr,
! Bound temperature at layer centers.
do iCol=1,NCOL
do iLay=1,nLev
if (t_lay(iCol,iLay) .le. lw_gas_props%get_temp_min()) then
t_lay = lw_gas_props%get_temp_min() + epsilon(lw_gas_props%get_temp_min())
if (t_lay(iCol,iLay) .le. minGPtemp) then
t_lay = minGPtemp + epsilon(minGPtemp)
endif
enddo
enddo
Expand All @@ -267,7 +217,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr,
tem2db(1:nCol,2:iSFC) = log(p_lev(1:nCol,2:iSFC))
do iCol = 1, nCol
tem2da(iCol,1) = log(p_lay(iCol,1) )
tem2db(iCol,1) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,1)) )
tem2db(iCol,1) = log(max(minGPpres, p_lev(iCol,1)) )
tem2db(iCol,iSFC) = log(p_lev(iCol,iSFC) )
enddo
!
Expand All @@ -286,7 +236,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr,
do iCol = 1, nCol
tem2da(iCol,1) = log(p_lay(iCol,1))
tem2db(iCol,1) = log(p_lev(iCol,1))
tem2db(iCol,iTOA) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,iTOA)) )
tem2db(iCol,iTOA) = log(max(minGPpres, p_lev(iCol,iTOA)) )
enddo
!
t_lev(1:NCOL,1) = tsfc(1:NCOL)
Expand Down Expand Up @@ -342,14 +292,14 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr,
vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.)
vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.)

! Initialize and opulate RRTMGP DDT w/ gas-concentrations
call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o2), gas_vmr(:,:,4)))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_co2), gas_vmr(:,:,1)))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_ch4), gas_vmr(:,:,3)))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_n2o), gas_vmr(:,:,2)))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_h2o), vmr_h2o))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o3), vmr_o3))
! Populate RRTMGP DDT w/ gas-concentrations
gas_concentrations%gas_name(:) = active_gases_array(:)
gas_concentrations%concs(istr_o2)%conc(:,:) = gas_vmr(:,:,4)
gas_concentrations%concs(istr_co2)%conc(:,:) = gas_vmr(:,:,1)
gas_concentrations%concs(istr_ch4)%conc(:,:) = gas_vmr(:,:,3)
gas_concentrations%concs(istr_n2o)%conc(:,:) = gas_vmr(:,:,2)
gas_concentrations%concs(istr_h2o)%conc(:,:) = vmr_h2o(:,:)
gas_concentrations%concs(istr_o3)%conc(:,:) = vmr_o3(:,:)

! #######################################################################################
! Radiation time step (output) (Is this really needed?) (Used by some diagnostics)
Expand All @@ -360,7 +310,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr,
! Setup surface ground temperature and ground/air skin temperature if required.
! #######################################################################################
tsfg(1:NCOL) = tsfc(1:NCOL)
tsfa(1:NCOL) = t_lay(1:NCOL,iSFC)!tsfc(1:NCOL)
tsfa(1:NCOL) = t_lay(1:NCOL,iSFC)

end subroutine GFS_rrtmgp_pre_run

Expand Down
50 changes: 17 additions & 33 deletions physics/GFS_rrtmgp_pre.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,15 +25,6 @@
type = integer
intent = in
optional = F
[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 = out
optional = F
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down Expand Up @@ -71,15 +62,7 @@
dimensions = ()
type = integer
intent = in
optional = F
[nGases]
standard_name = number_of_active_gases_used_by_RRTMGP
long_name = number of gases available used by RRTMGP (Model%nGases)
units = count
dimensions = ()
type = integer
intent = in
optional = F
optional = F
[nTracers]
standard_name = number_of_tracers
long_name = number of tracers
Expand Down Expand Up @@ -202,15 +185,6 @@
kind = kind_phys
intent = in
optional = F
[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
optional = F
[con_eps]
standard_name = ratio_of_dry_air_to_water_vapor_gas_constants
long_name = rd/rv
Expand Down Expand Up @@ -246,15 +220,25 @@
type = real
kind = kind_phys
intent = in
optional = F
[lw_gas_props]
standard_name = coefficients_for_lw_gas_optics
long_name = DDT containing spectral information for RRTMGP LW radiation scheme
units = DDT
optional = F
[minGPpres]
standard_name = minimum_pressure_in_RRTMGP
long_name = minimum pressure allowed in RRTMGP
units = Pa
dimensions = ()
type = ty_gas_optics_rrtmgp
type = real
kind = kind_phys
intent = in
optional = F
[minGPtemp]
standard_name = minimum_temperature_in_RRTMGP
long_name = minimum temperature allowed in RRTMGP
units = K
dimensions = ()
type = real
kind = kind_phys
intent = out
optional = F
[raddt]
standard_name = time_step_for_radiation
long_name = radiation time step
Expand Down
5 changes: 2 additions & 3 deletions physics/GFS_rrtmgp_sw_post.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ module GFS_rrtmgp_sw_post
use mo_fluxes_byband, only: ty_fluxes_byband
use mo_heating_rates, only: compute_heating_rate
use rrtmgp_aux, only: check_error_msg
use rrtmgp_sw_gas_optics, only: sw_gas_props
implicit none

public GFS_rrtmgp_sw_post_init,GFS_rrtmgp_sw_post_run,GFS_rrtmgp_sw_post_finalize
Expand All @@ -26,7 +27,7 @@ end subroutine GFS_rrtmgp_sw_post_init
!!
subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky_hr, &
save_diag, fhswr, coszen, coszdg, t_lay, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, &
sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sw_gas_props, fluxswUP_allsky, &
sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, fluxswUP_allsky, &
fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, &
mtopa, cld_frac, cldtausw, fluxr, &
nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, &
Expand All @@ -43,8 +44,6 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky
lsswr, & ! Call SW radiation?
do_sw_clrsky_hr, & ! Output clear-sky SW heating-rate?
save_diag ! Output radiation diagnostics?
type(ty_gas_optics_rrtmgp),intent(in) :: &
sw_gas_props ! DDT containing SW spectral information
real(kind_phys), intent(in) :: &
fhswr ! Frequency for SW radiation
real(kind_phys), dimension(nCol), intent(in) :: &
Expand Down
8 changes: 0 additions & 8 deletions physics/GFS_rrtmgp_sw_post.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -145,14 +145,6 @@
kind = kind_phys
intent = in
optional = F
[sw_gas_props]
standard_name = coefficients_for_sw_gas_optics
long_name = DDT containing spectral information for RRTMGP SW radiation scheme
units = DDT
dimensions = ()
type = ty_gas_optics_rrtmgp
intent = in
optional = F
[fluxswUP_allsky]
standard_name = RRTMGP_sw_flux_profile_upward_allsky
long_name = RRTMGP upward shortwave all-sky flux profile
Expand Down
5 changes: 2 additions & 3 deletions physics/GFS_rrtmgp_sw_pre.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ module GFS_rrtmgp_sw_pre
cdfnor ! Routine to compute CDF (used to compute percentiles)
use mo_gas_optics_rrtmgp, only: &
ty_gas_optics_rrtmgp
use rrtmgp_sw_gas_optics, only: sw_gas_props
public GFS_rrtmgp_sw_pre_run,GFS_rrtmgp_sw_pre_init,GFS_rrtmgp_sw_pre_finalize

contains
Expand All @@ -29,7 +30,7 @@ end subroutine GFS_rrtmgp_sw_pre_init
subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, &
lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, &
tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, &
sfc_wts, p_lay, tv_lay, relhum, p_lev, sw_gas_props, nday, idxday, coszen, coszdg, &
sfc_wts, p_lay, tv_lay, relhum, p_lev, nday, idxday, coszen, coszdg, &
sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, &
errmsg, errflg)

Expand Down Expand Up @@ -76,8 +77,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_
relhum ! Layer relative-humidity
real(kind_phys), dimension(nCol,nLev+1),intent(in) :: &
p_lev ! Pressure @ layer interfaces (Pa)
type(ty_gas_optics_rrtmgp),intent(in) :: &
sw_gas_props ! RRTMGP DDT: spectral information for SW calculation

! Outputs
integer, intent(out) :: &
Expand Down
Loading