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

Last change on this file since 102 was 4, checked in by raasch, 17 years ago

Id keyword set as property for all *.f90 files

  • Property svn:keywords set to Id
File size: 3.0 KB
Line 
1 SUBROUTINE check_for_restart
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: check_for_restart.f90 4 2007-02-13 11:33:16Z raasch $
11! RCS Log replace by Id keyword, revision history cleaned up
12!
13! Revision 1.11  2007/02/11 12:55:13  raasch
14! Informative output to the job protocol
15!
16! Revision 1.1  1998/03/18 20:06:51  raasch
17! Initial revision
18!
19!
20! Description:
21! ------------
22! Set stop flag, if restart is neccessary because of expiring cpu-time or
23! if it is forced by user
24!------------------------------------------------------------------------------!
25
26    USE pegrid
27    USE control_parameters
28
29    IMPLICIT NONE
30
31
32    LOGICAL :: terminate_run_l
33    REAL ::  remaining_time
34
35
36!
37!-- Check remaining CPU-time
38    CALL local_tremain( remaining_time )
39
40!
41!-- If necessary set a flag to stop the model run
42    terminate_run_l = .FALSE.
43    IF ( remaining_time <= termination_time_needed  .AND. &
44         write_binary(1:4) == 'true' )  THEN
45
46       terminate_run_l = .TRUE.
47    ENDIF
48
49#if defined( __parallel )
50!
51!-- Make a logical OR for all processes. Stop the model run if at least
52!-- one processor has reached the time limit.
53    CALL MPI_ALLREDUCE( terminate_run_l, terminate_run, 1, MPI_LOGICAL, &
54                        MPI_LOR, comm2d, ierr )
55#else
56    terminate_run = terminate_run_l
57#endif
58
59!
60!-- Output that job will be terminated
61    IF ( terminate_run  .AND.  myid == 0 )  THEN
62       PRINT*, '*** WARNING: run will be terminated because it is running out of job cpu', &
63                    'limit'
64       PRINT*, '             remaining time:         ', remaining_time, ' s'
65       PRINT*, '             termination time needed:', termination_time_needed, ' s'
66    ENDIF
67
68!
69!-- Set the stop flag also, if restart is forced by user
70    IF ( time_restart /= 9999999.9  .AND.  time_restart < simulated_time ) &
71    THEN
72!
73!--    Restart is not neccessary, if the end time of the run (given by
74!--    the user) has been reached
75       IF ( simulated_time < end_time )  THEN
76          terminate_run = .TRUE.
77!
78!--       Increment restart time, if forced by user, otherwise set restart
79!--       time to default (no user restart)
80          IF ( dt_restart /= 9999999.9 )  THEN
81             time_restart = time_restart + dt_restart
82          ELSE
83             time_restart = 9999999.9
84          ENDIF
85
86          IF ( myid == 0 )  THEN
87             PRINT*, '*** INFORMATIVE: run will be terminated due to user settings of'
88             PRINT*, '                 restart_time / dt_restart'
89             PRINT*, '                 new restart time is: ', time_restart, ' s'
90          ENDIF
91    ELSE
92          time_restart = 9999999.9
93       ENDIF
94    ENDIF
95
96!
97!-- If the run is stopped, set a flag file which is necessary to initiate
98!-- the start of a continuation run
99    IF ( terminate_run  .AND.  myid == 0 )  THEN
100
101       OPEN ( 90, FILE='CONTINUE_RUN', FORM='FORMATTED' )
102       WRITE ( 90, '(A)' )  TRIM( run_description_header )
103       CLOSE ( 90 )
104
105    ENDIF
106
107
108 END SUBROUTINE check_for_restart
Note: See TracBrowser for help on using the repository browser.