source: trunk/signal-checkpoint/signal_checkpoint.F90 @ 72

!--------------------------------------------------------------!
! 2012/04/20 (C) Gabriel Moreau
! Licence LGPLv2 or latter
! $Id: signal_checkpoint.F90 72 2012-05-29 09:20:54Z g7moreau $
!--------------------------------------------------------------!

module Signal_Checkpoint

#ifdef __INTEL_COMPILER
use IFPORT, only: signal
#endif

implicit none
save
private

integer, parameter :: SIGHUP  =  1  ! Signal HUP
integer, parameter :: SIGINT  =  2  ! Signal INT
integer, parameter :: SIGQUIT =  3  ! Signal QUIT
integer, parameter :: SIGUSR1 = 10  ! Signal USR1
integer, parameter :: SIGUSR2 = 12  ! Signal USR2
integer, parameter :: SIGTERM = 15  ! Signal TERM

! Internal counter
integer :: INTERNAL_RECEIVED_COUNT_ = 0       ! Global Signal Counter
logical :: INTERNAL_ERROR_ON_EXIT_  = .false. ! Global State

public :: SIGHUP
public :: SIGINT
public :: SIGQUIT
public :: SIGUSR1
public :: SIGUSR2
public :: SIGTERM
public :: signal_checkpoint_connect
public :: signal_checkpoint_is_received
public :: signal_checkpoint_received_times
public :: signal_checkpoint_ask_for_exit_code

!--------------------------------------------------------------!
contains
!--------------------------------------------------------------!

subroutine signal_checkpoint_connect (SIG_NUM, EXIT)
   integer, intent(in) :: SIG_NUM
   logical, intent(in), optional :: EXIT

#ifdef __INTEL_COMPILER
   integer :: ERR

   if (present(EXIT)) then
      ERR = signal(SIG_NUM, trap_callback_intel_exit_, -1)
   else
      ERR = signal(SIG_NUM, trap_callback_intel_count_, -1)
   end if
#endif

#ifdef __GNUC__
   intrinsic signal

   if (present(EXIT)) then
      call signal(SIG_NUM, trap_callback_exit_)
   else

      call signal(SIG_NUM, trap_callback_count_)
   end if
#endif

end subroutine

!--------------------------------------------------------------!

function signal_checkpoint_is_received () result (IS_RECEIVED)
   logical :: IS_RECEIVED

   IS_RECEIVED = ( INTERNAL_RECEIVED_COUNT_ > 0 )
end function

!--------------------------------------------------------------!

function signal_checkpoint_received_times () result (RECEIVED_TIMES)
   integer :: RECEIVED_TIMES

   RECEIVED_TIMES = INTERNAL_RECEIVED_COUNT_
end function

!--------------------------------------------------------------!

function signal_checkpoint_ask_for_exit_code () result (EXIT)
   logical :: EXIT
   
   EXIT = INTERNAL_ERROR_ON_EXIT_
end function

!--------------------------------------------------------------!
!--------------------------------------------------------------!

subroutine trap_callback_count_ !(SIG_NUM)
   !integer, intent(in) :: SIG_NUM

   INTERNAL_RECEIVED_COUNT_ = INTERNAL_RECEIVED_COUNT_ + 1
end subroutine

!--------------------------------------------------------------!

subroutine trap_callback_exit_ !(SIG_NUM)
   !integer, intent(in) :: SIG_NUM

   INTERNAL_ERROR_ON_EXIT_ = .true.
   call trap_callback_count_
end subroutine

!--------------------------------------------------------------!

function trap_callback_intel_exit_ (SIG_NUM) result (ONE)
   integer, intent(in) :: SIG_NUM
   integer :: ONE

   call trap_callback_exit_
   ONE = 1
end function

!--------------------------------------------------------------!

function trap_callback_intel_count_ (SIG_NUM) result (ONE)
   integer, intent(in) :: SIG_NUM
   integer :: ONE

   call trap_callback_count_
   ONE = 1
end function

!--------------------------------------------------------------!
end module
!--------------------------------------------------------------!