init.F90 2.26 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7
      MODULE m_juDFT_init
8

9
      USE m_judft_time
10 11
      USE m_judft_sysinfo
      USE m_judft_stop
12
      USE m_judft_args
13 14
      IMPLICIT NONE
      PRIVATE
15
      PUBLIC juDFT_init
16
      CONTAINS
17
     
18
      SUBROUTINE juDFT_init()
19 20
        IF (.NOT.judft_was_argument("-debugtime")) &
             CALL signal_handler()
21
      CALL checkstack()
22 23 24 25 26 27 28 29 30 31 32 33
      END SUBROUTINE juDFT_init

      SUBROUTINE signal_handler()
      !Installs custom handlers for SIGTERM,SIGSEGV
#ifdef __INTEL_COMPILER
      USE ifport
      INTEGER :: result
      EXTERNAL intel_signal_handler
      result=signal(SIGTERM,intel_signal_handler,-1)
      result=signal(SIGSEGV,intel_signal_handler,-1)
#endif
      END SUBROUTINE signal_handler
34

35 36
      END MODULE m_juDFT_init

37 38 39
      ! NOTE: The intel_signal_handler has to be outside the module
      !       as the OS has to have it under a certain name that
      !       would be changed if it would be defined in the module.
40 41
#ifdef __INTEL_COMPILER
      FUNCTION intel_signal_handler(signal)
42
      USE m_judft_time
43
      USE m_judft_sysinfo
44 45 46 47 48 49 50 51
      IMPLICIT NONE
      INTEGER :: signal
      INTEGER :: intel_signal_handler
#ifdef CPP_MPI
      include "mpif.h"
      INTEGER:: irank,ierr

      CALL MPI_COMM_RANK (MPI_COMM_WORLD,irank,ierr)
52
      WRITE(0,*) "Signal ",signal," detected on PE:",irank
53
#else
54
      WRITE(0,*) "Signal detected:",signal
55
#endif
56 57 58 59 60 61
      WRITE(0,*) "This might be due to either:"
      WRITE(0,*) " - A bug"
      WRITE(0,*) " - Your job running out of memory"
      WRITE(0,*) " - Your job got killed externally (e.g. no cpu-time left)"
      WRITE(0,*) " - ...." 
      WRITE(0,*) "Please check and report if you believe you found a bug"
62
      CALL writetimes()
63
      CALL PRINT_memory_info(0,.true.)
64
#ifdef CPP_MPI
65
      CALL MPI_ABORT(MPI_COMM_WORLD,ierr)
66
#endif      
67 68 69 70
      STOP "Signal"
      intel_signal_handler=0
      END FUNCTION intel_signal_handler
#endif