sdl_module.F90

Go to the documentation of this file.

MODULE sdl_module

!    Interface between user applications and system-dependent intrinsic
!    routines, provided by the computer vendors.

!    All routines which wish to call these routines must contain:
!    USE SDL_MODULE

! Author :
! ------
!   11-Apr-2005 R. El Khatib  *METEO-FRANCE*
!   26-Apr-2006 S.T.Saarinen  Dr.Hook trace, calls to EC_RAISE, Intel/ifort traceback

USE parkind1  ,ONLY : jpim  ,jprb
USE yomhook   ,ONLY : lhook ,dr_hook
USE yomoml, ONLY : oml_my_thread

IMPLICIT NONE

SAVE

PRIVATE

INTEGER, parameter :: sigabrt = 6 ! Hardcoded

PUBLIC :: sdl_srlabort, sdl_disabort, sdl_traceback

CONTAINS

!-----------------------------------------------------------------------------
SUBROUTINE sdl_traceback(KTID)

! Purpose :
! -------
!   Traceback

!   KTID : thread 

INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: KTID
CALL abor1('DANS SDL_TRACEBACK')   ! MPL 8.12.08 et commente toute la suite
!INTEGER(KIND=JPIM) ITID, IPRINT_OPTION, ILEVEL
!#ifdef NECSX
!CHARACTER(LEN=*), PARAMETER :: CLNECMSG = '*** Calling NEC traceback ***'
!#endif
!
!IF (PRESENT(KTID)) THEN
!  ITID = KTID
!ELSE
!  ITID = OML_MY_THREAD()
!ENDIF
!
!IF (LHOOK) THEN
!  IPRINT_OPTION = 2
!  ILEVEL = 0
!  CALL C_DRHOOK_PRINT(0, ITID, IPRINT_OPTION, ILEVEL) ! from drhook.c
!ENDIF
!
!#ifdef VPP
!  CALL ERRTRA
!  IF (PRESENT(KTID)) CALL SLEEP(28)
!#elif RS6K
!  WRITE(0,*)'SDL_TRACEBACK: Calling XL_TRBK, THRD = ',ITID
!  CALL XL__TRBK()
!  WRITE(0,*)'SDL_TRACEBACK: Done XL_TRBK, THRD = ',ITID
!#elif __INTEL_COMPILER
!  WRITE(0,*)'SDL_TRACEBACK: Calling INTEL_TRBK, THRD = ',ITID
!  CALL INTEL_TRBK() ! See ifsaux/utilities/gentrbk.F90
!  WRITE(0,*)'SDL_TRACEBACK: Done INTEL_TRBK, THRD = ',ITID
!#elif defined(LINUX) || defined(SUN4)
!  WRITE(0,*)'SDL_TRACEBACK: Calling LINUX_TRBK, THRD = ',ITID
!  CALL LINUX_TRBK() ! See ifsaux/utilities/linuxtrbk.c
!  WRITE(0,*)'SDL_TRACEBACK: Done LINUX_TRBK, THRD = ',ITID
!#elif defined(NECSX)
!  WRITE(0,*)'SDL_TRACEBACK: Calling NEC/MESPUT, THRD = ',ITID
!  CALL MESPUT(CLNECMSG, LEN(CLNECMSG), 1)
!  WRITE(0,*)'SDL_TRACEBACK: Done NEC/MESPUT, THRD = ',ITID
!#else
!  WRITE(0,*)'SDL_TRACEBACK: No proper traceback implemented.'
!  ! A traceback using dbx-debugger, if available AND 
!  ! activated via 'export DBXDEBUGGER=1'
!  WRITE(0,*)'SDL_TRACEBACK: Calling DBX_TRBK, THRD = ',ITID
!  CALL DBX_TRBK() ! See ifsaux/utilities/linuxtrbk.c
!  WRITE(0,*)'SDL_TRACEBACK: Done DBX_TRBK, THRD = ',ITID
!  ! A traceback using gdb-debugger, if available AND 
!  ! activated via 'export GDBDEBUGGER=1'
!  WRITE(0,*)'SDL_TRACEBACK: Calling GDB_TRBK, THRD = ',ITID
!  CALL GDB_TRBK() ! See ifsaux/utilities/linuxtrbk.c
!  WRITE(0,*)'SDL_TRACEBACK: Done GDB_TRBK, THRD = ',ITID
!#endif

END SUBROUTINE sdl_traceback
!-----------------------------------------------------------------------------
SUBROUTINE sdl_srlabort

! Purpose :
! -------
!   To abort in serial environment

!CALL EC_RAISE(SIGABRT)  ! EC_RAISE remplace par ABOR1 MPL 8.12.08
CALL abor1('DANS SRLABORT')
stop 'SDL_SRLABORT'

END SUBROUTINE sdl_srlabort
!-----------------------------------------------------------------------------
SUBROUTINE sdl_disabort(KCOMM)

! Purpose :
! -------
!   To abort in distributed environment

!   KCOMM : communicator

INTEGER(KIND=JPIM), INTENT(IN) :: KCOMM

INTEGER(KIND=JPIM) :: IRETURN_CODE,IERROR

!MPL 4.12.08
!#ifdef VPP
!
!CALL VPP_ABORT()
!
!#else
!
!IRETURN_CODE=1
!CALL MPI_ABORT(KCOMM,IRETURN_CODE,IERROR)

!#endif

!CALL EC_RAISE(SIGABRT) ! In case ever ends up here
CALL abor1('DANS SRLDISABORT')   ! EC_RAISE remplace par ABOR1 MPL 8.12.08
stop 'SDL_DISABORT'

END SUBROUTINE sdl_disabort
!-----------------------------------------------------------------------------

END MODULE sdl_module