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

Last change on this file since 1119 was 1037, checked in by raasch, 12 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 5.3 KB
RevLine 
[1]1 SUBROUTINE local_stop
2
[1036]3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
[484]20! Current revisions:
[1]21! -----------------
22!
[810]23!
[1]24! Former revisions:
25! -----------------
[3]26! $Id: local_stop.f90 1037 2012-10-22 14:10:22Z raasch $
[110]27!
[1037]28! 1036 2012-10-22 13:43:42Z raasch
29! code put under GPL (PALM 3.9)
30!
[810]31! 809 2012-01-30 13:32:58Z maronga
32! Bugfix: replaced .AND. and .NOT. with && and ! in the preprocessor directives
33!
[808]34! 807 2012-01-25 11:53:51Z maronga
35! New cpp directive "__check" implemented which is used by check_namelist_files
36!
[668]37! 667 2010-12-23 12:06:00Z suehring/gryschka
38! Exchange of terminate_coupled between ocean and atmosphere via PE0
39!
[226]40! 213 2008-11-13 10:26:18Z raasch
41! Implementation of a MPI-1 coupling: replaced myid with target_id.
42! The uncoupled case allows stop or mpi_abort depending on new steering
43! parameter abort_mode, which is set in routine message.
44!
[198]45! 147 2008-02-01 12:41:46Z raasch
46! Bugfix: a stop command was missing in some cases of the parallel branch
47!
[110]48! 108 2007-08-24 15:10:38Z letzel
49! modifications to terminate coupled runs
50!
[3]51! RCS Log replace by Id keyword, revision history cleaned up
52!
[1]53! Revision 1.2  2003/03/16 09:40:28  raasch
54! Two underscores (_) are placed in front of all define-strings
55!
56! Revision 1.1  2002/12/19 15:46:23  raasch
57! Initial revision
58!
59!
60! Description:
61! ------------
62! Stop program execution
[3]63!------------------------------------------------------------------------------!
[1]64
65    USE pegrid
[108]66    USE control_parameters
[1]67
[206]68
[809]69#if defined( __parallel ) && ! defined ( __check )
[108]70    IF ( coupling_mode == 'uncoupled' )  THEN
[213]71       IF ( abort_mode == 1 )  THEN
72          CALL MPI_FINALIZE( ierr )
73          STOP
74       ELSEIF ( abort_mode == 2 )  THEN
75          CALL MPI_ABORT( comm2d, 9999, ierr )
76       ENDIF
[108]77    ELSE
[1]78
[108]79       SELECT CASE ( terminate_coupled_remote )
80
81          CASE ( 0 )
82             IF ( myid == 0 )  THEN
83                PRINT*, '+++ local_stop:'
84                PRINT*, '    local model "', TRIM( coupling_mode ), &
85                     '" stops now'
86             ENDIF
87!
88!--          Inform the remote model of the termination and its reason, provided
89!--          the remote model has not already been informed of another
90!--          termination reason (terminate_coupled > 0) before.
91             IF ( terminate_coupled == 0 )  THEN
92                terminate_coupled = 1
[667]93                IF ( myid == 0 ) THEN
94                   CALL MPI_SENDRECV( &
95                        terminate_coupled,        1, MPI_INTEGER, target_id,  0, &
96                        terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0, &
97                        comm_inter, status, ierr )
98                ENDIF
99                CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_REAL, 0, comm2d, ierr)
[108]100             ENDIF
101             CALL MPI_FINALIZE( ierr )
[147]102             STOP
[108]103
104          CASE ( 1 )
105             IF ( myid == 0 )  THEN
106                PRINT*, '+++ local_stop:'
107                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
108                     '" stopped'
109             ENDIF
110             CALL MPI_FINALIZE( ierr )
[147]111             STOP
[108]112
113          CASE ( 2 )
114             IF ( myid == 0 )  THEN
115                PRINT*, '+++ local_stop:'
116                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
117                     '" terminated'
118                PRINT*, '    with stop_dt = .T.'
119             ENDIF
120             stop_dt = .TRUE.
121
122          CASE ( 3 )
123             IF ( myid == 0 )  THEN
124                PRINT*, '+++ local_stop:'
125                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
126                     '" terminated'
127                PRINT*, '    with terminate_run = .T. (CPU-time limit)'
128             ENDIF
129             terminate_run = .TRUE.
130
131          CASE ( 4 )
132             IF ( myid == 0 )  THEN
133                PRINT*, '+++ local_stop:'
134                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
135                     '" terminated'
136                PRINT*, '    with terminate_run = .T. (restart)'
137             ENDIF
138             terminate_run = .TRUE.
139             time_restart = time_restart + dt_restart
140
141          CASE ( 5 )
142             IF ( myid == 0 )  THEN
143                PRINT*, '+++ local_stop:'
144                PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
145                     '" terminated'
146                PRINT*, '    with terminate_run = .T. (single restart)'
147             ENDIF
148             terminate_run = .TRUE.
149             time_restart = 9999999.9
150
151       END SELECT
152
153    ENDIF
154
155#else
156
[1]157    STOP
158
[108]159#endif
160
[1]161 END SUBROUTINE local_stop   
Note: See TracBrowser for help on using the repository browser.