1!
2! Copyright (C) 2001-2009 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!----------------------------------------------------------------------------
9SUBROUTINE stop_run( exit_status )
10  !----------------------------------------------------------------------------
11  !! Close all files and synchronize processes before stopping:
12  !
13  !! * exit_status = 0: successfull execution, remove temporary files;
14  !! * exit_status =-1: code stopped by user request;
15  !! * exit_status = 1: convergence not achieved.
16  !
17  !! Do not remove temporary files needed for restart.
18  !
19  USE io_global,          ONLY : ionode
20  USE mp_global,          ONLY : mp_global_end
21  USE environment,        ONLY : environment_end
22  USE io_files,           ONLY : iuntmp, seqopn
23  !
24  IMPLICIT NONE
25  !
26  INTEGER, INTENT(IN) :: exit_status
27  LOGICAL             :: exst, opnd, lflag
28  !
29  lflag = ( exit_status == 0 )
30  IF ( lflag ) THEN
31     !
32     ! ... remove files needed only to restart
33     !
34     CALL seqopn( iuntmp, 'restart', 'UNFORMATTED', exst )
35     CLOSE( UNIT = iuntmp, STATUS = 'DELETE' )
36     !
37     IF ( ionode ) THEN
38        CALL seqopn( iuntmp, 'update', 'FORMATTED', exst )
39        CLOSE( UNIT = iuntmp, STATUS = 'DELETE' )
40        CALL seqopn( iuntmp, 'para', 'FORMATTED', exst )
41        CLOSE( UNIT = iuntmp, STATUS = 'DELETE' )
42     ENDIF
43     !
44  ENDIF
45  !
46  CALL close_files( lflag )
47  !
48  CALL print_clock_pw()
49  !
50  CALL clean_pw( .TRUE. )
51  !
52  CALL environment_end( 'PWSCF' )
53  !
54  CALL mp_global_end()
55  !
56END SUBROUTINE stop_run
57!
58!-----------------------------------------
59SUBROUTINE do_stop( exit_status )
60  !---------------------------------------
61  !! Stop the run.
62  !
63  IMPLICIT NONE
64  !
65  INTEGER, INTENT(IN) :: exit_status
66  !
67  IF ( exit_status == -1 ) THEN
68     ! -1 is not an acceptable value for stop in fortran;
69     ! convert it to 255
70     STOP 255
71  ELSEIF ( exit_status == 0 ) THEN
72     STOP
73  ELSEIF ( exit_status == 1 ) THEN
74     STOP 1
75  ELSEIF ( exit_status == 2 ) THEN
76     STOP 2
77  ELSEIF ( exit_status == 3 ) THEN
78     STOP 3
79  ELSEIF ( exit_status == 4 ) THEN
80     STOP 4
81  ELSEIF ( exit_status == 130) THEN
82     STOP
83  ELSEIF ( exit_status == 255 ) THEN
84     STOP 255
85  ELSEIF ( exit_status == 254 ) THEN
86     STOP 254
87  ELSE
88     ! unimplemented value
89     STOP 128
90  ENDIF
91  !
92END SUBROUTINE do_stop
93!
94!----------------------------------------------------------------------------
95SUBROUTINE closefile()
96  !----------------------------------------------------------------------------
97  !! Close all files and synchronize processes before stopping.
98  !! Called by "sigcatch" when it receives a signal.
99  !
100  USE io_global,  ONLY :  stdout
101  !
102  WRITE( stdout,'(5X,"Signal Received, stopping ... ")')
103  !
104  CALL stop_run( 255 )
105  !
106  RETURN
107  !
108END SUBROUTINE closefile
109