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

!--------------------------------------------------------------!
! Copyright (C) 2012 LEGI - UMR 5519 / CNRS
!   http://www.legi.grenoble-inp.fr/
! Licence: GNU Lesser General Public License - LGPLv2 or later
! Author: Gabriel Moreau
! Forge:
!  http://servforge.legi.grenoble-inp.fr/projects/soft-trokata/
! $Id: signal_checkpoint.F90 90 2012-10-10 15:53:41Z g7moreau $
!--------------------------------------------------------------!

module Signal_Checkpoint

#ifdef __INTEL_COMPILER
use IFPORT, only: signal
#endif

implicit none
save
private

! Signal list
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 :: SIGNAL_RECEIVED_COUNT_ = 0       ! Global signal counter
logical :: CODE_ERROR_ON_EXIT_    = .false. ! Global return state

! Public interface
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

#if defined (__GNUC__) || defined (XLF)
   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 = ( SIGNAL_RECEIVED_COUNT_ > 0 )
end function

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

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

   RECEIVED_TIMES = SIGNAL_RECEIVED_COUNT_
end function

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

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

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

subroutine trap_callback_count_

   SIGNAL_RECEIVED_COUNT_ = SIGNAL_RECEIVED_COUNT_ + 1
end subroutine

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

subroutine trap_callback_exit_

   CODE_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
!--------------------------------------------------------------!