diff --git a/src/DAMASK_FEM.f90 b/src/DAMASK_FEM.f90 index e31eef7f6..05668b14a 100644 --- a/src/DAMASK_FEM.f90 +++ b/src/DAMASK_FEM.f90 @@ -473,42 +473,55 @@ program DAMASK_FEM real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & ' %) increments converged!' endif - if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged + if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged call quit(0_pInt) ! no complains ;) -end program DAMASK_FEM +end program DAMASK_FEM !-------------------------------------------------------------------------------------------------- !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief quit subroutine to mimic behavior of FEM solvers -!> @details exits the Spectral solver and reports time and duration. Exit code 0 signals -!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code -!> 2 signals request for regridding, increment of last saved restart information is written to -!> stderr. Exit code 3 signals no severe problems, but some increments did not converge +!> @brief quit subroutine +!> @details exits the program and reports current time and duration. Exit code 0 signals +!> everything is fine. Exit code 1 signals an error, message according to IO_error. Exit code +!> 2 signals no severe problems, but some increments did not converge !-------------------------------------------------------------------------------------------------- subroutine quit(stop_id) +#include +#ifdef _OPENMP + use MPI, only: & + MPI_finalize +#endif use prec, only: & pInt - + use PetscSys + implicit none integer(pInt), intent(in) :: stop_id integer, dimension(8) :: dateAndTime ! type default integer - + integer(pInt) :: error = 0_pInt + PetscErrorCode :: ierr = 0 + logical :: ErrorInQuit + + call PETScFinalize(ierr) + if (ierr /= 0) write(6,'(a)') ' Error in PETScFinalize' +#ifdef _OPENMP + call MPI_finalize(error) + if (error /= 0) write(6,'(a)') ' Error in MPI_finalize' +#endif + ErrorInQuit = (ierr /= 0 .or. error /= 0_pInt) + call date_and_time(values = dateAndTime) write(6,'(/,a)') 'DAMASK terminated on:' write(6,'(a,2(i2.2,a),i4.4)') 'Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& - dateAndTime(1) + dateAndTime(1) write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',& dateAndTime(6),':',& - dateAndTime(7) - if (stop_id == 0_pInt) stop 0 ! normal termination - if (stop_id < 0_pInt) then ! trigger regridding - write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt) - stop 2 - endif - if (stop_id == 3_pInt) stop 3 ! not all incs converged + dateAndTime(7) + + if (stop_id == 0_pInt .and. .not. ErrorInQuit) stop 0 ! normal termination + if (stop_id == 2_pInt .and. .not. ErrorInQuit) stop 2 ! not all incs converged stop 1 ! error (message from IO_error) end subroutine quit diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index 59245ba35..3bd4df68f 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -227,8 +227,8 @@ subroutine setWorkingDirectory(workingDirectoryArg) implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument character(len=1024) :: workingDirectory !< working directory argument - external :: quit logical :: error + external :: quit absolutePath: if (workingDirectoryArg(1:1) == '/') then workingDirectory = workingDirectoryArg @@ -282,6 +282,7 @@ character(len=1024) function getGeometryFile(geometryParameter) implicit none character(len=1024), intent(in) :: geometryParameter logical :: file_exists + external :: quit getGeometryFile = trim(geometryParameter) if (scan(getGeometryFile,'/') /= 1) getGeometryFile = trim(getCWD())//'/'//trim(getGeometryFile) @@ -306,6 +307,7 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) implicit none character(len=1024), intent(in) :: loadCaseParameter logical :: file_exists + external :: quit getLoadCaseFile = trim(loadCaseParameter) if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = trim(getCWD())//'/'//trim(getLoadCaseFile) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 8b7578573..c2858ebc2 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -628,7 +628,7 @@ program DAMASK_spectral call MPI_file_close(fileUnit,ierr) close(statUnit) - if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged + if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged call quit(0_pInt) ! no complains ;) end program DAMASK_spectral @@ -636,11 +636,10 @@ end program DAMASK_spectral !-------------------------------------------------------------------------------------------------- !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief quit subroutine to mimic behavior of FEM solvers -!> @details exits the Spectral solver and reports time and duration. Exit code 0 signals -!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code -!> 2 signals no converged solution and increment of last saved restart information is written to -!> stderr. Exit code 3 signals no severe problems, but some increments did not converge +!> @brief quit subroutine +!> @details exits the program and reports current time and duration. Exit code 0 signals +!> everything is fine. Exit code 1 signals an error, message according to IO_error. Exit code +!> 2 signals no severe problems, but some increments did not converge !-------------------------------------------------------------------------------------------------- subroutine quit(stop_id) #include @@ -650,6 +649,7 @@ subroutine quit(stop_id) #endif use prec, only: & pInt + use PetscSys implicit none integer(pInt), intent(in) :: stop_id @@ -676,12 +676,7 @@ subroutine quit(stop_id) dateAndTime(7) if (stop_id == 0_pInt .and. .not. ErrorInQuit) stop 0 ! normal termination - if (stop_id < 0_pInt .and. .not. ErrorInQuit) then ! terminally ill, restart might help - write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt) - stop 2 - endif - if (stop_id == 3_pInt .and. .not. ErrorInQuit) stop 3 ! not all incs converged - + if (stop_id == 2_pInt .and. .not. ErrorInQuit) stop 2 ! not all incs converged stop 1 ! error (message from IO_error) end subroutine quit