mpl_end_mod.F90

Go to the documentation of this file.

MODULE mpl_end_mod

!**** MPL_END - Terminates the message passing environment

!     Purpose.
!     --------
!     Cleans up all of the MPI state. 
!     Subsequently, no MPI routine can be called

!**   Interface.
!     ----------
!        CALL MPL_END

!        Input required arguments :
!        -------------------------
!           none

!        Input optional arguments :
!        -------------------------
!           none

!        Output required arguments :
!        -------------------------
!           none

!        Output optional arguments :
!        -------------------------
!           KERROR   -  return error code.     If not supplied, 
!                       MPL_END aborts when an error is detected.
!     Author.
!     -------
!        D.Dent, M.Hamrud     ECMWF

!     Modifications.
!     --------------
!        Original: 2000-09-01
!        P. Towers     3-Jul-2014 Add call to ec_cray_meminfo

!     ------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb

USE mpl_data_module
USE mpl_message_mod

IMPLICIT NONE

PUBLIC mpl_end
PRIVATE

INTEGER :: ierror

CONTAINS 

SUBROUTINE mpl_end(KERROR)


#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_buffer_detach => mpi_buffer_detach8, mpi_finalize => mpi_finalize8
#endif


INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
INTEGER(KIND=JPIM)                      :: IERROR
LOGICAL                      :: LLABORT=.true.

IF(mpl_numproc < 1) THEN
  IF(mpl_numproc == -1) THEN
    IF (.NOT.linitmpi_via_mpl) THEN
      ! Neither MPL_INIT_MOD nor MPL_ARG_MOD -modules were called before this
      CALL mpl_message(cdmessage=' MPL_END CALLED BEFORE MPL_INIT ')
    ENDIF
!!-- we do not want the following message to appear, since its non-fatal
!!  ELSEIF(MPL_NUMPROC == -2) THEN
!!    CALL MPL_MESSAGE(CDMESSAGE=' MPL_END CALLED MULTIPLE TIMES ')
  ENDIF
  IF(PRESENT(kerror)) THEN
    ierror=0
    kerror=ierror
  ENDIF
  RETURN
ENDIF

#ifdef _CRAYFTN
  CALL ec_cray_meminfo(-1,"mpl_end",mpl_comm)
#endif

IF (ALLOCATED(mpl_attached_buffer)) THEN
  CALL mpi_buffer_detach(mpl_attached_buffer,mpl_mbx_size,ierror)
  IF(PRESENT(kerror)) THEN
    kerror=ierror
  ELSE
    IF( ierror /= 0 )THEN
      CALL mpl_message(ierror,'MPL_END ',ldabort=llabort)
    ENDIF
  ENDIF
  DEALLOCATE(mpl_attached_buffer)
ENDIF

IF (linitmpi_via_mpl) THEN
  CALL mpi_finalize(ierror)
ELSE
  ierror = 0
ENDIF

mpl_numproc = -2
linitmpi_via_mpl = .false.

IF(PRESENT(kerror)) THEN
  kerror=ierror
ENDIF

RETURN
END SUBROUTINE mpl_end

END MODULE mpl_end_mod