abor1.F90

Go to the documentation of this file.

SUBROUTINE abor1(CDTEXT)

USE parkind1  ,ONLY : jpim     ,jprb
USE yomlun_ifsaux, ONLY : nulout,nulerr
#ifdef SFX_MPI
USE mpl_module, ONLY : mpl_abort, mpl_rank, mpl_numproc
#endif
USE sdl_mod, ONLY : sdl_traceback, sdl_srlabort
#ifdef NAG
USE f90_unix_io, ONLY: flush
#endif

IMPLICIT NONE

CHARACTER(LEN=*), INTENT(IN) :: CDTEXT
INTEGER(KIND=JPIM) :: ILEN

ilen=len(cdtext)
IF (nulout >= 0) WRITE(nulout,'(1X,A)') 'ABOR1 CALLED'

IF(ilen <= 512) THEN
  IF (nulout >= 0) WRITE(nulout,'(1X,A)') cdtext
#ifdef SFX_MPI
  IF (nulerr >= 0) WRITE(nulerr,'(1X,A,1X,I3,1X,A)') 'ABORT! ',mpl_rank,cdtext
#else
  IF (nulerr >= 0) WRITE(nulerr,'(1X,A,1X,A)') 'ABORT! ',cdtext
#endif
ELSE
#ifdef SFX_MPI
  IF (nulerr >= 0) WRITE(nulerr,'(1X,A,1X,I3,1X,A)') 'ABORT! ',mpl_rank,&
   & 'ABOR1 CALLED WITHOUT TEXT STRING'  
#else
  IF (nulerr >= 0) WRITE(nulerr,'(1X,A,1X,A)') 'ABORT! ',&
   & 'ABOR1 CALLED WITHOUT TEXT STRING'
#endif
ENDIF

IF (nulout >= 0) THEN
  CALL flush(nulout)
  IF (nulout /= 0 .AND. nulout /= 6) CLOSE(nulout)
ENDIF

#ifdef SFX_MPI
IF (mpl_numproc > 1) THEN
  IF(ilen <= 512) THEN
    CALL mpl_abort(cdtext)
  ELSE
    CALL mpl_abort
  ENDIF
ELSE
#endif
  CALL sdl_traceback
  CALL flush(0)
  CALL sdl_srlabort
#ifdef SFX_MPI
ENDIF
#endif

END SUBROUTINE abor1

SUBROUTINE abor1fl(CDFILE, KLINENUM, CDTEXT)
USE parkind1  ,ONLY : jpim
USE yomlun_ifsaux, ONLY : nulout,nulerr
#ifdef NAG
USE f90_unix_io, ONLY: flush
#endif
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: CDFILE,CDTEXT
INTEGER(KIND=JPIM), INTENT(IN) :: KLINENUM
IF (len(cdfile) > 0 .AND. klinenum > 0 .AND. nulerr >= 0) THEN
 1000 FORMAT(1x,a,a,":",i6.6)
  WRITE(nulerr,1000) 'ABOR1FL HAS BEEN CALLED AT ',cdfile,klinenum
  CALL flush(nulerr)
ENDIF
CALL abor1(cdtext)
END SUBROUTINE abor1fl