gentrbk.F90

Go to the documentation of this file.

!-- Generic traceback calls here

SUBROUTINE gentrbk_dummy
END SUBROUTINE gentrbk_dummy

#ifdef __INTEL_COMPILER
SUBROUTINE intel_trbk()
USE ifcore
#ifdef SFX_MPI
USE mpl_module, ONLY : mpl_myrank
#endif
CHARACTER*80 MESSAGE
LOGICAL :: DONE_TRACEBACK = .false.
INTEGER :: MYPROC,MYTHREAD

#ifdef _OPENMP
INTEGER,EXTERNAL :: OMP_GET_THREAD_NUM
#endif

IF(done_traceback) THEN
  WRITE(0,*) "INTEL_TRBK already called"
  RETURN
ENDIF
#ifdef SFX_MPI
myproc=mpl_myrank()
#else
myproc=0
#endif
#ifdef _OPENMP
mythread=omp_get_thread_num() + 1
#else
mythread=1
#endif

#ifndef BOM
  WRITE(message,'(A,I4,A,I2,A)') &
  &           "Process ",myproc," thread ",mythread, &
  &           " calling tracebackqq from intel_trbk()"
#ifndef __INTEL_COMPILER
  CALL tracebackqq(message, user_exit_code=-1)
#endif
#endif
#ifdef LINUX
  WRITE(0,*) "Process ",myproc," thread ",mythread, &
 &           " calling linux_trbk from intel_trbk()"
  CALL linux_trbk() ! See ifsaux/utilities/linuxtrbk.c
#endif
done_traceback=.true.
END SUBROUTINE intel_trbk
#endif

#ifndef VPP
SUBROUTINE errtra
END SUBROUTINE errtra
#endif

#ifdef NECSX
SUBROUTINE necsx_trbk(CDMESS)
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: CDMESS
CALL mesput(cdmess, len(cdmess), 1)
CALL dbx_trbk()
END SUBROUTINE necsx_trbk

SUBROUTINE necsx_trbk_fl(CDMESS, CDFILENAME, KLINENO)
USE parkind1  ,ONLY : jpim
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: CDMESS
CHARACTER(LEN=*), INTENT(IN) :: CDFILENAME
INTEGER(KIND=JPIM), INTENT(IN) :: KLINENO
CHARACTER(LEN=LEN(CDMESS)+LEN(CDFILENAME)+30) CLOCAL
WRITE(clocal,'(a," at ",a,":",i6.6)') trim(cdmess),trim(cdfilename),klineno
CALL necsx_trbk(trim(clocal))
END SUBROUTINE necsx_trbk_fl
#endif