-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathstop_file.f90
136 lines (94 loc) · 3.16 KB
/
stop_file.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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
!\
! -------------------------------------------------------------------
! -------------------------------------------------------------------
!/
subroutine check_stop
use ModGITM
use ModTime
use ModInputs, only: CPUTimeMax, iOutputUnit_, DoCheckStopFile
use ModMpi
implicit none
real, external :: get_timing
real*8 :: EndTimeLocal
logical :: IsThere
integer :: iError
if (.not.DoCheckStopFile) return
call report("check_stop",2)
call start_timing("check_stop")
EndTimeLocal = EndTime
inquire(file="GITM.STOP",EXIST=IsThere)
if (IsThere) then
if (iProc == 0) write(*,*) "GITM.STOP file found. Exiting."
EndTimeLocal = CurrentTime - 1.0
endif
if (get_timing("GITM") > CPUTimeMax) then
if (iProc == 0) write(*,*) "CPUTimeMax Exceeded. Exiting."
EndTimeLocal = CurrentTime - 1.0
open(unit=iOutputUnit_, file="GITM.CPU", status="unknown")
close(iOutputUnit_)
endif
call MPI_AllREDUCE(EndTimeLocal, EndTime, &
1, MPI_DOUBLE_PRECISION, MPI_MIN, iCommGITM, iError)
call check_start
call end_timing("check_stop")
end subroutine check_stop
!\
! -------------------------------------------------------------------
! -------------------------------------------------------------------
!/
subroutine delete_stop
use ModGITM
use ModInputs, only: iOutputUnit_
implicit none
logical :: IsThere
call report("delete_stop",2)
inquire(file='GITM.STOP',EXIST=IsThere)
if (IsThere .and. iProc == 0) then
open(iOutputUnit_, file = 'GITM.STOP', status = 'OLD')
close(iOutputUnit_, status = 'DELETE')
endif
inquire(file='GITM.DONE',EXIST=IsThere)
if (IsThere .and. iProc == 0) then
open(iOutputUnit_, file = 'GITM.DONE', status = 'OLD')
close(iOutputUnit_, status = 'DELETE')
endif
inquire(file='GITM.CPU',EXIST=IsThere)
if (IsThere .and. iProc == 0) then
open(iOutputUnit_, file = 'GITM.CPU', status = 'OLD')
close(iOutputUnit_, status = 'DELETE')
endif
end subroutine delete_stop
!\
! -------------------------------------------------------------------
! -------------------------------------------------------------------
!/
subroutine check_start
use ModGITM
use ModTime
use ModInputs, only: CPUTimeMax, iOutputUnit_
use ModMpi
use ModUtilities, only: sleep
implicit none
real*8 :: EndTimeLocal
logical :: IsThere
integer :: iError
if ((CurrentTime-dt) < PauseTime .and. CurrentTime > PauseTime) then
write(*,*) "Pausing"
IsThere = .false.
do while (.not.IsThere)
inquire(file="GITM.START",EXIST=IsThere)
if (IsThere .and. iProc == 0) then
if (iProc == 0) then
write(*,*) "GITM.START file found. Continuing."
open(iOutputUnit_, file = 'GITM.START', status = 'OLD')
close(iOutputUnit_, status = 'DELETE')
endif
endif
if (.not. IsThere) call sleep(2.0)
call MPI_BARRIER(iCommGITM,iError)
enddo
! Here is where to open and read the file that will set the new pause time
! and update the state of GITM.
PauseTime = PauseTime + 300.0 ! delete this when you read the new file....
endif
end subroutine check_start