SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/module/sdl

Go to the documentation of this file.
00001 MODULE SDL_MOD
00002 
00003 !    Interface between user applications and system-dependent intrinsic
00004 !    routines, provided by the computer vendors.
00005 
00006 !    All routines which wish to call these routines must contain:
00007 !    USE SDL_MOD
00008 
00009 ! Author :
00010 ! ------
00011 !   11-Apr-2005 R. El Khatib  *METEO-FRANCE*
00012 !   26-Apr-2006 S.T.Saarinen  Dr.Hook trace, calls to EC_RAISE, Intel/ifort traceback
00013 
00014 USE PARKIND1  ,ONLY : JPIM  ,JPRB
00015 USE YOMHOOK   ,ONLY : LHOOK ,DR_HOOK
00016 !USE OML_MOD, ONLY : OML_MY_THREAD
00017 
00018 IMPLICIT NONE
00019 
00020 SAVE
00021 
00022 PRIVATE
00023 
00024 INTEGER, parameter :: SIGABRT = 6 ! Hardcoded
00025 
00026 PUBLIC :: SDL_SRLABORT, SDL_DISABORT, SDL_TRACEBACK
00027 
00028 CONTAINS
00029 
00030 !-----------------------------------------------------------------------------
00031 SUBROUTINE SDL_TRACEBACK(KTID)
00032 
00033 ! Purpose :
00034 ! -------
00035 !   Traceback
00036 
00037 !   KTID : thread 
00038 
00039 INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: KTID
00040 INTEGER(KIND=JPIM) ITID, IPRINT_OPTION, ILEVEL
00041 #ifdef NECSX
00042 CHARACTER(LEN=*), PARAMETER :: CLNECMSG = '*** Calling NEC traceback ***'
00043 #endif
00044 
00045 IF (PRESENT(KTID)) THEN
00046   ITID = KTID
00047 ELSE
00048   !ITID = OML_MY_THREAD()
00049   ITID = 1
00050 ENDIF
00051 
00052 IF (LHOOK) THEN
00053   IPRINT_OPTION = 2
00054   ILEVEL = 0
00055   CALL C_DRHOOK_PRINT(0, ITID, IPRINT_OPTION, ILEVEL) ! from drhook.c
00056 ENDIF
00057 
00058 #ifdef VPP
00059   CALL ERRTRA
00060   IF (PRESENT(KTID)) CALL SLEEP(28)
00061 #elif RS6K
00062   WRITE(0,*)'SDL_TRACEBACK: Calling XL_TRBK, THRD = ',ITID
00063   CALL XL__TRBK()
00064   WRITE(0,*)'SDL_TRACEBACK: Done XL_TRBK, THRD = ',ITID
00065 #elif __INTEL_COMPILER
00066   WRITE(0,*)'SDL_TRACEBACK: Calling INTEL_TRBK, THRD = ',ITID
00067   CALL INTEL_TRBK() ! See ifsaux/utilities/gentrbk.F90
00068   WRITE(0,*)'SDL_TRACEBACK: Done INTEL_TRBK, THRD = ',ITID
00069 #elif defined(LINUX) || defined(SUN4)
00070   WRITE(0,*)'SDL_TRACEBACK: Calling LINUX_TRBK, THRD = ',ITID
00071   CALL LINUX_TRBK() ! See ifsaux/utilities/linuxtrbk.c
00072   WRITE(0,*)'SDL_TRACEBACK: Done LINUX_TRBK, THRD = ',ITID
00073 #elif defined(NECSX)
00074 ! MESPUT writes out onto unit 6
00075   WRITE(6,*)'SDL_TRACEBACK: Calling NEC/MESPUT, THRD = ',ITID
00076   CALL NECSX_TRBK(CLNECMSG)
00077   CALL FLUSH(6)
00078   WRITE(6,*)'SDL_TRACEBACK: Done NEC/MESPUT, THRD = ',ITID
00079 #else
00080   WRITE(0,*)'SDL_TRACEBACK: No proper traceback implemented.'
00081   ! A traceback using dbx-debugger, if available AND 
00082   ! activated via 'export DBXDEBUGGER=1'
00083   WRITE(0,*)'SDL_TRACEBACK: Calling DBX_TRBK, THRD = ',ITID
00084   CALL DBX_TRBK() ! See ifsaux/utilities/linuxtrbk.c
00085   WRITE(0,*)'SDL_TRACEBACK: Done DBX_TRBK, THRD = ',ITID
00086   ! A traceback using gdb-debugger, if available AND 
00087   ! activated via 'export GDBDEBUGGER=1'
00088   WRITE(0,*)'SDL_TRACEBACK: Calling GDB_TRBK, THRD = ',ITID
00089   CALL GDB_TRBK() ! See ifsaux/utilities/linuxtrbk.c
00090   WRITE(0,*)'SDL_TRACEBACK: Done GDB_TRBK, THRD = ',ITID
00091 #endif
00092 
00093 END SUBROUTINE SDL_TRACEBACK
00094 !-----------------------------------------------------------------------------
00095 SUBROUTINE SDL_SRLABORT
00096 
00097 ! Purpose :
00098 ! -------
00099 !   To abort in serial environment
00100 
00101 CALL EC_RAISE(SIGABRT)
00102 STOP 'SDL_SRLABORT'
00103 
00104 END SUBROUTINE SDL_SRLABORT
00105 !-----------------------------------------------------------------------------
00106 SUBROUTINE SDL_DISABORT(KCOMM)
00107 
00108 ! Purpose :
00109 ! -------
00110 !   To abort in distributed environment
00111 
00112 !   KCOMM : communicator
00113 
00114 INTEGER(KIND=JPIM), INTENT(IN) :: KCOMM
00115 
00116 INTEGER(KIND=JPIM) :: IRETURN_CODE,IERROR
00117 
00118 #ifdef VPP
00119 
00120 CALL VPP_ABORT()
00121 
00122 #else
00123 
00124 IRETURN_CODE=1
00125 CALL MPI_ABORT(KCOMM,IRETURN_CODE,IERROR)
00126 
00127 #endif
00128 
00129 CALL EC_RAISE(SIGABRT) ! In case ever ends up here
00130 STOP 'SDL_DISABORT'
00131 
00132 END SUBROUTINE SDL_DISABORT
00133 !-----------------------------------------------------------------------------
00134 
00135 END MODULE SDL_MOD