    module ferror
!  FERROR - MPI version.  This module is used by the MPI wrappers (mp.f90)
!  and so must be compiled first.  It does not use the MPI shutdown
!  calls to avoid a circular dependency between this module and the mp module.
!
!  Required packages:
!
    use io
    use mpi
    contains
!------------------------------------------------------------------------
    subroutine fexit(msg,errcode,unit,mpid)
!  FEXIT - print the indicated message and halt with an exit code (default 0).
!  ERRCODE : if present, the exit error code to return to the shell.
!  UNIT    : if present, the logical unit number on which to diplay msg
!            (default 0, std error).
!  MPID : if present, the MPI process rank.  If MPI is used, then there may be
!  no reliable way to report ERRCODE; we'll call exit with ERRCODE but
!  there are no guarantees that it is reported to the environment.
!
    implicit none
    character(*),intent(in)::msg
    integer,intent(in),optional::errcode,unit,mpid
!
    character(MAX_FILE_NAME_LEN)::progname
    integer::iunit,ierr,code
    logical::mpinit
!
    call getarg(0,progname)
    if(present(unit)) then
       iunit=unit
    else
       iunit=IERR
    endif
    if(present(errcode)) then
       code=errcode
    else
       code=1
    endif
    if(len_trim(progname).gt.0) &
       write(iunit,100,advance='no') trim(progname)//': '
100 format(a)
    write(iunit,100) msg
    call mpi_initialized(mpinit,ierr)
    if(mpinit) then
       if(present(mpid)) write(iunit,101) 'MPI id:',mpid
       if(present(errcode)) write(iunit,101) 'error code:',code
       call mpi_finalize(ierr)
    else
       call exit(code)
    endif
101 format(a,1x,i0)
    stop
    end subroutine fexit
!------------------------------------------------------------------------
    subroutine fabort(msg,unit,mpid)
!  FABORT - print the indicated message and abort.  Depending on the
!  environment, this routine may produce a memory dump.
!  UNIT    : if present, the logical unit number on which to diplay msg
!            (default 0, std error).
!
    implicit none
    character(*),intent(in)::msg
    integer,intent(in),optional::unit,mpid
!
    character(MAX_FILE_NAME_LEN)::progname
    integer::iunit
    logical::mpinit
!
    call getarg(0,progname)
    if(present(unit)) then
       iunit=unit
    else
       iunit=IERR
    endif
    if(len_trim(progname).gt.0) &
       write(iunit,100,advance='no') trim(progname)//': '
100 format(a)
    call mpi_initialized(mpinit,ierr)
    if(mpinit) then
       if(present(mpid)) write(iunit,101,advance='no') mpid
       write(iunit,100) msg
       call mpi_abort(MPI_COMM_WORLD,2,ierr)  ! 1 is usual MPI error exit code
       call exit(1)  ! just in case
    else
       write(iunit,100) msg
       call abort
    endif
101 format('MPI id: ',i0,': ')
    !  Never returns
    end subroutine fabort
!------------------------------------------------------------------------
    subroutine finfo(msg,unit,mpid)
!  FINFO - print the indicated message and return.
!  UNIT    : if present, the logical unit number on which to diplay msg
!            (default 0, std error).
!  MPID : if present, the MPI process rank
!
    implicit none
    character(*),intent(in)::msg
    integer,intent(in),optional::unit,mpid
!
    character(MAX_FILE_NAME_LEN)::progname
    integer::iunit
    logical::mpinit
!
    call getarg(0,progname)
    if(present(unit)) then
       iunit=unit
    else
       iunit=IERR
    endif
!
    if(len_trim(progname).gt.0) &
       write(iunit,100,advance='no') trim(progname)//': '
100 format(a)
    call mpi_initialized(mpinit,ierr)
    if(mpinit.and.present(mpid)) write(iunit,101,advance='no') mpid
101 format('MPI id: ',i0,': ')
    write(iunit,100) trim(msg)
    return
    end subroutine finfo
!------------------------------------------------------------------------
    end module ferror
