From e5e90d8be6d6d2447a29fb96f887441d41ae3066 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Thu, 4 Sep 2025 12:07:41 -0400 Subject: [PATCH 1/3] fix endrun exit issue --- .../CLM51/shr_abort_mod.F90 | 38 ++++++------------- 1 file changed, 12 insertions(+), 26 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index bc97791a4..30b0c0201 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -38,21 +38,15 @@ module shr_abort_mod contains !=============================================================================== - subroutine shr_abort_abort(string,ec,rc) - ! Consistent stopping mechanism - + subroutine shr_abort_abort(string, ec, rc) !----- arguments ----- - character(len=*) , intent(in) , optional :: string ! error message string - integer(shr_kind_in), intent(in) , optional :: ec ! error code - integer(shr_kind_in), intent(out), optional :: rc ! error code - - !----- local ----- - !logical :: flag + character(len=*), intent(in), optional :: string + integer(shr_kind_in), intent(in), optional :: ec + integer(shr_kind_in), intent(out), optional :: rc - ! Local version of the string. - ! (Gets a default value if string is not present.) + !----- local ----- character(len=shr_kind_cx) :: local_string - !------------------------------------------------------------------------------- + integer :: exit_code if (present(string)) then local_string = trim(string) @@ -60,24 +54,16 @@ subroutine shr_abort_abort(string,ec,rc) local_string = "Unknown error submitted to shr_abort_abort." end if + ! Log to stdout/stderr and flush. call print_error_to_logs("ERROR", local_string) - ! call shr_abort_backtrace() - -! call shr_mpi_initialized(flag) - - if (present(ec)) then - _ASSERT(.FALSE.,trim(local_string)) - else - _ASSERT(.FALSE.,trim(local_string)) - endif - - ! A compiler's abort method may print a backtrace or do other nice - ! things, but in fact we can rarely leverage this, because MPI_Abort - ! usually sends SIGTERM to the process, and we don't catch that signal. - !call abort() + exit_code = 1 + if (present(ec)) exit_code = ec + if (present(rc)) rc = exit_code + error stop "shr_abort_abort: hard abort" ! prints and exits nonzero end subroutine shr_abort_abort + !=============================================================================== !=============================================================================== From 6c66c3976bfc821520ce6f582c9f3d390afb84d7 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 4 Sep 2025 13:16:00 -0400 Subject: [PATCH 2/3] attempt to fix abort in a way that is consistent with GEOS (CNBalanceCheckMod.F90, abortutils.F90, shr_abort_mod.F90) --- .../CLM51/CNBalanceCheckMod.F90 | 17 ++++++-- .../CLM51/abortutils.F90 | 16 ++++++-- .../CLM51/shr_abort_mod.F90 | 40 ++++++++++++------- 3 files changed, 51 insertions(+), 22 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 index c10a48c9c..11a1e39aa 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 @@ -5,6 +5,9 @@ module CNBalanceCheckMod ! Module for carbon/nitrogen mass balance checking. ! ! !USES: + + use ESMF + use shr_kind_mod , only : r8 => shr_kind_r8 use nanMod , only : nan use shr_log_mod , only : errMsg => shr_log_errMsg @@ -220,6 +223,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & real(r8) :: som_c_leached_grc(bounds%begg:bounds%endg) real(r8) :: hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg) real(r8) :: dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg) + integer :: rc !----------------------------------------------------------------------- associate( & @@ -307,7 +311,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*)'wood_harvestc = ',wood_harvestc(c)*dt write(iulog,*)'grainc_to_cropprodc = ',grainc_to_cropprodc(c)*dt write(iulog,*)'-1*som_c_leached = ',som_c_leached(c)*dt - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun(msg=errMsg(sourcefile, __LINE__),rc) end if ! Repeat error check at the gridcell level @@ -379,11 +383,13 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*)'dwt_seedc_to_deadstem_grc =', dwt_seedc_to_deadstem_grc(g) * dt write(iulog,*)'--- Outputs ---' write(iulog,*)'-1*som_c_leached_grc = ', som_c_leached_grc(g) * dt - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun(msg=errMsg(sourcefile, __LINE__),rc) end if end associate + RETURN_(ESMF_SUCCESS) + end subroutine CBalanceCheck !----------------------------------------------------------------------- @@ -426,6 +432,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & real(r8):: grc_ninputs(bounds%begg:bounds%endg) real(r8):: grc_noutputs(bounds%begg:bounds%endg) real(r8):: grc_errnb(bounds%begg:bounds%endg) + integer :: rc !----------------------------------------------------------------------- associate( & @@ -545,7 +552,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun(msg=errMsg(sourcefile, __LINE__),rc) end if ! Repeat error check at the gridcell level @@ -619,11 +626,13 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*) 'grc_noutputs_partial =', grc_noutputs_partial(g) * dt write(iulog,*) 'dwt_conv_nflux_grc =', dwt_conv_nflux_grc(g) * dt write(iulog,*) 'product_loss_grc =', product_loss_grc(g) * dt - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun(msg=errMsg(sourcefile, __LINE__),rc) end if end associate + RETURN_(ESMF_SUCCESS) + end subroutine NBalanceCheck end module CNBalanceCheckMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 index 0d6581540..9ccb9d712 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 @@ -7,6 +7,8 @@ module abortutils ! Abort the model for abnormal termination !----------------------------------------------------------------------- + use ESMF + private save @@ -20,7 +22,7 @@ module abortutils CONTAINS !----------------------------------------------------------------------- - subroutine endrun_vanilla(msg, additional_msg) + subroutine endrun_vanilla(msg, additional_msg, rc) !----------------------------------------------------------------------- ! !DESCRIPTION: @@ -39,6 +41,7 @@ subroutine endrun_vanilla(msg, additional_msg) ! and then just assert against msg. character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort + integer, intent(out),optional :: rc ! return code !----------------------------------------------------------------------- if (present (additional_msg)) then @@ -47,12 +50,14 @@ subroutine endrun_vanilla(msg, additional_msg) write(iulog,*)'ENDRUN:' end if - call shr_sys_abort(msg) + call shr_sys_abort(msg,rc) + + RETURN_(ESMF_SUCCESS) end subroutine endrun_vanilla !----------------------------------------------------------------------- - subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) + subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg, rc) !----------------------------------------------------------------------- ! Description: @@ -74,6 +79,7 @@ subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) ! and then just assert against msg. character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort + integer, intent(out),optional :: rc ! return code ! ! Local Variables: integer :: igrc, ilun, icol @@ -88,8 +94,10 @@ subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) write(iulog,*)'ENDRUN:' end if - call shr_sys_abort(msg) + call shr_sys_abort(msg, rc) + RETURN_(ESMF_SUCCESS) + end subroutine endrun_globalindex end module abortutils diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index 30b0c0201..01b6365fd 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -11,9 +11,10 @@ module shr_abort_mod use, intrinsic :: iso_fortran_env, only: output_unit, error_unit + use ESMF use MAPL_ExceptionHandling use shr_kind_mod, only : shr_kind_in, shr_kind_cx -! use shr_mpi_mod , only : shr_mpi_initialized, shr_mpi_abort + !use shr_mpi_mod , only : shr_mpi_initialized, shr_mpi_abort use shr_log_mod , only : s_logunit => shr_log_Unit !#ifdef CPRNAG @@ -33,20 +34,25 @@ module shr_abort_mod ! (shr_sys_abort, shr_sys_backtrace). (This is for consistency with older code, from ! when these routines were defined in shr_sys_mod.) public :: shr_abort_abort ! abort a program - ! public :: shr_abort_backtrace ! print a backtrace, if possible + !public :: shr_abort_backtrace ! print a backtrace, if possible contains !=============================================================================== - subroutine shr_abort_abort(string, ec, rc) - !----- arguments ----- - character(len=*), intent(in), optional :: string - integer(shr_kind_in), intent(in), optional :: ec - integer(shr_kind_in), intent(out), optional :: rc + subroutine shr_abort_abort(string,rc) + ! Consistent stopping mechanism + !----- arguments ----- + character(len=*) , intent(in) , optional :: string ! error message string + integer(shr_kind_in), intent(out), optional :: rc ! return code + !----- local ----- + !logical :: flag + + ! Local version of the string. + ! (Gets a default value if string is not present.) character(len=shr_kind_cx) :: local_string - integer :: exit_code + !------------------------------------------------------------------------------- if (present(string)) then local_string = trim(string) @@ -54,16 +60,22 @@ subroutine shr_abort_abort(string, ec, rc) local_string = "Unknown error submitted to shr_abort_abort." end if - ! Log to stdout/stderr and flush. call print_error_to_logs("ERROR", local_string) - exit_code = 1 - if (present(ec)) exit_code = ec - if (present(rc)) rc = exit_code + !call shr_abort_backtrace() - error stop "shr_abort_abort: hard abort" ! prints and exits nonzero - end subroutine shr_abort_abort + !call shr_mpi_initialized(flag) + + _ASSERT(.FALSE.,trim(local_string)) + ! A compiler's abort method may print a backtrace or do other nice + ! things, but in fact we can rarely leverage this, because MPI_Abort + ! usually sends SIGTERM to the process, and we don't catch that signal. + !call abort() + + RETURN_(ESMF_SUCCESS) + + end subroutine shr_abort_abort !=============================================================================== !=============================================================================== From 6e02675b47f6236964a200d8d1b04507ca10b397 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 4 Sep 2025 14:31:44 -0400 Subject: [PATCH 3/3] revert to CTSM abort (CNBalanceCheckMod.F90, abortutils.F90, shr_abort_mod.F90) --- .../CLM51/CNBalanceCheckMod.F90 | 17 +-- .../CLM51/abortutils.F90 | 22 +-- .../CLM51/shr_abort_mod.F90 | 140 +++++++++--------- 3 files changed, 81 insertions(+), 98 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 index 11a1e39aa..c10a48c9c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/CNBalanceCheckMod.F90 @@ -5,9 +5,6 @@ module CNBalanceCheckMod ! Module for carbon/nitrogen mass balance checking. ! ! !USES: - - use ESMF - use shr_kind_mod , only : r8 => shr_kind_r8 use nanMod , only : nan use shr_log_mod , only : errMsg => shr_log_errMsg @@ -223,7 +220,6 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & real(r8) :: som_c_leached_grc(bounds%begg:bounds%endg) real(r8) :: hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg) real(r8) :: dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg) - integer :: rc !----------------------------------------------------------------------- associate( & @@ -311,7 +307,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*)'wood_harvestc = ',wood_harvestc(c)*dt write(iulog,*)'grainc_to_cropprodc = ',grainc_to_cropprodc(c)*dt write(iulog,*)'-1*som_c_leached = ',som_c_leached(c)*dt - call endrun(msg=errMsg(sourcefile, __LINE__),rc) + call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! Repeat error check at the gridcell level @@ -383,13 +379,11 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*)'dwt_seedc_to_deadstem_grc =', dwt_seedc_to_deadstem_grc(g) * dt write(iulog,*)'--- Outputs ---' write(iulog,*)'-1*som_c_leached_grc = ', som_c_leached_grc(g) * dt - call endrun(msg=errMsg(sourcefile, __LINE__),rc) + call endrun(msg=errMsg(sourcefile, __LINE__)) end if end associate - RETURN_(ESMF_SUCCESS) - end subroutine CBalanceCheck !----------------------------------------------------------------------- @@ -432,7 +426,6 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & real(r8):: grc_ninputs(bounds%begg:bounds%endg) real(r8):: grc_noutputs(bounds%begg:bounds%endg) real(r8):: grc_errnb(bounds%begg:bounds%endg) - integer :: rc !----------------------------------------------------------------------- associate( & @@ -552,7 +545,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & - call endrun(msg=errMsg(sourcefile, __LINE__),rc) + call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! Repeat error check at the gridcell level @@ -626,13 +619,11 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*) 'grc_noutputs_partial =', grc_noutputs_partial(g) * dt write(iulog,*) 'dwt_conv_nflux_grc =', dwt_conv_nflux_grc(g) * dt write(iulog,*) 'product_loss_grc =', product_loss_grc(g) * dt - call endrun(msg=errMsg(sourcefile, __LINE__),rc) + call endrun(msg=errMsg(sourcefile, __LINE__)) end if end associate - RETURN_(ESMF_SUCCESS) - end subroutine NBalanceCheck end module CNBalanceCheckMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 index 9ccb9d712..1afbce209 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/abortutils.F90 @@ -7,8 +7,6 @@ module abortutils ! Abort the model for abnormal termination !----------------------------------------------------------------------- - use ESMF - private save @@ -22,7 +20,7 @@ module abortutils CONTAINS !----------------------------------------------------------------------- - subroutine endrun_vanilla(msg, additional_msg, rc) + subroutine endrun_vanilla(msg, additional_msg) !----------------------------------------------------------------------- ! !DESCRIPTION: @@ -41,7 +39,6 @@ subroutine endrun_vanilla(msg, additional_msg, rc) ! and then just assert against msg. character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort - integer, intent(out),optional :: rc ! return code !----------------------------------------------------------------------- if (present (additional_msg)) then @@ -50,14 +47,12 @@ subroutine endrun_vanilla(msg, additional_msg, rc) write(iulog,*)'ENDRUN:' end if - call shr_sys_abort(msg,rc) - - RETURN_(ESMF_SUCCESS) + call shr_sys_abort(msg) end subroutine endrun_vanilla !----------------------------------------------------------------------- - subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg, rc) + subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) !----------------------------------------------------------------------- ! Description: @@ -65,7 +60,7 @@ subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg, rc) ! use shr_sys_mod , only: shr_sys_abort use clm_varctl , only: iulog - ! use GetGlobalValuesMod, only: GetGlobalWrite + !use GetGlobalValuesMod, only: GetGlobalWrite ! ! Arguments: implicit none @@ -79,14 +74,13 @@ subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg, rc) ! and then just assert against msg. character(len=*), intent(in), optional :: msg ! string to be passed to shr_sys_abort character(len=*), intent(in), optional :: additional_msg ! string to be printed, but not passed to shr_sys_abort - integer, intent(out),optional :: rc ! return code ! ! Local Variables: integer :: igrc, ilun, icol !----------------------------------------------------------------------- - ! write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel) - ! call GetGlobalWrite(decomp_index, clmlevel) + !write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel) + !call GetGlobalWrite(decomp_index, clmlevel) if (present (additional_msg)) then write(iulog,*)'ENDRUN: ', additional_msg @@ -94,10 +88,8 @@ subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg, rc) write(iulog,*)'ENDRUN:' end if - call shr_sys_abort(msg, rc) + call shr_sys_abort(msg) - RETURN_(ESMF_SUCCESS) - end subroutine endrun_globalindex end module abortutils diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 index 01b6365fd..9e4de5bd0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM51_GridComp/CLM51/shr_abort_mod.F90 @@ -1,5 +1,3 @@ -#include "MAPL_Generic.h" - module shr_abort_mod ! This module defines procedures that can be used to abort the model cleanly in a ! system-specific manner @@ -11,17 +9,15 @@ module shr_abort_mod use, intrinsic :: iso_fortran_env, only: output_unit, error_unit - use ESMF - use MAPL_ExceptionHandling use shr_kind_mod, only : shr_kind_in, shr_kind_cx - !use shr_mpi_mod , only : shr_mpi_initialized, shr_mpi_abort + use shr_mpi_mod , only : shr_mpi_initialized, shr_mpi_abort use shr_log_mod , only : s_logunit => shr_log_Unit -!#ifdef CPRNAG -! ! NAG does not provide this as an intrinsic, but it does provide modules -! ! that implement commonly used POSIX routines. -! use f90_unix_proc, only: abort -!#endif +#ifdef CPRNAG + ! NAG does not provide this as an intrinsic, but it does provide modules + ! that implement commonly used POSIX routines. + use f90_unix_proc, only: abort +#endif implicit none @@ -34,7 +30,7 @@ module shr_abort_mod ! (shr_sys_abort, shr_sys_backtrace). (This is for consistency with older code, from ! when these routines were defined in shr_sys_mod.) public :: shr_abort_abort ! abort a program - !public :: shr_abort_backtrace ! print a backtrace, if possible + public :: shr_abort_backtrace ! print a backtrace, if possible contains @@ -43,11 +39,11 @@ subroutine shr_abort_abort(string,rc) ! Consistent stopping mechanism !----- arguments ----- - character(len=*) , intent(in) , optional :: string ! error message string - integer(shr_kind_in), intent(out), optional :: rc ! return code - + character(len=*) , intent(in), optional :: string ! error message string + integer(shr_kind_in), intent(in), optional :: rc ! error code + !----- local ----- - !logical :: flag + logical :: flag ! Local version of the string. ! (Gets a default value if string is not present.) @@ -62,71 +58,75 @@ subroutine shr_abort_abort(string,rc) call print_error_to_logs("ERROR", local_string) - !call shr_abort_backtrace() + call shr_abort_backtrace() - !call shr_mpi_initialized(flag) + call shr_mpi_initialized(flag) - _ASSERT(.FALSE.,trim(local_string)) + if (flag) then + if (present(rc)) then + call shr_mpi_abort(trim(local_string),rc) + else + call shr_mpi_abort(trim(local_string)) + endif + endif ! A compiler's abort method may print a backtrace or do other nice ! things, but in fact we can rarely leverage this, because MPI_Abort ! usually sends SIGTERM to the process, and we don't catch that signal. - !call abort() - - RETURN_(ESMF_SUCCESS) - + call abort() + end subroutine shr_abort_abort !=============================================================================== !=============================================================================== -! subroutine shr_abort_backtrace() -! ! This routine uses compiler-specific facilities to print a backtrace to -! ! error_unit (standard error, usually unit 0). -! -!#if defined(CPRIBM) -! -! ! This theoretically should be in xlfutility, but using it from that -! ! module doesn't seem to always work. -! interface -! subroutine xl_trbk() -! end subroutine xl_trbk -! end interface -! -! call xl__trbk() -! -!#elif defined(CPRGNU) && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 8 )) -! -! ! gfortran 4.8 and later implement this intrinsic. We explicitly call it -! ! out as such to make sure that it really is available, just in case the -! ! CPP logic above screws up. -! intrinsic :: backtrace -! -! call backtrace() -! -!#elif defined(CPRINTEL) -! -! ! tracebackqq uses optional arguments, so *must* have an explicit -! ! interface. -! use ifcore, only: tracebackqq -! -! ! An exit code of -1 is a special value that prevents this subroutine -! ! from aborting the run. -! call tracebackqq(user_exit_code=-1) -! -!#else -! -! ! Currently we have no means to request a backtrace from the NAG runtime, -! ! even though it is capable of emitting backtraces itself, if you use the -! ! "-gline" option. -! -! ! Similarly, PGI has a -traceback option, but no user interface for -! ! requesting a backtrace to be printed. -! -!#endif -! -! flush(error_unit) -! -! end subroutine shr_abort_backtrace + subroutine shr_abort_backtrace() + ! This routine uses compiler-specific facilities to print a backtrace to + ! error_unit (standard error, usually unit 0). + +#if defined(CPRIBM) + + ! This theoretically should be in xlfutility, but using it from that + ! module doesn't seem to always work. + interface + subroutine xl_trbk() + end subroutine xl_trbk + end interface + + call xl__trbk() + +#elif defined(CPRGNU) && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 8 )) + + ! gfortran 4.8 and later implement this intrinsic. We explicitly call it + ! out as such to make sure that it really is available, just in case the + ! CPP logic above screws up. + intrinsic :: backtrace + + call backtrace() + +#elif defined(CPRINTEL) + + ! tracebackqq uses optional arguments, so *must* have an explicit + ! interface. + use ifcore, only: tracebackqq + + ! An exit code of -1 is a special value that prevents this subroutine + ! from aborting the run. + call tracebackqq(user_exit_code=-1) + +#else + + ! Currently we have no means to request a backtrace from the NAG runtime, + ! even though it is capable of emitting backtraces itself, if you use the + ! "-gline" option. + + ! Similarly, PGI has a -traceback option, but no user interface for + ! requesting a backtrace to be printed. + +#endif + + flush(error_unit) + + end subroutine shr_abort_backtrace !=============================================================================== !===============================================================================