psmile_abort.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PSMILe_Abort
!
! !INTERFACE:
!
      subroutine psmile_abort
!
! !USES:
!
      use PSMILe_common, dummy_interface => psmile_abort

      implicit none
!
! !LOCAL VARIABLES
!
      integer :: ila_args(PSMILe_trans_Header_length)
      integer :: ierror

#ifdef PRISM_with_MPI2
      logical :: finalized      
#endif
!
! !DESCRIPTION:
!
!     Best attempt to abort all tasks of the current PRISM application
!     called from psmile internal routines
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 01.12.03    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_abort.F90 2937 2011-02-03 10:18:38Z redler $
!  $Autor$

   Character(len=len_cvs_string), save :: mycvs = 
      '$Id: psmile_abort.F90 2937 2011-02-03 10:18:38Z redler $'
!
!----------------------------------------------------------------------

      ierror = 0

!
! 1st Send the header message to the transformer
!
     ila_args(1) = PSMILe_trans_Abort
     ila_args(2) = global_rank
     ila_args(3) = 0
     ila_args(4) = Appl%sequence_number
     ila_args(5) = Appl%rank

     CALL MPI_Send(ila_args(1), PSMILe_trans_Header_length, MPI_Integer, &
                      PRISMdrv_root, 0, comm_trans, ierror)
!rr  call psmile_trs_inform(ila_args, PRISMdrv_root, ierror)

! 2nd flush write buffer

      print *, trim(ch_id), ': psmile_abort called from application ', Appl%name
      call psmile_flushstd
!
! 3rd shut down tasks
!
!     MPI_Abort is now called by the transformer
!
!     call MPI_Abort ( comm_global, 1, ierror )

      end subroutine psmile_abort