Enhanced fatal_error subroutine.

src/error.F90

@@ -2,7 +2,11 @@ module error
 
   use ISO_FORTRAN_ENV
 
-  use global, only: master, free_memory, message
+  use global, only: master, free_memory, message, mpi_err
+
+#ifdef MPI
+  use mpi
+#endif
 
   implicit none
 
@@ -25,14 +29,14 @@ contains
     ! Only allow master to print to screen
     if (.not. master) return
 
-    write(ou, fmt='(1X,A9)', advance='no') 'WARNING: '
+    write(OUTPUT_UNIT, fmt='(1X,A9)', advance='no') 'WARNING: '
 
     n_lines = (len_trim(message)-1)/70 + 1
     do i = 1, n_lines
        if (i == 1) then
-          write(ou, fmt='(A70)') message(70*(i-1)+1:70*i)
+          write(OUTPUT_UNIT, fmt='(A70)') message(70*(i-1)+1:70*i)
        else
-          write(ou, fmt='(10X,A70)') message(70*(i-1)+1:70*i)
+          write(OUTPUT_UNIT, fmt='(10X,A70)') message(70*(i-1)+1:70*i)
        end if
     end do
 
@@ -44,29 +48,42 @@ contains
 ! the program is aborted.
 !===============================================================================
 
-  subroutine fatal_error()
+  subroutine fatal_error(error_code)
 
+    integer, optional :: error_code ! error code
+
+    integer :: code    ! error code
     integer :: n_lines ! number of lines
     integer :: i       ! loop index over lines
 
-    ! Only allow master to print to screen
-    if (master) then
-       write(eu, fmt='(1X,A7)', advance='no') 'ERROR: '
-
-       n_lines = (len_trim(message)-1)/72 + 1
-       do i = 1, n_lines
-          if (i == 1) then
-             write(eu, fmt='(A72)') message(72*(i-1)+1:72*i)
-          else
-             write(eu, fmt='(7X,A72)') message(72*(i-1)+1:72*i)
-          end if
-       end do
-       write(eu,*)
+    ! set default error code
+    if (present(error_code)) then
+       code = error_code
+    else
+       code = -1
     end if
 
+    ! Only allow master to print to screen
+    write(ERROR_UNIT, fmt='(1X,A7)', advance='no') 'ERROR: '
+
+    n_lines = (len_trim(message)-1)/72 + 1
+    do i = 1, n_lines
+       if (i == 1) then
+          write(ERROR_UNIT, fmt='(A72)') message(72*(i-1)+1:72*i)
+       else
+          write(ERROR_UNIT, fmt='(7X,A72)') message(72*(i-1)+1:72*i)
+       end if
+    end do
+    write(ERROR_UNIT,*)
+
     ! Release memory from all allocatable arrays
     call free_memory()
 
+#ifdef MPI
+    ! Abort MPI
+    call MPI_ABORT(MPI_COMM_WORLD, code, mpi_err)
+#endif
+
     ! Abort program
     stop
 

src/global.F90

@@ -211,11 +211,6 @@ contains
     if (allocated(fission_bank)) deallocate(fission_bank)
     if (allocated(source_bank)) deallocate(source_bank)
 
-#ifdef MPI
-    ! If MPI is in use and enabled, terminate it
-    call MPI_FINALIZE(mpi_err)
-#endif
-
   end subroutine free_memory
 
 end module global

src/main.F90

@@ -44,6 +44,11 @@ program main
 
   ! deallocate arrays
   call free_memory()
+
+#ifdef MPI
+  ! If MPI is in use and enabled, terminate it
+  call MPI_FINALIZE(mpi_err)
+#endif
   
 contains