[u/mrichter/AliRoot.git] / GEANT321 / gparal / gpabort.F

*CMZ :          23/08/95  15.00.00  by  John Apostolakis
*-- Author :    John Apostolakis  CERN/GP-MIMD2   22/07/94
      subroutine gpabort
#if defined(CERNLIB_PARA)
c
c      This makes a "best attempt" to abort all parallel Geant tasks.
c      It should be used if a fatal error is detected in a task that
c      cannot be recovered, or will cause irreperable damage later.
c
      implicit none
      integer  ierror
#include "geant321/mpifinc.inc"
#include "geant321/multiprox.inc"
#include "geant321/gcunit.inc"
      write(chmail,*)
     $' gpabort: calling MPI_abort to terminate program from  node ',
     $ nprank
      call gmail(2,2)

      call MPI_abort( MPI_COMM_WORLD, ierror )
      if (ierror .ne. 0)  then
	 write(chmail,*)
     $     ' ERROR in gpabort: MPI_abort failed to terminate on node ',
     $     nprank, ' error code: ', ierror, ' STOPPING this node.'
         call gmail(2,2)
         stop
      endif
#endif
      return
      end
Commit	Line	Data
fe4da5cc	1	*CMZ : 23/08/95 15.00.00 by John Apostolakis
	2	*-- Author : John Apostolakis CERN/GP-MIMD2 22/07/94
	3	subroutine gpabort
	4	#if defined(CERNLIB_PARA)
	5	c
	6	c This makes a "best attempt" to abort all parallel Geant tasks.
	7	c It should be used if a fatal error is detected in a task that
	8	c cannot be recovered, or will cause irreperable damage later.
	9	c
	10	implicit none
	11	integer ierror
	12	#include "geant321/mpifinc.inc"
	13	#include "geant321/multiprox.inc"
	14	#include "geant321/gcunit.inc"
	15	write(chmail,*)
	16	$' gpabort: calling MPI_abort to terminate program from node ',
	17	$ nprank
	18	call gmail(2,2)
	19
	20	call MPI_abort( MPI_COMM_WORLD, ierror )
	21	if (ierror .ne. 0) then
	22	write(chmail,*)
	23	$ ' ERROR in gpabort: MPI_abort failed to terminate on node ',
	24	$ nprank, ' error code: ', ierror, ' STOPPING this node.'
	25	call gmail(2,2)
	26	stop
	27	endif
	28	#endif
	29	return
	30	end
	31