File: N:\mfix\model\exit.f

1     #include "version.inc"
2     MODULE exit
3        CONTAINS
4           SUBROUTINE MFIX_EXIT(myID, normal_termination)
5     
6     ! File unit for .OUT file
7           USE funits, only : UNIT_OUT
8     ! File unit for .LOG files
9           USE funits, only : UNIT_LOG
10     
11           use compar
12           use mpi_utility
13     
14           implicit none
15     
16     ! Rank ID
17           INTEGER, INTENT(IN) :: myID
18     ! if present, normal termination (won't print error message)
19           LOGICAL, INTENT(IN), OPTIONAL :: normal_termination
20     ! Logical showing that a file unit is open.
21           LOGICAL :: isOpen
22     ! The value passed via the dummy argument or the process ID.
23           INTEGER :: myID_l
24     ! Process ID (myPE) converted to a character string.
25           CHARACTER(len=64) :: myID_c
26     
27     ! Set the ID of the caller.
28           myID_c=''; WRITE(myID_c,*) myID
29     
30     ! Write out that this routine was called.
31           IF (.not. present(normal_termination)) THEN
32              IF(myPE == PE_IO) WRITE(*,1000)
33              IF(DMP_LOG) THEN
34                 INQUIRE(UNIT=UNIT_LOG,OPENED=isOpen)
35                 IF(isOPEN) WRITE(UNIT_LOG,1001) trim(adjustl(myID_c))
36              ENDIF
37           ENDIF
38     
39     ! Terminate MPI.
40           CALL exitMPI(myID_l)
41     
42     ! Close any open files.
43           CALL CLOSE_FILE(UNIT_OUT)
44           CALL CLOSE_FILE(UNIT_LOG)
45     
46     ! Last gasp...
47           IF(myPE == PE_IO) WRITE(*,1002)
48     
49     ! Hard Stop.
50           ERROR_STOP 1
51     
52      1000 FORMAT(2/,1x,70('*'),/' Fatal error reported on one or more',    &
53             ' processes. The .LOG file',/' may contain additional',        &
54             ' information about the failure.',/1x,70('*'))
55     
56      1001 FORMAT(2/,1x,70('*'),/' Fatal error reported on PE ',  &
57              A,'. The .LOG file may contain',/' additional ',     &
58             'information about the failure.',/1x,70('*'))
59     
60      1002 FORMAT(2/,1x,'Program Terminated.',2/)
61     
62           END SUBROUTINE MFIX_EXIT
63     
64     !``````````````````````````````````````````````````````````````````````!
65     ! Subroutine: CLOSE_FILE                                               !
66     !                                                                      !
67     ! Purpose: Close a file if it is open.                                 !
68     !......................................................................!
69           SUBROUTINE CLOSE_FILE(UNIT_l)
70     
71     ! Global Variables.
72     !---------------------------------------------------------------------//
73     ! NONE
74     
75           implicit none
76     
77     ! Dummy Arguments:
78     !---------------------------------------------------------------------//
79           INTEGER, INTENT(IN) :: UNIT_l
80     
81     ! Local Variables.
82     !---------------------------------------------------------------------//
83     ! Retruned status of the specifed file unit
84           INTEGER :: IOS
85     ! Logical indicating if the file is open
86           LOGICAL :: FOPEN
87     
88     ! If the file is open...
89           INQUIRE(UNIT=UNIT_l, OPENED=FOPEN, IOSTAT=IOS )
90     ! Close it.
91           IF(FOPEN) CLOSE(UNIT_l)
92     
93           RETURN
94           END SUBROUTINE CLOSE_FILE
95     
96     END MODULE exit
97