mpl_message_mod.F90

Go to the documentation of this file.

MODULE mpl_message_mod

!**** MPL_MESSAGE - Prints message

!     Purpose.
!     --------
!     Creates an ASCII message for printing and optionally aborts

!**   Interface.
!     ----------
!        CALL MPL_MESSAGE

!        Input required arguments :
!        -------------------------
!           CDMESSAGE-  character string for message

!        Input optional arguments :
!        -------------------------
!           KERROR   -  Error number
!           CDSTRING -  Optional additional message 
!                       prepended to CDMESSAGE
!           LDABORT  -  forces ABORT if true

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

!        Output optional arguments :
!        -------------------------
!           none
!     Author.
!     -------
!        D.Dent, M.Hamrud     ECMWF

!     Modifications.
!     --------------
!        Original: 2000-09-01

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

USE mpl_mpif
USE mpl_data_module
USE mpl_abort_mod

USE parkind1  ,ONLY : jpim     ,jprb

PRIVATE

PUBLIC mpl_message

CONTAINS 

SUBROUTINE mpl_message(KERROR,CDMESSAGE,CDSTRING,LDABORT)


#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_error_string => mpi_error_string8
#endif


IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL     :: KERROR
CHARACTER*(*),INTENT(IN)          :: CDMESSAGE
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
LOGICAL      ,INTENT(IN),OPTIONAL :: LDABORT

CHARACTER*(MPI_MAX_ERROR_STRING)  :: CLMPI_ERROR
CHARACTER*10                      :: CLERROR
INTEGER(KIND=JPIM)                         :: IRESULTLEN,IERROR

IF(PRESENT(kerror)) THEN
  WRITE(clerror,'(I10)') kerror
ELSE
  clerror=' '
ENDIF
IF(PRESENT(cdstring)) THEN
  WRITE(mpl_unit,'(4A,I8)') cdstring,cdmessage,clerror, &
                               & ' FROM PROCESSOR ',mpl_rank
ELSE
  WRITE(mpl_unit,'(3A,I8)') cdmessage,clerror, &
                               & ' FROM PROCESSOR ',mpl_rank
ENDIF

IF(PRESENT(kerror)) THEN
  CALL mpi_error_string(kerror,clmpi_error,iresultlen,ierror)
  WRITE(mpl_unit,'(2A,I8)') clmpi_error(1:iresultlen),' in process ',mpl_rank
ELSE
  clmpi_error=' '
  iresultlen=1
ENDIF

IF(PRESENT(ldabort)) THEN
  IF(ldabort) THEN
    WRITE(0,'(2A,I8)') clmpi_error(1:iresultlen),' in process ',mpl_rank
    CALL mpl_abort('ABORT')
  ENDIF
ENDIF
RETURN
END SUBROUTINE mpl_message

END MODULE mpl_message_mod