Skip to content

Commit

Permalink
Hotfix for RRTMGP using multiple threads (#247)
Browse files Browse the repository at this point in the history
Changes to the initialization and setup of the RRTMGP radiation scheme to allow for use across multiple OpenMP threads.
* Moved Interstitial RRTMGP DDTs (ty_rrtmgp_gas_optics, ty_cloud_optics) to static fields defined during initialization in module memory.
* Add "$omp critical" statements around the calling type-bound procedures during initialization.
* Move allocation of ty_gas_conc from Interstitial to GFS_typedefs. Initialize ty_gas_concs for all blocks during initialization.
  • Loading branch information
dustinswales authored Feb 24, 2021
1 parent 70e55f2 commit 4908898
Show file tree
Hide file tree
Showing 3 changed files with 26 additions and 5 deletions.
15 changes: 11 additions & 4 deletions ccpp/data/GFS_typedefs.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2022,6 +2022,8 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: dudt_tms(:,:) => null() !< daily aver u-wind tend due to TMS

! RRTMGP
real (kind=kind_phys) :: minGPpres !< Minimum pressure allowed by RRTMGP.
real (kind=kind_phys) :: minGPtemp !< Minimum temperature allowed by RRTMGP.
integer :: ipsdlw0 !<
integer :: ipsdsw0 !<
real (kind=kind_phys), pointer :: p_lay(:,:) => null() !<
Expand Down Expand Up @@ -2071,10 +2073,6 @@ module GFS_typedefs
integer, pointer :: icseed_sw(:) => null() !< RRTMGP seed for RNG for shortwave radiation
type(proflw_type), pointer :: flxprf_lw(:,:) => null() !< DDT containing RRTMGP longwave fluxes
type(profsw_type), pointer :: flxprf_sw(:,:) => null() !< DDT containing RRTMGP shortwave fluxes
type(ty_gas_optics_rrtmgp) :: lw_gas_props !< RRTMGP DDT
type(ty_gas_optics_rrtmgp) :: sw_gas_props !< RRTMGP DDT
type(ty_cloud_optics) :: lw_cloud_props !< RRTMGP DDT
type(ty_cloud_optics) :: sw_cloud_props !< RRTMGP DDT
type(ty_optical_props_2str) :: lw_optical_props_cloudsByBand !< RRTMGP DDT
type(ty_optical_props_2str) :: lw_optical_props_clouds !< RRTMGP DDT
type(ty_optical_props_2str) :: lw_optical_props_precipByBand !< RRTMGP DDT
Expand Down Expand Up @@ -6155,6 +6153,7 @@ subroutine interstitial_create (Interstitial, IM, Model)
class(GFS_interstitial_type) :: Interstitial
integer, intent(in) :: IM
type(GFS_control_type), intent(in) :: Model
integer :: iGas
!
allocate (Interstitial%otspt (Model%ntracp1,2))
! Set up numbers of tracers for PBL, convection, etc: sets
Expand Down Expand Up @@ -6438,6 +6437,14 @@ subroutine interstitial_create (Interstitial, IM, Model)
allocate (Interstitial%toa_src_sw (IM,Model%rrtmgp_nGptsSW))
allocate (Interstitial%toa_src_lw (IM,Model%rrtmgp_nGptsLW))
allocate (Interstitial%active_gases_array (Model%nGases))
! ty_gas_concs
Interstitial%gas_concentrations%ncol = IM
Interstitial%gas_concentrations%nlay = Model%levs
allocate(Interstitial%gas_concentrations%gas_name(Model%nGases))
allocate(Interstitial%gas_concentrations%concs(Model%nGases))
do iGas=1,Model%nGases
allocate(Interstitial%gas_concentrations%concs(iGas)%conc(IM, Model%levs))
enddo
end if

! UGWP common
Expand Down
14 changes: 14 additions & 0 deletions ccpp/data/GFS_typedefs.meta
Original file line number Diff line number Diff line change
Expand Up @@ -10135,6 +10135,20 @@
type = real
kind = kind_phys
active = (flag_for_rrtmgp_radiation_scheme)
[minGPpres]
standard_name = minimum_pressure_in_RRTMGP
long_name = minimum pressure allowed in RRTMGP
units = Pa
dimensions = ()
type = real
kind = kind_phys
[minGPtemp]
standard_name = minimum_temperature_in_RRTMGP
long_name = minimum temperature allowed in RRTMGP
units = K
dimensions = ()
type = real
kind = kind_phys
[ipsdsw0]
standard_name = initial_permutation_seed_sw
long_name = initial seed for McICA SW
Expand Down

0 comments on commit 4908898

Please sign in to comment.