exit.f

Go to the documentation of this file.

#include "version.inc"
MODULE exit
   CONTAINS
      SUBROUTINE mfix_exit(myID, normal_termination)

! File unit for .OUT file
      USE funits, only : unit_out
! File unit for .LOG files
      USE funits, only : unit_log

      use compar
      use mpi_utility

      implicit none

! Rank ID
      INTEGER, INTENT(IN) :: myID
! if present, normal termination (won't print error message)
      LOGICAL, INTENT(IN), OPTIONAL :: normal_termination
! Logical showing that a file unit is open.
      LOGICAL :: isOpen
! The value passed via the dummy argument or the process ID.
      INTEGER :: myID_l
! Process ID (myPE) converted to a character string.
      CHARACTER(len=64) :: myID_c

! Set the ID of the caller.
      myid_c=''; WRITE(myid_c,*) myid

! Write out that this routine was called.
      IF (.not. present(normal_termination)) THEN
         IF(mype == pe_io) WRITE(*,1000)
         IF(dmp_log) THEN
            INQUIRE(unit=unit_log,opened=isopen)
            IF(isopen) WRITE(unit_log,1001) trim(adjustl(myid_c))
         ENDIF
      ENDIF

! Terminate MPI.
      CALL exitmpi(myid_l)

! Close any open files.
      CALL close_file(unit_out)
      CALL close_file(unit_log)

! Last gasp...
      IF(mype == pe_io) WRITE(*,1002)

! Hard Stop.
      error_stop 1

 1000 FORMAT(2/,1x,70('*'),/' Fatal error reported on one or more',    &
        ' processes. The .LOG file',/' may contain additional',        &
        ' information about the failure.',/1x,70('*'))

 1001 FORMAT(2/,1x,70('*'),/' Fatal error reported on PE ',  &
         a,'. The .LOG file may contain',/' additional ',     &
        'information about the failure.',/1x,70('*'))

 1002 FORMAT(2/,1x,'Program Terminated.',2/)

      END SUBROUTINE mfix_exit

!``````````````````````````````````````````````````````````````````````!
! Subroutine: CLOSE_FILE                                               !
!                                                                      !
! Purpose: Close a file if it is open.                                 !
!......................................................................!
      SUBROUTINE close_file(UNIT_l)

! Global Variables.
!---------------------------------------------------------------------//
! NONE

      implicit none

! Dummy Arguments:
!---------------------------------------------------------------------//
      INTEGER, INTENT(IN) :: UNIT_l

! Local Variables.
!---------------------------------------------------------------------//
! Retruned status of the specifed file unit
      INTEGER :: IOS
! Logical indicating if the file is open
      LOGICAL :: FOPEN

! If the file is open...
      INQUIRE(unit=unit_l, opened=fopen, iostat=ios )
! Close it.
      IF(fopen) CLOSE(unit_l)

      RETURN
      END SUBROUTINE close_file

END MODULE exit