forked from mjlaine/mcmcf90
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathMCMC_signal_handler.F90
109 lines (88 loc) · 2.16 KB
/
MCMC_signal_handler.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
!!! $Id: MCMC_signal_handler.F90,v 1.6 2012/07/03 10:57:34 mjlaine Exp $
!!! ------------------------------------------------------------------------
!!! mcmc library
!!! File: MCMC_signal_handler.F90
!!! Purpose: signal handler modulde
!!!
!!! Marko Laine 2008 <[email protected]>
!!! Copyrights licensed under a MIT License.
!!! See the accompanying LICENSE.txt file for terms.
!!!
!!! works with ifort, gfortran and VisualFortran, at least
!!!
subroutine signal_handler_init()
#ifdef _WIN32
use dflib ! for signal handler
#endif
#ifdef __IFC
use iflport ! Intel fortran portability library
!!! you may have to copy and compile iflport.f90 in the current directory
! include 'iflport.f90'
#endif
implicit none
#ifdef _WIN32
integer(4) iret
#endif
#ifdef __IFC
integer(4) iret
#endif
!!! install signal handler for ctrl-c
#ifdef _WIN32
iret = signalqq(SIG$INT, cc_handler)
#endif
#ifdef __IFC
iret = signalqq(SIG$INT, cc_handler)
#endif
#if defined(__GFORTRAN__) || defined(__PGI)
interface
subroutine signalqq(h)
external h
end subroutine signalqq
end interface
call signalqq(cc_handler)
#endif
end subroutine signal_handler_init
!!!
!!! control-c handler
!!!
#ifdef _WIN32
function cc_handler(signum)
implicit none
!dec$attributes c :: cc_handler
integer(4) cc_handler
integer(2) signum
integer status
!!! save chain
write(*,*) 'Saving chain upto ', simuind
call MCMC_writechains(status)
cc_handler = 1
stop 'Coltrol-c interrupt'
end function cc_handler
#endif
#ifdef __IFC
function cc_handler(signum)
implicit none
!dec$attributes c :: cc_handler
integer(4) cc_handler
integer(2) signum
integer status
if (MCMC_running == 1) then
!!! save chain
write(*,*) 'Saving chain upto ', simuind
call MCMC_writechains(status)
end if
cc_handler = 1
stop 'Coltrol-c interrupt'
end function cc_handler
#endif
#if defined(__GFORTRAN__) || defined(__PGI)
subroutine cc_handler()
implicit none
integer :: status
if (MCMC_running == 1) then
write(*,*) 'Saving chain upto ', simuind
call MCMC_writechains(status)
end if
stop 'Coltrol-c interrupt'
end subroutine cc_handler
#endif