From 4908898cdd71a84cef482a7e6c330697a39c7378 Mon Sep 17 00:00:00 2001
From: dustinswales <dustin.swales@noaa.gov>
Date: Wed, 24 Feb 2021 15:27:26 -0700
Subject: [PATCH] Hotfix for RRTMGP using multiple threads (#247)

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.
---
 ccpp/data/GFS_typedefs.F90  | 15 +++++++++++----
 ccpp/data/GFS_typedefs.meta | 14 ++++++++++++++
 ccpp/physics                |  2 +-
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90
index f91fdc06f..d4ab334d9 100644
--- a/ccpp/data/GFS_typedefs.F90
+++ b/ccpp/data/GFS_typedefs.F90
@@ -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()  !<
@@ -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
@@ -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
@@ -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
diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta
index f39248d4c..a3a1a08f5 100644
--- a/ccpp/data/GFS_typedefs.meta
+++ b/ccpp/data/GFS_typedefs.meta
@@ -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
diff --git a/ccpp/physics b/ccpp/physics
index d884fb105..869dfaaf9 160000
--- a/ccpp/physics
+++ b/ccpp/physics
@@ -1 +1 @@
-Subproject commit d884fb105bc138216f5f213d43ee05b0481a030e
+Subproject commit 869dfaaf9c0fad932dc032a180e02ed50f4b2002