avoiding compiler warnings and confusion of the user
This commit is contained in:
Martin Diehl 2018-09-27 08:23:30 +02:00
parent f14bc5b843
commit 6509775d41
3 changed files with 40 additions and 30 deletions

View File

@ -473,7 +473,7 @@ program DAMASK_FEM
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, &
' %) increments converged!' ' %) increments converged!'
endif 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 ;) call quit(0_pInt) ! no complains ;)
end program DAMASK_FEM end program DAMASK_FEM
@ -481,19 +481,35 @@ end program DAMASK_FEM
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief quit subroutine to mimic behavior of FEM solvers !> @brief quit subroutine
!> @details exits the Spectral solver and reports time and duration. Exit code 0 signals !> @details exits the program and reports current time and duration. Exit code 0 signals
!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code !> everything is 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 !> 2 signals no severe problems, but some increments did not converge
!> stderr. Exit code 3 signals no severe problems, but some increments did not converge
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine quit(stop_id) subroutine quit(stop_id)
#include <petsc/finclude/petscsys.h>
#ifdef _OPENMP
use MPI, only: &
MPI_finalize
#endif
use prec, only: & use prec, only: &
pInt pInt
use PetscSys
implicit none implicit none
integer(pInt), intent(in) :: stop_id integer(pInt), intent(in) :: stop_id
integer, dimension(8) :: dateAndTime ! type default integer 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) call date_and_time(values = dateAndTime)
write(6,'(/,a)') 'DAMASK terminated on:' write(6,'(/,a)') 'DAMASK terminated on:'
@ -503,12 +519,9 @@ subroutine quit(stop_id)
write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',& write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',&
dateAndTime(6),':',& dateAndTime(6),':',&
dateAndTime(7) dateAndTime(7)
if (stop_id == 0_pInt) stop 0 ! normal termination
if (stop_id < 0_pInt) then ! trigger regridding if (stop_id == 0_pInt .and. .not. ErrorInQuit) stop 0 ! normal termination
write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt) if (stop_id == 2_pInt .and. .not. ErrorInQuit) stop 2 ! not all incs converged
stop 2
endif
if (stop_id == 3_pInt) stop 3 ! not all incs converged
stop 1 ! error (message from IO_error) stop 1 ! error (message from IO_error)
end subroutine quit end subroutine quit

View File

@ -227,8 +227,8 @@ subroutine setWorkingDirectory(workingDirectoryArg)
implicit none implicit none
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
character(len=1024) :: workingDirectory !< working directory argument character(len=1024) :: workingDirectory !< working directory argument
external :: quit
logical :: error logical :: error
external :: quit
absolutePath: if (workingDirectoryArg(1:1) == '/') then absolutePath: if (workingDirectoryArg(1:1) == '/') then
workingDirectory = workingDirectoryArg workingDirectory = workingDirectoryArg
@ -282,6 +282,7 @@ character(len=1024) function getGeometryFile(geometryParameter)
implicit none implicit none
character(len=1024), intent(in) :: geometryParameter character(len=1024), intent(in) :: geometryParameter
logical :: file_exists logical :: file_exists
external :: quit
getGeometryFile = trim(geometryParameter) getGeometryFile = trim(geometryParameter)
if (scan(getGeometryFile,'/') /= 1) getGeometryFile = trim(getCWD())//'/'//trim(getGeometryFile) if (scan(getGeometryFile,'/') /= 1) getGeometryFile = trim(getCWD())//'/'//trim(getGeometryFile)
@ -306,6 +307,7 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter)
implicit none implicit none
character(len=1024), intent(in) :: loadCaseParameter character(len=1024), intent(in) :: loadCaseParameter
logical :: file_exists logical :: file_exists
external :: quit
getLoadCaseFile = trim(loadCaseParameter) getLoadCaseFile = trim(loadCaseParameter)
if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = trim(getCWD())//'/'//trim(getLoadCaseFile) if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = trim(getCWD())//'/'//trim(getLoadCaseFile)

View File

@ -628,7 +628,7 @@ program DAMASK_spectral
call MPI_file_close(fileUnit,ierr) call MPI_file_close(fileUnit,ierr)
close(statUnit) 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 ;) call quit(0_pInt) ! no complains ;)
end program DAMASK_spectral end program DAMASK_spectral
@ -636,11 +636,10 @@ end program DAMASK_spectral
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief quit subroutine to mimic behavior of FEM solvers !> @brief quit subroutine
!> @details exits the Spectral solver and reports time and duration. Exit code 0 signals !> @details exits the program and reports current time and duration. Exit code 0 signals
!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code !> everything is 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 !> 2 signals no severe problems, but some increments did not converge
!> stderr. Exit code 3 signals no severe problems, but some increments did not converge
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine quit(stop_id) subroutine quit(stop_id)
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
@ -650,6 +649,7 @@ subroutine quit(stop_id)
#endif #endif
use prec, only: & use prec, only: &
pInt pInt
use PetscSys
implicit none implicit none
integer(pInt), intent(in) :: stop_id integer(pInt), intent(in) :: stop_id
@ -676,12 +676,7 @@ subroutine quit(stop_id)
dateAndTime(7) dateAndTime(7)
if (stop_id == 0_pInt .and. .not. ErrorInQuit) stop 0 ! normal termination 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 if (stop_id == 2_pInt .and. .not. ErrorInQuit) stop 2 ! not all incs converged
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
stop 1 ! error (message from IO_error) stop 1 ! error (message from IO_error)
end subroutine quit end subroutine quit