mpl_abort_mod.F90

Go to the documentation of this file.

MODULE mpl_abort_mod

USE mpl_data_module
USE mpl_mpif
USE oml_mod
USE yomabrt
USE sdl_mod, ONLY : sdl_traceback, sdl_disabort
#ifdef NAG
USE f90_unix_io, ONLY: flush
#endif
USE parkind1  ,ONLY : jpim     ,jprb

PRIVATE
PUBLIC mpl_abort

CONTAINS 

SUBROUTINE mpl_abort(CDMESSAGE)

IMPLICIT NONE

CHARACTER*(*),INTENT(IN),OPTIONAL :: CDMESSAGE
INTEGER(KIND=JPIM) :: IRETURN_CODE,IERROR,ITID
itid=oml_my_thread()

CLOSE(mpl_unit)
CALL flush(0)
CALL ec_sleep(1) ! This rather than 'CALL SYSTEM("sleep 1")' ; see code ../support/env.c

!------Traceback from only one thread
CALL oml_set_lock(mylock=mab_lock(1))
IF(mab_cnt == 0) THEN
  WRITE(mpl_errunit,'(A,I6,A,I6)') 'MPL_ABORT: CALLED FROM PROCESSOR ',mpl_rank,' THRD',itid
  IF(PRESENT(cdmessage)) THEN
    WRITE(mpl_errunit,*) 'MPL_ABORT: THRD',itid,"  ",cdmessage
  ENDIF
  mab_cnt=1
  CALL sdl_traceback(itid)
  CALL flush(0)
  CALL ec_sleep(1) ! This rather than 'CALL SYSTEM("sleep 1")' ; see code ../support/env.c
ENDIF
CALL oml_unset_lock(mylock=mab_lock(1))
! ------All threads wait till traceback done
CALL flush(0)
CALL ec_sleep(1) ! This rather than 'CALL SYSTEM("sleep 1")' ; see code ../support/env.c

CALL sdl_disabort(mpl_comm_oml(itid))

END SUBROUTINE mpl_abort

END MODULE mpl_abort_mod