ecearth3/sources/oasis3-mct/lib/mct/mpeu/m_dropdead.F90

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-----------------------------------------------------------------------
! CVS m_dropdead.F90,v 1.4 2007-01-10 03:04:46 rloy Exp
! CVS MCT_2_8_0  
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: m_dropdead - An abort() with a style
!
! !DESCRIPTION:
!
! !INTERFACE:

    module m_dropdead
      implicit none
      private	! except

      public	:: die	! terminate a program with a condition

      interface die; module procedure	&
	die_,	&
	diex_
      end interface

! !REVISION HISTORY:
! 	20Feb97 - Jing Guo <guo@eramus> - defined template
!EOP
!_______________________________________________________________________

contains

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-----------------------------------------------------------------------
!BOP
! !IROUTINE: die_ - Clean up and raise an exception to the OS
!
! !DESCRIPTION:
!
!   A call to die() exits the program with minimum information for
!   both the user and the operating system.
!
! !INTERFACE:

    subroutine die_(where)
      use m_stdio, only : stderr
      use m_mpif90,only : MP_comm_world
      use m_mpif90,only : MP_comm_rank
      use m_mpif90,only : MP_abort
      use m_mpif90,only : MP_initialized
      implicit none
      character(len=*),intent(in) :: where	! where it is called

! !REVISION HISTORY:
! 	20Feb97 - Jing Guo <guo@eramus> - defined template
!       09Jan07 - R. Loy <rloy@mcs.anl.gov> - check for initialized, add
!                 options for abort 
!
!EOP
!_______________________________________________________________________

  character(len=*),parameter :: myname_='MCT(MPEU)::die.'
  integer :: myrank,ier
  logical :: initialized

  call MP_initialized(initialized,ier)

  if (initialized) then

	!-------------------------------------------------
	! MPI_ should have been initialized for this call
	!-------------------------------------------------

    call MP_comm_rank(MP_comm_world,myrank,ier)

	! a message for the users:

    write(stderr,'(z3.3,5a)') myrank,'.',myname_,	&
      ': from ',trim(where),'()'

	! raise a condition to the OS

#ifdef ENABLE_UNIX_ABORT
    call abort
#else
    call MP_abort(MP_comm_world,2,ier)
#endif

  else

    write(stderr,'(5a)') 'unknown rank .',myname_,	&
      ': from ',trim(where),'()'

    call abort

  endif

end subroutine die_
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: diex_ - Clean up and raise an exception to the OS
!
! !DESCRIPTION:
!
!   A call to die() exits the program with minimum information for
!   both the user and the operating system.  This implementation,
!   however, may be used in conjunction with with a source preprocessor
!   to produce more detailed location information.
!
! !INTERFACE:

    subroutine diex_(where,fnam,line)
      use m_stdio, only : stderr
      use m_mpif90,only : MP_comm_world
      use m_mpif90,only : MP_comm_rank
      use m_mpif90,only : MP_abort
      use m_mpif90,only : MP_initialized
      implicit none
      character(len=*),intent(in) :: where	! where it is called
      character(len=*),intent(in) :: fnam
      integer,intent(in) :: line

! !REVISION HISTORY:
! 	20Feb97 - Jing Guo <guo@eramus> - defined template
!       09Jan07 - R. Loy <rloy@mcs.anl.gov> - check for initialized, add
!                 options for abort 
!
!EOP
!_______________________________________________________________________

  character(len=*),parameter :: myname_='die.'
  integer :: myrank,ier
  character(len=16) :: lineno

  logical :: initialized

  write(lineno,'(i16)') line

  call MP_initialized(initialized,ier)

  if (initialized) then

	!-------------------------------------------------
	! MPI_ should have been initialized for this call
	!-------------------------------------------------

    call MP_comm_rank(MP_comm_world,myrank,ier)

	! a message for the users:
    write(stderr,'(z3.3,9a)') myrank,'.',myname_,	&
      ': from ',trim(where),'()',	&
      ', line ',trim(adjustl(lineno)),	&
      ' of file ',fnam

	! raise a condition to the OS

#ifdef ENABLE_UNIX_ABORT
    call abort
#else
    call MP_abort(MP_comm_world,2,ier)
#endif

  else

	! a message for the users:
    write(stderr,'(9a)') 'unknown rank .',myname_,	&
      ': from ',trim(where),'()',	&
      ', line ',trim(adjustl(lineno)),	&
      ' of file ',fnam

    call abort
  endif


end subroutine diex_
!=======================================================================
end module m_dropdead
!.