diff --git a/VERSION b/VERSION index 567d81c9b..ed949e161 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha7-316-g8a7655a9e +3.0.0-alpha7-326-g510f59b4b diff --git a/src/parallelization.f90 b/src/parallelization.f90 index 04a852a15..3feea8cc3 100644 --- a/src/parallelization.f90 +++ b/src/parallelization.f90 @@ -65,10 +65,12 @@ subroutine parallelization_init() PetscErrorCode :: err_PETSc #ifdef _OPENMP ! If openMP is enabled, check if the MPI libary supports it and initialize accordingly. - ! Otherwise, the first call to PETSc will do the initialization. call MPI_Init_Thread(MPI_THREAD_FUNNELED,threadLevel,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI init failed' if (threadLevel everything is fine. Exit code 1 signals an error, message according to IO_error. !-------------------------------------------------------------------------------------------------- subroutine quit(stop_id) + use, intrinsic :: ISO_fortran_env, only: ERROR_UNIT #include use PETScSys #if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) @@ -22,23 +23,16 @@ subroutine quit(stop_id) integer, dimension(8) :: dateAndTime integer :: err_HDF5 - integer(MPI_INTEGER_KIND) :: err_MPI + integer(MPI_INTEGER_KIND) :: err_MPI, worldsize PetscErrorCode :: err_PETSc - call h5open_f(err_HDF5) - if (err_HDF5 /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in h5open_f ',err_HDF5 ! prevents error if not opened yet + + call h5open_f(err_HDF5) ! prevents error if not opened yet + if (err_HDF5 /= 0) write(ERROR_UNIT,'(a,i5)') ' Error in h5open_f ',err_HDF5 call h5close_f(err_HDF5) - if (err_HDF5 /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in h5close_f ',err_HDF5 + if (err_HDF5 /= 0) write(ERROR_UNIT,'(a,i5)') ' Error in h5close_f ',err_HDF5 call PetscFinalize(err_PETSc) - CHKERRQ(err_PETSc) - -#ifdef _OPENMP - call MPI_finalize(err_MPI) - if (err_MPI /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in MPI_finalize',err_MPI -#else - err_MPI = 0_MPI_INTEGER_KIND -#endif call date_and_time(values = dateAndTime) write(6,'(/,a)') ' DAMASK terminated on:' @@ -49,10 +43,15 @@ subroutine quit(stop_id) dateAndTime(6),':',& dateAndTime(7) - if (stop_id == 0 .and. & - err_HDF5 == 0 .and. & - err_MPI == 0_MPI_INTEGER_KIND .and. & - err_PETSC == 0) stop 0 ! normal termination - stop 1 ! error (message from IO_error) + if (stop_id == 0 .and. err_HDF5 == 0 .and. err_PETSC == 0) then + call MPI_Finalize(err_MPI) + if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI_Finalize error' + stop 0 ! normal termination + else + call MPI_Comm_size(MPI_COMM_WORLD,worldsize,err_MPI) + if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI_Comm error' + if (stop_id /= 0 .and. worldsize > 1) call MPI_Abort(MPI_COMM_WORLD,1,err_MPI) + stop 1 ! error (message from IO_error) + endif end subroutine quit