cmiss_mpi.f90

Go to the documentation of this file.

MODULE cmiss_mpi
  
  USE base_routines
  USE constants
  USE kinds
#ifndef NOMPIMOD
  USE mpi
#endif
  USE iso_varying_string
  USE strings

#include "macros.h"

  IMPLICIT NONE

  PRIVATE

#ifdef NOMPIMOD
#include "mpif.h"
#endif

  !Module parameters

  !Module types

  !Module variables

  !Interfaces

  PUBLIC mpi_error_check
 
CONTAINS

  !
  !================================================================================================================================
  !

  SUBROUTINE mpi_error_check(ROUTINE,MPI_ERR_CODE,ERR,ERROR,*)
  
    !Argument Variables
    CHARACTER(LEN=*) :: ROUTINE
    INTEGER(INTG), INTENT(IN) :: MPI_ERR_CODE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    INTEGER(INTG) :: MPI_IERROR, MPI_ERR_STR_LENGTH
    CHARACTER(LEN=MAXSTRLEN) :: MPI_ERR_STR
    TYPE(varying_string) :: LOCAL_ERROR

    enters("MPI_ERROR_CHECK",err,error,*999)

    IF(mpi_err_code/=mpi_success) THEN
      CALL mpi_error_string(mpi_err_code,mpi_err_str,mpi_err_str_length,mpi_ierror)
      local_error="MPI error "//trim(number_to_vstring(mpi_err_code,"*",err,error))//" ("// &
        & mpi_err_str(1:mpi_err_str_length)//") in "//routine(1:len_trim(routine))
      CALL flagerror(local_error,err,error,*999)
    ENDIF

    exits("MPI_ERROR_CHECK")
    RETURN
999 errorsexits("MPI_ERROR_CHECK",err,error)
    RETURN 1
  END SUBROUTINE mpi_error_check

  !
  !================================================================================================================================
  !
    
END MODULE cmiss_mpi