From bcebb0ccd1f6af7661169a4ea337586b4f02ef78 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 20 Dec 2011 15:48:16 -0500 Subject: [PATCH] Enhanced fatal_error subroutine. --- src/error.F90 | 53 +++++++++++++++++++++++++++++++++----------------- src/global.F90 | 5 ----- src/main.F90 | 5 +++++ 3 files changed, 40 insertions(+), 23 deletions(-) diff --git a/src/error.F90 b/src/error.F90 index fab7c8dc84..2eac3f2372 100644 --- a/src/error.F90 +++ b/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 diff --git a/src/global.F90 b/src/global.F90 index dc3d01092b..347eace57b 100644 --- a/src/global.F90 +++ b/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 diff --git a/src/main.F90 b/src/main.F90 index d71993c923..9586f8bc40 100644 --- a/src/main.F90 +++ b/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