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..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 @@ -60,7 +60,7 @@ subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) ! 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,8 +79,8 @@ subroutine endrun_globalindex(decomp_index, clmlevel, msg, additional_msg) 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 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..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,16 +9,15 @@ module shr_abort_mod use, intrinsic :: iso_fortran_env, only: output_unit, error_unit - 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 @@ -33,21 +30,20 @@ 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) + subroutine shr_abort_abort(string,rc) ! Consistent stopping mechanism !----- 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 - + 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,73 +58,75 @@ subroutine shr_abort_abort(string,ec,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) - if (present(ec)) then - _ASSERT(.FALSE.,trim(local_string)) - else - _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() + 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 !=============================================================================== !===============================================================================