Skip to content

Commit

Permalink
Debug array alloc ccpp caps (NCAR#407)
Browse files Browse the repository at this point in the history 
This PR and associated PRs for ccpp-framework and ccpp-physics
-enable debugging features in auto-generated CCPP physics caps
-cleanup variables for Ferrier-Aligo and RRTMGP in GFS_typedefs.{F90,meta}
-contain bugfixes for multigases array dimensions in CCPP_typedefs.{F90,meta}
-and contain additional bug fixes in CCPP metadata in GFS_typedefs.{F90,meta}
  • Loading branch information
@climbfuji
climbfuji authored Oct 25, 2021
1 parent 43c0982 commit b96f38d
Show file tree
Hide file tree
Showing 7 changed files with 49 additions and 158 deletions.
5 changes: 4 additions & 1 deletion ccpp/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,10 @@ list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/framework/cmake")
#------------------------------------------------------------------------------
# Call to CCPP code generator
if(DEBUG)
# Enable debugging features in auto-generated physics caps
set(_ccpp_debug_arg "--debug")
# Enable verbose output from ccpp_prebuild.py
set(_ccpp_verbose_arg "--verbose")
endif()
if(DEFINED CCPP_SUITES)
set(_ccpp_suites_arg "--suites=${CCPP_SUITES}")
Expand All @@ -31,7 +34,7 @@ endif()
execute_process(COMMAND ${Python_EXECUTABLE}
"framework/scripts/ccpp_prebuild.py"
"--config=config/ccpp_prebuild_config.py"
"--builddir=${CMAKE_CURRENT_BINARY_DIR}" ${_ccpp_suites_arg} ${_ccpp_debug_arg}
"--builddir=${CMAKE_CURRENT_BINARY_DIR}" ${_ccpp_suites_arg} ${_ccpp_debug_arg} ${_ccpp_verbose_arg}
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
OUTPUT_FILE ${CMAKE_CURRENT_BINARY_DIR}/ccpp_prebuild.out
ERROR_FILE ${CMAKE_CURRENT_BINARY_DIR}/ccpp_prebuild.err
Expand Down
12 changes: 6 additions & 6 deletions ccpp/data/CCPP_typedefs.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -219,18 +219,18 @@ subroutine interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd, jed
! For multi-gases physics
Interstitial%nwat = nwat
! If ngas, rilist and cpilist are present, then
! multi-gases physics are used. If not, set ngas=1
! multi-gases physics are used. If not, set ngas=0
! (safe value), allocate rilist/cpilist and set to zero
if(present(ngas)) then
Interstitial%ngas = ngas
else
Interstitial%ngas = 1
Interstitial%ngas = 0
end if
allocate(Interstitial%rilist(1:Interstitial%ngas))
allocate(Interstitial%cpilist(1:Interstitial%ngas))
allocate(Interstitial%rilist(0:Interstitial%ngas))
allocate(Interstitial%cpilist(0:Interstitial%ngas))
if (present(rilist)) then
Interstitial%rilist = rilist(1:Interstitial%ngas)
Interstitial%cpilist = cpilist(1:Interstitial%ngas)
Interstitial%rilist = rilist(0:Interstitial%ngas)
Interstitial%cpilist = cpilist(0:Interstitial%ngas)
else
Interstitial%rilist = 0.0
Interstitial%cpilist = 0.0
Expand Down
3 changes: 2 additions & 1 deletion ccpp/data/CCPP_typedefs.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -228,9 +228,10 @@
standard_name = gas_tracers_for_multi_gas_physics_at_Lagrangian_surface
long_name = gas tracers for multi gas physics at Lagrangian surface
units = kg kg-1
dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics,1:number_of_gases_for_multi_gases_physics)
dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics,0:number_of_gases_for_multi_gases_physics)
type = real
kind = kind_dyn
active = (number_of_gases_for_multi_gases_physics > 0)
[qv]
standard_name = water_vapor_specific_humidity_at_Lagrangian_surface
long_name = water vapor specific humidity updated by fast physics at Lagrangian surface
Expand Down
76 changes: 18 additions & 58 deletions ccpp/data/GFS_typedefs.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -739,7 +739,7 @@ module GFS_typedefs
integer :: rrtmgp_nrghice !< Number of ice-roughness categories
integer :: rrtmgp_nGauss_ang !< Number of angles used in Gaussian quadrature
logical :: do_GPsw_Glw !< If set to true use rrtmgp for SW calculation, rrtmg for LW.
character(len=128) :: active_gases_array(100) !< character array for each trace gas name
character(len=128), pointer :: active_gases_array(:) => null() !< character array for each trace gas name
logical :: use_LW_jacobian !< If true, use Jacobian of LW to update radiation tendency.
logical :: damp_LW_fluxadj !< If true, damp the LW flux adjustment using the Jacobian w/ height with logistic function
real(kind_phys) :: lfnc_k !< Logistic function transition depth (Pa)
Expand Down Expand Up @@ -1153,8 +1153,8 @@ module GFS_typedefs
integer :: n_var_lndp
logical :: lndp_each_step ! flag to indicate that land perturbations are applied at every time step,
! otherwise they are applied only after gcycle is run
character(len=3) :: lndp_var_list(6) ! dimension here must match n_var_max_lndp in stochy_nml_def
real(kind=kind_phys) :: lndp_prt_list(6) ! dimension here must match n_var_max_lndp in stochy_nml_def
character(len=3) , pointer :: lndp_var_list(:) ! dimension here must match n_var_max_lndp in stochy_nml_def
real(kind=kind_phys), pointer :: lndp_prt_list(:) ! dimension here must match n_var_max_lndp in stochy_nml_def
! also previous code had dimension 5 for each pert, to allow
! multiple patterns. It wasn't fully coded (and wouldn't have worked
! with nlndp>1, so I just dropped it). If we want to code it properly,
Expand Down Expand Up @@ -2165,7 +2165,6 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: sfc_alb_uvvis_dif(:,:) => null() !<
real (kind=kind_phys), pointer :: toa_src_lw(:,:) => null() !<
real (kind=kind_phys), pointer :: toa_src_sw(:,:) => null() !<
character(len=128), pointer :: active_gases_array(:) => null() !< Character array for each trace gas name
integer, pointer :: icseed_lw(:) => null() !< RRTMGP seed for RNG for longwave radiation
integer, pointer :: icseed_sw(:) => null() !< RRTMGP seed for RNG for shortwave radiation
type(proflw_type), pointer :: flxprf_lw(:,:) => null() !< DDT containing RRTMGP longwave fluxes
Expand All @@ -2185,26 +2184,12 @@ module GFS_typedefs
type(ty_gas_concs) :: gas_concentrations !< RRTMGP DDT
type(ty_source_func_lw) :: sources !< RRTMGP DDT

