source: palm/trunk/SOURCE/local_stop.f90 @ 226

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

preparations for the next release

  • Property svn:keywords set to Id
File size: 3.9 KB
RevLine 
[1]1 SUBROUTINE local_stop
2
[3]3!------------------------------------------------------------------------------!
[1]4! Actual revisions:
5! -----------------
[226]6!
[1]7!
8! Former revisions:
9! -----------------
[3]10! $Id: local_stop.f90 226 2009-02-02 07:39:34Z raasch $
[110]11!
[226]12! 213 2008-11-13 10:26:18Z raasch
13! Implementation of a MPI-1 coupling: replaced myid with target_id.
14! The uncoupled case allows stop or mpi_abort depending on new steering
15! parameter abort_mode, which is set in routine message.
16!
[198]17! 147 2008-02-01 12:41:46Z raasch
18! Bugfix: a stop command was missing in some cases of the parallel branch
19!
[110]20! 108 2007-08-24 15:10:38Z letzel
21! modifications to terminate coupled runs
22!
[3]23! RCS Log replace by Id keyword, revision history cleaned up
24!
[1]25! Revision 1.2  2003/03/16 09:40:28  raasch
26! Two underscores (_) are placed in front of all define-strings
27!
28! Revision 1.1  2002/12/19 15:46:23  raasch
29! Initial revision
30!
31!
32! Description:
33! ------------
34! Stop program execution
[3]35!------------------------------------------------------------------------------!
[1]36
37    USE pegrid
[108]38    USE control_parameters
[1]39
[206]40
[1]41#if defined( __parallel )
[108]42    IF ( coupling_mode == 'uncoupled' )  THEN
[213]43       IF ( abort_mode == 1 )  THEN
44          CALL MPI_FINALIZE( ierr )
45          STOP
46       ELSEIF ( abort_mode == 2 )  THEN
47          CALL MPI_ABORT( comm2d, 9999, ierr )
48       ENDIF
[108]49    ELSE
[1]50
[108]51       SELECT CASE ( terminate_coupled_remote )
52
53          CASE ( 0 )
54             IF ( myid == 0 )  THEN
55                PRINT*, '+++ local_stop:'
56                PRINT*, '    local model "', TRIM( coupling_mode ), &
57                     '" stops now'
58             ENDIF
59!
60!--          Inform the remote model of the termination and its reason, provided
61!--          the remote model has not already been informed of another
62!--          termination reason (terminate_coupled > 0) before.
63             IF ( terminate_coupled == 0 )  THEN
64                terminate_coupled = 1
65                CALL MPI_SENDRECV( &
[206]66                     terminate_coupled,        1, MPI_INTEGER, target_id,  0, &
67                     terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0, &
[108]68                     comm_inter, status, ierr )
69             ENDIF
70             CALL MPI_FINALIZE( ierr )
[147]71             STOP
[108]72
73          CASE ( 1 )
74             IF ( myid == 0 )  THEN
75                PRINT*, '+++ local_stop:'
76                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
77                     '" stopped'
78             ENDIF
79             CALL MPI_FINALIZE( ierr )
[147]80             STOP
[108]81
82          CASE ( 2 )
83             IF ( myid == 0 )  THEN
84                PRINT*, '+++ local_stop:'
85                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
86                     '" terminated'
87                PRINT*, '    with stop_dt = .T.'
88             ENDIF
89             stop_dt = .TRUE.
90
91          CASE ( 3 )
92             IF ( myid == 0 )  THEN
93                PRINT*, '+++ local_stop:'
94                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
95                     '" terminated'
96                PRINT*, '    with terminate_run = .T. (CPU-time limit)'
97             ENDIF
98             terminate_run = .TRUE.
99
100          CASE ( 4 )
101             IF ( myid == 0 )  THEN
102                PRINT*, '+++ local_stop:'
103                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
104                     '" terminated'
105                PRINT*, '    with terminate_run = .T. (restart)'
106             ENDIF
107             terminate_run = .TRUE.
108             time_restart = time_restart + dt_restart
109
110          CASE ( 5 )
111             IF ( myid == 0 )  THEN
112                PRINT*, '+++ local_stop:'
113                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
114                     '" terminated'
115                PRINT*, '    with terminate_run = .T. (single restart)'
116             ENDIF
117             terminate_run = .TRUE.
118             time_restart = 9999999.9
119
120       END SELECT
121
122    ENDIF
123
124#else
125
[1]126    STOP
127
[108]128#endif
129
[1]130 END SUBROUTINE local_stop   
Note: See TracBrowser for help on using the repository browser.