scale_sigvars.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
module scale_sigvars
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use iso_c_binding
  use scale_io
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: sigvars_get_all
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  integer(c_int), public :: sigint  = -1
  integer(c_int), public :: sigquit = -1
  integer(c_int), public :: sigabrt = -1
  integer(c_int), public :: sigfpe  = -1
  integer(c_int), public :: sigsegv = -1
  integer(c_int), public :: sigterm = -1
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  interface
    function get_sigint(ierr) bind(c)
      import
      integer(c_int),intent(out) :: ierr
      integer(c_int) get_sigint
    end function
  end interface
 
  interface
    function get_sigquit(ierr) bind(c)
      import
      integer(c_int),intent(out) :: ierr
      integer(c_int) get_sigquit
    end function
  end interface
 
  interface
    function get_sigabrt(ierr) bind(c)
      import
      integer(c_int),intent(out) :: ierr
      integer(c_int) get_sigabrt
    end function
  end interface
 
  interface
    function get_sigfpe(ierr) bind(c)
      import
      integer(c_int),intent(out) :: ierr
      integer(c_int) get_sigfpe
    end function
  end interface
 
  interface
    function get_sigsegv(ierr) bind(c)
      import
      integer(c_int),intent(out) :: ierr
      integer(c_int) get_sigsegv
    end function
  end interface
 
  interface
    function get_sigterm(ierr) bind(c)
      import
      integer(c_int),intent(out) :: ierr
      integer(c_int) get_sigterm
    end function
  end interface
 
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
  contains
  !-----------------------------------------------------------------------------
 
  !-----------------------------------------------------------------------------
  subroutine sigvars_get_all( &
       master    )
    implicit none
    logical, intent(in) :: master   ! master flag
    integer(c_int) :: ierr
    !---------------------------------------------------------------------------
 
    if( master ) write(*,*) ''
    if( master ) write(*,*) 'Get system signals'
 
    sigint = get_sigint(ierr)
    if ( ierr == 0 ) then
       if( master ) write(*,*) '*** signal: SIGINT  = ', sigint
    else
       if( master ) write(*,*) 'xxx [WARNING] Not Exist: SIGINT'
    endif
 
    sigquit = get_sigquit(ierr)
    if ( ierr == 0 ) then
       if( master ) write(*,*) '*** signal: SIGQUIT = ', sigquit
    else
       if( master ) write(*,*) 'xxx [WARNING] Not Exist: SIGQUIT'
    endif
 
    sigabrt = get_sigabrt(ierr)
    if ( ierr == 0 ) then
       if( master ) write(*,*) '*** signal: SIGABRT = ', sigabrt
    else
       if( master ) write(*,*) 'xxx [WARNING] Not Exist: SIGABRT'
    endif
 
    sigfpe = get_sigfpe(ierr)
    if ( ierr == 0 ) then
       if( master ) write(*,*) '*** signal: SIGFPE  = ', sigfpe
    else
       if( master ) write(*,*) 'xxx [WARNING] Not Exist: SIGFPE'
    endif
 
    sigsegv = get_sigsegv(ierr)
    if ( ierr == 0 ) then
       if( master ) write(*,*) '*** signal: SIGSEGV = ', sigsegv
    else
       if( master ) write(*,*) 'xxx [WARNING] Not Exist: SIGSEGV'
    endif
 
    sigterm = get_sigterm(ierr)
    if ( ierr == 0 ) then
       if( master ) write(*,*) '*** signal: SIGTERM = ', sigterm
    else
       if( master ) write(*,*) 'xxx [WARNING] Not Exist: SIGTERM'
    endif
 
    return
  end subroutine sigvars_get_all
 
end module scale_sigvars
!-------------------------------------------------------------------------------