Merge pull request NCAR#70 from dustinswales/bugfix_rrtmgp_threading

Fix to allow for threading in RRTMGP
dustinswales · Jun 8, 2023 · 8cb1643 · 8cb1643
2 parents 3a306a4 + 81e3f5e
commit 8cb1643
Show file tree

Hide file tree

Showing 3 changed files with 66 additions and 71 deletions.
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -159,13 +159,6 @@ if(CMAKE_BUILD_TYPE STREQUAL "Release" AND ${CMAKE_Fortran_COMPILER_ID} STREQUAL
   endforeach()
 endif()
 
-# Reduce optimization for mo_gas_optics_kernels.F90 (to avoid an apparent compiler bug with Intel 19+)
-if(${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 IN_LIST SCHEMES_OPENMP_OFF AND
-   CMAKE_BUILD_TYPE STREQUAL "Release" AND ${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
-  SET_SOURCE_FILES_PROPERTIES(${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90
-                              APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PHYSICS} -O1")
-endif()
-
 #------------------------------------------------------------------------------
 
 add_library(ccpp_physics STATIC ${SCHEMES} ${SCHEMES_OPENMP_OFF} ${SCHEMES_DYNAMICS} ${CAPS})

diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90
@@ -27,13 +27,6 @@ module rrtmgp_lw_main
   use rrtmgp_sampling,        only: sampled_mask, draw_samples
   implicit none
 
-  type(ty_gas_concs)          :: gas_concs
-  type(ty_optical_props_1scl) :: lw_optical_props_clrsky, lw_optical_props_aerosol_local
-  type(ty_optical_props_2str) :: lw_optical_props_clouds, lw_optical_props_cloudsByBand,    &
-       lw_optical_props_cnvcloudsByBand, lw_optical_props_pblcloudsByBand,                  &
-       lw_optical_props_precipByBand
-  type(ty_source_func_lw)     :: sources 
-
   public rrtmgp_lw_main_init, rrtmgp_lw_main_run
 contains
   ! #########################################################################################
@@ -94,33 +87,6 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi
          doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot,    &
          errmsg, errflg)
 
-    ! DDTs
-
-    ! ty_gas_concs
-    call check_error_msg('rrtmgp_lw_main_gas_concs_init',gas_concs%init(active_gases_array))
-
-    ! ty_optical_props
-    call check_error_msg('rrtmgp_lw_main_gas_optics_init',&
-         lw_optical_props_clrsky%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props))
-    call check_error_msg('rrtmgp_lw_main_sources_init',&
-         sources%alloc(rrtmgp_phys_blksz, nLay, lw_gas_props))
-    call check_error_msg('rrtmgp_lw_main_cloud_optics_init',&
-         lw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
-    call check_error_msg('rrtmgp_lw_main_precip_optics_init',&
-         lw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
-    call check_error_msg('rrtmgp_lw_mian_cloud_sampling_init', &
-         lw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props))
-    call check_error_msg('rrtmgp_lw_main_aerosol_optics_init',&
-         lw_optical_props_aerosol_local%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
-    if (doGP_sgs_cnv) then
-       call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics_init',&
-            lw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
-    endif
-    if (doGP_sgs_pbl) then
-       call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics_init',&
-            lw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
-    endif
-
   end subroutine rrtmgp_lw_main_init
 !> @}
   ! ######################################################################################
@@ -242,12 +208,49 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
     real(kind_phys), dimension(rrtmgp_phys_blksz,lw_gas_props%get_ngpt()) :: lw_Ds
     real(kind_phys), dimension(lw_gas_props%get_nband(),rrtmgp_phys_blksz) :: sfc_emiss_byband
 
+    ! Local RRTMGP DDTs.
+    type(ty_gas_concs)          :: gas_concs
+    type(ty_optical_props_1scl) :: lw_optical_props_clrsky, lw_optical_props_aerosol_local
+    type(ty_optical_props_2str) :: lw_optical_props_clouds, lw_optical_props_cloudsByBand,    &
+         lw_optical_props_cnvcloudsByBand, lw_optical_props_pblcloudsByBand,                  &
+         lw_optical_props_precipByBand
+    type(ty_source_func_lw)     :: sources 
+
     ! Initialize CCPP error handling variables
     errmsg = ''
     errflg = 0
 
     if (.not. doLWrad) return
 
+    !
+    ! Initialize RRTMGP DDTs (local)
+    !
+
+    ! ty_gas_concs
+    call check_error_msg('rrtmgp_lw_main_gas_concs_run',gas_concs%init(active_gases_array))
+
+    ! ty_optical_props
+    call check_error_msg('rrtmgp_lw_main_gas_optics_run',&
+         lw_optical_props_clrsky%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props))
+    call check_error_msg('rrtmgp_lw_main_sources_run',&
+         sources%alloc(rrtmgp_phys_blksz, nLay, lw_gas_props))
+    call check_error_msg('rrtmgp_lw_main_cloud_optics_run',&
+         lw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+    call check_error_msg('rrtmgp_lw_main_precip_optics_run',&
+         lw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+    call check_error_msg('rrtmgp_lw_mian_cloud_sampling_run', &
+         lw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props))
+    call check_error_msg('rrtmgp_lw_main_aerosol_optics_run',&
+         lw_optical_props_aerosol_local%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+    if (doGP_sgs_cnv) then
+       call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics_run',&
+            lw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+    endif
+    if (doGP_sgs_pbl) then
+       call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics_run',&
+            lw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+    endif
+
     ! ######################################################################################
     !
     ! Loop over all columns...

diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90
@@ -20,12 +20,6 @@ module rrtmgp_sw_main
   use rrtmgp_sampling,        only: sampled_mask, draw_samples
   implicit none
 
-  type(ty_gas_concs)          :: gas_concs
-  type(ty_optical_props_2str) :: sw_optical_props_accum, sw_optical_props_aerosol_local,    &
-       sw_optical_props_cloudsByBand, sw_optical_props_cnvcloudsByBand,                     &
-       sw_optical_props_pblcloudsByBand, sw_optical_props_precipByBand,                     &
-       sw_optical_props_clouds
-
   public rrtmgp_sw_main_init, rrtmgp_sw_main_run
 
 contains
@@ -80,30 +74,6 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi
          doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot,      &
          errmsg, errflg)
 
-    ! DDTs
-
-    ! ty_gas_concs
-    call check_error_msg('rrtmgp_sw_main_gas_concs_init',gas_concs%init(active_gases_array))
-
-    ! ty_optical_props
-    call check_error_msg('rrtmgp_sw_main_accumulated_optics_init',&
-         sw_optical_props_accum%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props))
-    call check_error_msg('rrtmgp_sw_main_cloud_optics_init',&
-         sw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
-    call check_error_msg('rrtmgp_sw_main_precip_optics_init',&
-         sw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
-    call check_error_msg('rrtmgp_sw_mian_cloud_sampling_init', &
-         sw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props))
-    call check_error_msg('rrtmgp_sw_main_aerosol_optics_init',&
-         sw_optical_props_aerosol_local%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
-    if (doGP_sgs_cnv) then
-       call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics_init',&
-            sw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
-    endif
-    if (doGP_sgs_pbl) then
-       call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics_init',&
-            sw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
-    endif
   end subroutine rrtmgp_sw_main_init
 
   ! #########################################################################################
@@ -241,12 +211,41 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_
          uvb_bnd       = (/29000,38000/)
     real(kind_phys), dimension(rrtmgp_phys_blksz,sw_gas_props%get_ngpt()) :: toa_src_sw
 
+    type(ty_gas_concs)          :: gas_concs
+    type(ty_optical_props_2str) :: sw_optical_props_accum, sw_optical_props_aerosol_local,    &
+         sw_optical_props_cloudsByBand, sw_optical_props_cnvcloudsByBand,                     &
+         sw_optical_props_pblcloudsByBand, sw_optical_props_precipByBand,                     &
+         sw_optical_props_clouds
+
     ! Initialize CCPP error handling variables
     errmsg = ''
     errflg = 0
 
     if (.not. doSWrad) return
 
+    ! ty_gas_concs
+    call check_error_msg('rrtmgp_sw_main_gas_concs_init',gas_concs%init(active_gases_array))
+
+    ! ty_optical_props
+    call check_error_msg('rrtmgp_sw_main_accumulated_optics_init',&
+         sw_optical_props_accum%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props))
+    call check_error_msg('rrtmgp_sw_main_cloud_optics_init',&
+         sw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
+    call check_error_msg('rrtmgp_sw_main_precip_optics_init',&
+         sw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
+    call check_error_msg('rrtmgp_sw_mian_cloud_sampling_init', &
+         sw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props))
+    call check_error_msg('rrtmgp_sw_main_aerosol_optics_init',&
+         sw_optical_props_aerosol_local%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
+    if (doGP_sgs_cnv) then
+       call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics_init',&
+            sw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
+    endif
+    if (doGP_sgs_pbl) then
+       call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics_init',&
+            sw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
+    endif
+
     if (nDay .gt. 0) then
 
        bandlimits = sw_gas_props%get_band_lims_wavenumber()