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

Last change on this file since 1752 was 1683, checked in by knoop, 9 years ago

last commit documented

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