!-- HWRF physics: dry mixing ratios
real (kind=kind_phys), pointer :: qv_r(:,:) => null() !<
real (kind=kind_phys), pointer :: qc_r(:,:) => null() !<
real (kind=kind_phys), pointer :: qi_r(:,:) => null() !<
real (kind=kind_phys), pointer :: qr_r(:,:) => null() !<
real (kind=kind_phys), pointer :: qs_r(:,:) => null() !<
real (kind=kind_phys), pointer :: qg_r(:,:) => null() !<

!-- GSL drag suite
real (kind=kind_phys), pointer :: varss(:) => null() !<
real (kind=kind_phys), pointer :: ocss(:) => null() !<
real (kind=kind_phys), pointer :: oa4ss(:,:) => null() !<
real (kind=kind_phys), pointer :: clxss(:,:) => null() !<

!-- Ferrier-Aligo MP scheme
real (kind=kind_phys), pointer :: f_rain (:,:) => null() !<
real (kind=kind_phys), pointer :: f_ice (:,:) => null() !<
real (kind=kind_phys), pointer :: f_rimef (:,:) => null() !<
real (kind=kind_phys), pointer :: cwm (:,:) => null() !<

!-- 3D diagnostics
integer :: rtg_ozone_index, rtg_tke_index

Expand Down Expand Up @@ -3010,7 +2995,7 @@ subroutine coupling_create (Coupling, IM, Model)
endif

