CatchCN CLM51 fix endrun exit issue

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

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
   !===============================================================================
 
   !===============================================================================