Abort Subroutine

SUBROUTINE Abort(SourceFile,SourceLine,CompDate,CompTime,ErrorMessage,IntInfo,RealInfo,ErrorCode,TypeInfo)
! MODULES
IMPLICIT NONE
!----------------------------------------------------------------------------------------------------------------------------------
! INPUT/OUTPUT VARIABLES
CHARACTER(LEN=*)                  :: SourceFile      !! Source file where error has occurred
INTEGER                           :: SourceLine      !! Line in source file
CHARACTER(LEN=*)                  :: CompDate        !! Compilation date
CHARACTER(LEN=*)                  :: CompTime        !! Compilation time
CHARACTER(LEN=*)                  :: ErrorMessage    !! Error message
INTEGER,OPTIONAL                  :: IntInfo         !! additional integer value for error message
REAL(wp),OPTIONAL                 :: RealInfo        !! additional real value for error message
INTEGER,OPTIONAL                  :: ErrorCode       !! used for MPI
CHARACTER(LEN=*),OPTIONAL         :: TypeInfo        !! Error type, default is "RuntimeError". Or e.g.
                                                     !! "MissingParameterError","InvalidParameterError","FileNotFoundError","InitializationError"
!----------------------------------------------------------------------------------------------------------------------------------
! LOCAL VARIABLES
CHARACTER(LEN=50)                 :: IntString,RealString,errtype
#if MPI
INTEGER                           :: errOut          ! Output of MPI_ABORT
INTEGER                           :: signalout       ! Output errorcode
#endif
CHARACTER(LEN=MAXLEN)             :: errmsg
INTEGER                           :: i
!==================================================================================================================================
IntString = ""
RealString = ""
errtype="RuntimeError"
errmsg=""
IF(MPIroot)THEN
  errmsg=TRIM(active_region(1))
  DO i=2,iregion
    errmsg=TRIM(errmsg)//"."//TRIM(active_region(i))
  END DO
  CALL reset_subregion()
END IF
IF(PRESENT(TypeInfo)) errtype = TRIM(TypeInfo)
errmsg=TRIM(errmsg) // " | "//TRIM(errtype)

IF (PRESENT(IntInfo))  THEN
  WRITE(IntString,"(I8)")  IntInfo
  IntString=",IntInfo="//TRIM(IntString)
END IF
IF (PRESENT(RealInfo)) THEN
   WRITE(RealString,"(F24.19)") RealInfo
   RealString=",RealInfo="//TRIM(RealString)
END IF
errmsg=TRIM(errmsg)//" | "//TRIM(ErrorMessage)//TRIM(IntString)//TRIM(RealString)

WRITE(UNIT_stdOut,*) '_____________________________________________________________________________\n', &
                     'Program abort caused on Proc ',myRank, '\n', &
                     '  in File : ',TRIM(SourceFile),' Line ',SourceLine, '\n', &
                     '  This file was compiled at ',TRIM(CompDate),'  ',TRIM(CompTime), '\n', &
                     'Message: ',TRIM(errmsg)

CALL FLUSH(UNIT_stdOut)

#if MPI
signalout=2 ! MPI_ABORT requires an output error-code /=0
IF(PRESENT(ErrorCode)) signalout=ErrorCode
CALL MPI_ABORT(MPI_COMM_WORLD,signalout,errOut)
#endif

#if GNU
IF(print_backtrace) CALL BACKTRACE
#endif

IF (ASSOCIATED(RaiseExceptionPtr)) THEN
  CALL RaiseExceptionPtr(errmsg)
END IF
ERROR STOP 2
END SUBROUTINE Abort