Commit ebb227c7 authored by Keith Bennett's avatar Keith Bennett

Merge branch 'keith/errhandler_bugfix' into 'master'

Prevent error handler being prematurely free'd

See merge request SDF/SDF_FORTRAN!23
parents b113d773 29cdedd2
......@@ -107,6 +107,9 @@ MODULE sdf_common
INTEGER, PARAMETER :: max_handles = 64
TYPE(sdf_handle_type) :: sdf_handles(max_handles)
INTEGER, SAVE :: errhandler_handle = MPI_ERRHANDLER_NULL
INTEGER, SAVE :: open_handles = 0
INTEGER, PARAMETER :: c_sdf_read = 0
INTEGER, PARAMETER :: c_sdf_write = 1
INTEGER, PARAMETER :: c_sdf_append = 3
......@@ -728,7 +731,10 @@ CONTAINS
IF (set_err_handler) THEN
CALL MPI_FILE_GET_ERRHANDLER(MPI_FILE_NULL, var%old_errhandler, ierr)
CALL MPI_FILE_CREATE_ERRHANDLER(error_handler, var%errhandler, ierr)
IF (errhandler_handle == MPI_ERRHANDLER_NULL) THEN
CALL MPI_FILE_CREATE_ERRHANDLER(error_handler, errhandler_handle, ierr)
ENDIF
var%errhandler = errhandler_handle
CALL MPI_FILE_SET_ERRHANDLER(MPI_FILE_NULL, var%errhandler, ierr)
ENDIF
......@@ -744,9 +750,7 @@ CONTAINS
IF (ASSOCIATED(var%buffer)) DEALLOCATE(var%buffer)
IF (ASSOCIATED(var%station_ids)) DEALLOCATE(var%station_ids)
IF (var%errhandler /= MPI_ERRHANDLER_NULL) THEN
CALL MPI_ERRHANDLER_FREE(var%errhandler, errcode)
ENDIF
var%errhandler = MPI_ERRHANDLER_NULL
IF (var%old_errhandler /= MPI_ERRHANDLER_NULL) THEN
CALL MPI_FILE_SET_ERRHANDLER(MPI_FILE_NULL, var%old_errhandler, errcode)
......@@ -758,12 +762,18 @@ CONTAINS
DO i = 1, max_handles
IF (sdf_handles(i)%filehandle == var%filehandle) THEN
sdf_handles(i)%filehandle = 0
open_handles = open_handles - 1
EXIT
ENDIF
ENDDO
CALL initialise_file_handle(var, set_handler=.FALSE.)
IF (open_handles == 0) THEN
CALL MPI_ERRHANDLER_FREE(errhandler_handle, errcode)
errhandler_handle = MPI_ERRHANDLER_NULL
ENDIF
END SUBROUTINE deallocate_file_handle
......
......@@ -81,16 +81,21 @@ CONTAINS
IF (h%rank == h%rank_master .AND. h%filehandle /= 0) THEN
IF (h%errhandler /= MPI_ERRHANDLER_NULL) THEN
IF (h%old_errhandler /= MPI_ERRHANDLER_NULL) THEN
! Restore default error handler if changed
CALL MPI_FILE_GET_ERRHANDLER(MPI_FILE_NULL, errcode, ierr)
IF (errcode /= h%old_errhandler) THEN
CALL MPI_FILE_SET_ERRHANDLER(MPI_FILE_NULL, h%old_errhandler, errcode)
h%old_errhandler = MPI_ERRHANDLER_NULL
ENDIF
h%old_errhandler = MPI_ERRHANDLER_NULL
CALL MPI_FILE_SET_ERRHANDLER(h%filehandle, h%errhandler, errcode)
ENDIF
DO i = 1, max_handles
IF (sdf_handles(i)%filehandle == 0) THEN
sdf_handles(i)%filehandle = h%filehandle
sdf_handles(i)%handle => h
open_handles = open_handles + 1
EXIT
ENDIF
ENDDO
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment