Merge branch 'jonbob/mpas-framework/fix-log-abort' (PR #7457)

Fix the abort routines in mpas-framework to use shr_sys_abort when coupled

Fix the abort routines in mpas-framework so that log_abort calls
mpas_dmpar_global_abort and mpas_dmpar_global_abort itself uses
shr_sys_abort when running as a coupled model.

Fixes #7447
[BFB]

Author: jonbob

components/mpas-framework/src/framework/framework.cmake

@@ -1,4 +1,5 @@
 # framework
+list(APPEND CPPDEFS "-Dcoupled")
 list(APPEND COMMON_RAW_SOURCES
   framework/mpas_kind_types.F
   framework/mpas_framework.F

components/mpas-framework/src/framework/mpas_abort.F

@@ -29,6 +29,10 @@ subroutine mpas_dmpar_global_abort(mesg, deferredAbort)!{{{
       use mpas_kind_types, only : StrKIND
       use mpas_io_units, only : mpas_new_unit
       use mpas_threading, only : mpas_threading_get_thread_num
+
+#ifdef coupled
+      use shr_sys_mod, only : shr_sys_abort
+#endif
 
 #ifdef _MPI
 #ifndef NOMPIMOD
@@ -44,7 +48,7 @@ subroutine mpas_dmpar_global_abort(mesg, deferredAbort)!{{{
 #endif
 #endif
 
-      character(len=*), intent(in) :: mesg !< Input: Abort message
+      character(len=*), intent(in), optional :: mesg !< Input: Abort message
       logical, intent(in), optional :: deferredAbort !< Input: Defer call to abort until later
 
       integer :: threadNum
@@ -63,40 +67,46 @@ subroutine mpas_dmpar_global_abort(mesg, deferredAbort)!{{{
          local_deferredAbort = .false.
       end if
 
-      threadNum = mpas_threading_get_thread_num()
+      if (present(mesg)) then
+         threadNum = mpas_threading_get_thread_num()
 
 #ifdef _MPI
-      call MPI_Comm_rank(MPI_COMM_WORLD, my_proc_id, mpi_ierr)
-      call MPI_Comm_size(MPI_COMM_WORLD, nprocs, mpi_ierr)
-      if (nprocs < 1E4) then
-         write(errorFile,fmt='(a,i4.4,a)') 'log.', my_proc_id, '.abort'
-      else if (nprocs < 1E5) then
-         write(errorFile,fmt='(a,i5.5,a)') 'log.', my_proc_id, '.abort'
-      else if (nprocs < 1E6) then
-         write(errorFile,fmt='(a,i6.6,a)') 'log.', my_proc_id, '.abort'
-      else if (nprocs < 1E7) then
-         write(errorFile,fmt='(a,i7.7,a)') 'log.', my_proc_id, '.abort'
-      else if (nprocs < 1E8) then
-         write(errorFile,fmt='(a,i8.8,a)') 'log.', my_proc_id, '.abort'
-      else
-         write(errorFile,fmt='(a,i9.9,a)') 'log.', my_proc_id, '.abort'
-      end if
+         call MPI_Comm_rank(MPI_COMM_WORLD, my_proc_id, mpi_ierr)
+         call MPI_Comm_size(MPI_COMM_WORLD, nprocs, mpi_ierr)
+         if (nprocs < 1E4) then
+            write(errorFile,fmt='(a,i4.4,a)') 'log.', my_proc_id, '.abort'
+         else if (nprocs < 1E5) then
+            write(errorFile,fmt='(a,i5.5,a)') 'log.', my_proc_id, '.abort'
+         else if (nprocs < 1E6) then
+            write(errorFile,fmt='(a,i6.6,a)') 'log.', my_proc_id, '.abort'
+         else if (nprocs < 1E7) then
+            write(errorFile,fmt='(a,i7.7,a)') 'log.', my_proc_id, '.abort'
+         else if (nprocs < 1E8) then
+            write(errorFile,fmt='(a,i8.8,a)') 'log.', my_proc_id, '.abort'
+         else
+            write(errorFile,fmt='(a,i9.9,a)') 'log.', my_proc_id, '.abort'
+         end if
 #else
-      errorFile = 'log.abort'
+         errorFile = 'log.abort'
 #endif
 
-      if ( threadNum == 0 ) then
-         call mpas_new_unit(errorUnit)
-         open(unit=errorUnit, file=trim(errorFile), form='formatted', position='append')
-         write(errorUnit,*) trim(mesg)
-         close(errorUnit)
+         if ( threadNum == 0 ) then
+            call mpas_new_unit(errorUnit)
+            open(unit=errorUnit, file=trim(errorFile), form='formatted', position='append')
+            write(errorUnit,*) trim(mesg)
+            close(errorUnit)
+         end if
       end if
 
       if (.not. local_deferredAbort) then
+#ifdef coupled
+      call shr_sys_abort('MPAS framework abort')
+#else
 #ifdef _MPI
-         call MPI_Abort(MPI_COMM_WORLD, mpi_errcode, mpi_ierr)
+      call MPI_Abort(MPI_COMM_WORLD, mpi_errcode, mpi_ierr)
 #else
-         stop
+      stop
+#endif
 #endif
       end if
 

components/mpas-framework/src/framework/mpas_log.F

@@ -846,11 +846,7 @@ subroutine log_abort()
       deallocate(mpas_log_info % outputLog)
       deallocate(mpas_log_info)
 
-#ifdef _MPI
-      call MPI_Abort(MPI_COMM_WORLD, mpi_errcode, mpi_ierr)
-#else
-      stop
-#endif
+      call mpas_dmpar_global_abort()
 
    !--------------------------------------------------------------------
    end subroutine log_abort