!--- stochastic land perturbation option
if (Model%lndp_type .NE. 0) then
if (Model%lndp_type /= 0) then
allocate (Coupling%sfc_wts (IM,Model%n_var_lndp))
Coupling%sfc_wts = clear_val
endif
Expand Down Expand Up @@ -3964,6 +3949,13 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
Model%do_GPsw_Glw = do_GPsw_Glw
Model%active_gases = active_gases
Model%ngases = nGases
if (Model%do_RRTMGP) then
allocate (Model%active_gases_array(Model%nGases))
! Reset, will be populated by RRTMGP
do ipat=1,Model%nGases
Model%active_gases_array(ipat) = ''
enddo
endif
Model%rrtmgp_root = rrtmgp_root
Model%lw_file_gas = lw_file_gas
Model%lw_file_clouds = lw_file_clouds
Expand Down Expand Up @@ -4420,10 +4412,16 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
Model%use_zmtnblck = use_zmtnblck
Model%do_shum = do_shum
Model%do_skeb = do_skeb
!--- stochastic surface perturbation options
Model%lndp_type = lndp_type
Model%n_var_lndp = n_var_lndp
Model%lndp_each_step = lndp_each_step

if (Model%lndp_type/=0) then
allocate(Model%lndp_var_list(Model%n_var_lndp))
allocate(Model%lndp_prt_list(Model%n_var_lndp))
Model%lndp_var_list(:) = ''
Model%lndp_prt_list(:) = clear_val
end if
!--- cellular automata options
! force namelist constsitency
allocate(Model%vfact_ca(levs))
Expand Down Expand Up @@ -7200,7 +7198,6 @@ subroutine interstitial_create (Interstitial, IM, Model)
allocate (Interstitial%sfc_alb_uvvis_dif (Model%rrtmgp_nBandsSW,IM))
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))
!
! gas_concentrations (ty_gas_concs)
!
Expand Down Expand Up @@ -7328,21 +7325,6 @@ subroutine interstitial_create (Interstitial, IM, Model)
allocate (Interstitial%cnv_ndrop (IM,Model%levs))
allocate (Interstitial%cnv_nice (IM,Model%levs))
end if
if (Model%imp_physics == Model%imp_physics_fer_hires) then
!--- if HWRF physics?
allocate (Interstitial%qv_r (IM,Model%levs))
allocate (Interstitial%qc_r (IM,Model%levs))
allocate (Interstitial%qi_r (IM,Model%levs))
allocate (Interstitial%qr_r (IM,Model%levs))
allocate (Interstitial%qs_r (IM,Model%levs))
allocate (Interstitial%qg_r (IM,Model%levs))

!--- Ferrier-Aligo MP scheme
allocate (Interstitial%f_ice (IM,Model%levs))
allocate (Interstitial%f_rain (IM,Model%levs))
allocate (Interstitial%f_rimef (IM,Model%levs))
allocate (Interstitial%cwm (IM,Model%levs))
end if
if (Model%do_shoc) then
if (.not. associated(Interstitial%qrn)) allocate (Interstitial%qrn (IM,Model%levs))
if (.not. associated(Interstitial%qsnw)) allocate (Interstitial%qsnw (IM,Model%levs))
Expand Down Expand Up @@ -7609,22 +7591,6 @@ subroutine interstitial_rad_reset (Interstitial, Model)
Interstitial%tsfa = clear_val
Interstitial%tsfg = clear_val

! F-A scheme
if (Model%imp_physics == Model%imp_physics_fer_hires) then
Interstitial%qv_r = clear_val
Interstitial%qc_r = clear_val
Interstitial%qi_r = clear_val
Interstitial%qr_r = clear_val
Interstitial%qs_r = clear_val
Interstitial%qg_r = clear_val
if(Model%spec_adv) then
Interstitial%f_ice = clear_val
Interstitial%f_rain = clear_val
Interstitial%f_rimef = clear_val
Interstitial%cwm = clear_val
end if
end if

if (Model%do_RRTMGP) then
Interstitial%tracer = clear_val
Interstitial%tv_lay = clear_val
Expand Down Expand Up @@ -7936,12 +7902,6 @@ subroutine interstitial_phys_reset (Interstitial, Model)
Interstitial%cnv_ndrop = clear_val
Interstitial%cnv_nice = clear_val
end if
if (Model%imp_physics == Model%imp_physics_fer_hires .and. Model%spec_adv) then
Interstitial%f_ice = clear_val
Interstitial%f_rain = clear_val
Interstitial%f_rimef = clear_val
Interstitial%cwm = clear_val
end if
if (Model%do_shoc) then
Interstitial%qrn = clear_val
Interstitial%qsnw = clear_val
Expand Down
Loading

0 comments on commit b96f38d

Please sign in to comment.