source: palm/trunk/SOURCE/check_for_restart.f90 @ 217

Last change on this file since 217 was 206, checked in by raasch, 15 years ago

ocean-atmosphere coupling realized with MPI-1, adjustments in mrun, mbuild, subjob for lcxt4

  • Property svn:keywords set to Id
File size: 5.0 KB
Line 
1 SUBROUTINE check_for_restart
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Implementation of an MPI-1 coupling: replaced myid with target_id
7!
8! Former revisions:
9! -----------------
10! $Id: check_for_restart.f90 206 2008-10-13 14:59:11Z letzel $
11!
12! 108 2007-08-24 15:10:38Z letzel
13! modifications to terminate coupled runs
14!
15! RCS Log replace by Id keyword, revision history cleaned up
16!
17! Revision 1.11  2007/02/11 12:55:13  raasch
18! Informative output to the job protocol
19!
20! Revision 1.1  1998/03/18 20:06:51  raasch
21! Initial revision
22!
23!
24! Description:
25! ------------
26! Set stop flag, if restart is neccessary because of expiring cpu-time or
27! if it is forced by user
28!------------------------------------------------------------------------------!
29
30    USE pegrid
31    USE control_parameters
32
33    IMPLICIT NONE
34
35
36    LOGICAL :: terminate_run_l
37    REAL ::  remaining_time
38
39
40!
41!-- Check remaining CPU-time
42    CALL local_tremain( remaining_time )
43
44!
45!-- If necessary set a flag to stop the model run
46    terminate_run_l = .FALSE.
47    IF ( remaining_time <= termination_time_needed  .AND. &
48         write_binary(1:4) == 'true' )  THEN
49
50       terminate_run_l = .TRUE.
51    ENDIF
52
53#if defined( __parallel )
54!
55!-- Make a logical OR for all processes. Stop the model run if at least
56!-- one processor has reached the time limit.
57    CALL MPI_ALLREDUCE( terminate_run_l, terminate_run, 1, MPI_LOGICAL, &
58                        MPI_LOR, comm2d, ierr )
59#else
60    terminate_run = terminate_run_l
61#endif
62
63!
64!-- Output that job will be terminated
65    IF ( terminate_run  .AND.  myid == 0 )  THEN
66       PRINT*, '*** WARNING: run will be terminated because it is running', &
67                    ' out of job cpu limit'
68       PRINT*, '             remaining time:         ', remaining_time, ' s'
69       PRINT*, '             termination time needed:', &
70                             termination_time_needed, ' s'
71    ENDIF
72
73!
74!-- In case of coupled runs inform the remote model of the termination
75!-- and its reason, provided the remote model has not already been
76!-- informed of another termination reason (terminate_coupled > 0) before,
77!-- or vice versa (terminate_coupled_remote > 0).
78    IF ( terminate_run .AND. TRIM( coupling_mode ) /= 'uncoupled'  .AND. &
79         terminate_coupled == 0  .AND.  terminate_coupled_remote == 0 )  THEN
80
81       terminate_coupled = 3
82       CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER,          &
83                          target_id, 0,                                      &
84                          terminate_coupled_remote, 1, MPI_INTEGER,          &
85                          target_id, 0,                                      &
86                          comm_inter, status, ierr )
87    ENDIF
88
89!
90!-- Set the stop flag also, if restart is forced by user
91    IF ( time_restart /= 9999999.9  .AND.  time_restart < simulated_time ) &
92    THEN
93!
94!--    Restart is not neccessary, if the end time of the run (given by
95!--    the user) has been reached
96       IF ( simulated_time < end_time )  THEN
97          terminate_run = .TRUE.
98!
99!--       Increment restart time, if forced by user, otherwise set restart
100!--       time to default (no user restart)
101          IF ( dt_restart /= 9999999.9 )  THEN
102             time_restart = time_restart + dt_restart
103          ELSE
104             time_restart = 9999999.9
105          ENDIF
106
107          IF ( myid == 0 )  THEN
108             PRINT*, '*** INFORMATIVE: run will be terminated due to user ', &
109                                       'settings of'
110             PRINT*, '                 restart_time / dt_restart'
111             PRINT*, '                 new restart time is: ', time_restart, &
112                                       ' s'
113          ENDIF
114!
115!--       In case of coupled runs inform the remote model of the termination
116!--       and its reason, provided the remote model has not already been
117!--       informed of another termination reason (terminate_coupled > 0) before,
118!--       or vice versa (terminate_coupled_remote > 0).
119          IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0  &
120               .AND.  terminate_coupled_remote == 0 )  THEN
121
122             IF ( dt_restart /= 9999999.9 )  THEN
123                terminate_coupled = 4
124             ELSE
125                terminate_coupled = 5
126             ENDIF
127             CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER,    &
128                                target_id,  0,                               &
129                                terminate_coupled_remote, 1, MPI_INTEGER,    &
130                                target_id,  0,                               &
131                                comm_inter, status, ierr )
132          ENDIF
133       ELSE
134          time_restart = 9999999.9
135       ENDIF
136    ENDIF
137
138!
139!-- If the run is stopped, set a flag file which is necessary to initiate
140!-- the start of a continuation run
141    IF ( terminate_run  .AND.  myid == 0 )  THEN
142
143       OPEN ( 90, FILE='CONTINUE_RUN', FORM='FORMATTED' )
144       WRITE ( 90, '(A)' )  TRIM( run_description_header )
145       CLOSE ( 90 )
146
147    ENDIF
148
149
150 END SUBROUTINE check_for_restart
Note: See TracBrowser for help on using the repository browser.