source: LMDZ6/trunk/libf/phylmd/rrtm/sdl_module.F90 @ 3312

Last change on this file since 3312 was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.7 KB
Line 
1MODULE SDL_MODULE
2
3!    Interface between user applications and system-dependent intrinsic
4!    routines, provided by the computer vendors.
5
6!    All routines which wish to call these routines must contain:
7!    USE SDL_MODULE
8
9! Author :
10! ------
11!   11-Apr-2005 R. El Khatib  *METEO-FRANCE*
12!   26-Apr-2006 S.T.Saarinen  Dr.Hook trace, calls to EC_RAISE, Intel/ifort traceback
13
14USE PARKIND1  ,ONLY : JPIM  ,JPRB
15USE YOMHOOK   ,ONLY : LHOOK ,DR_HOOK
16USE YOMOML, ONLY : OML_MY_THREAD
17
18IMPLICIT NONE
19
20SAVE
21
22PRIVATE
23
24INTEGER, parameter :: SIGABRT = 6 ! Hardcoded
25
26PUBLIC :: SDL_SRLABORT, SDL_DISABORT, SDL_TRACEBACK
27
28CONTAINS
29
30!-----------------------------------------------------------------------------
31SUBROUTINE SDL_TRACEBACK(KTID)
32
33! Purpose :
34! -------
35!   Traceback
36
37!   KTID : thread
38
39INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: KTID
40CALL ABOR1('DANS SDL_TRACEBACK')   ! MPL 8.12.08 et commente toute la suite
41!INTEGER(KIND=JPIM) ITID, IPRINT_OPTION, ILEVEL
42!#ifdef NECSX
43!CHARACTER(LEN=*), PARAMETER :: CLNECMSG = '*** Calling NEC traceback ***'
44!#endif
45!
46!IF (PRESENT(KTID)) THEN
47!  ITID = KTID
48!ELSE
49!  ITID = OML_MY_THREAD()
50!ENDIF
51!
52!IF (LHOOK) THEN
53!  IPRINT_OPTION = 2
54!  ILEVEL = 0
55!  CALL C_DRHOOK_PRINT(0, ITID, IPRINT_OPTION, ILEVEL) ! from drhook.c
56!ENDIF
57!
58!#ifdef VPP
59!  CALL ERRTRA
60!  IF (PRESENT(KTID)) CALL SLEEP(28)
61!#elif RS6K
62!  WRITE(0,*)'SDL_TRACEBACK: Calling XL_TRBK, THRD = ',ITID
63!  CALL XL__TRBK()
64!  WRITE(0,*)'SDL_TRACEBACK: Done XL_TRBK, THRD = ',ITID
65!#elif __INTEL_COMPILER
66!  WRITE(0,*)'SDL_TRACEBACK: Calling INTEL_TRBK, THRD = ',ITID
67!  CALL INTEL_TRBK() ! See ifsaux/utilities/gentrbk.F90
68!  WRITE(0,*)'SDL_TRACEBACK: Done INTEL_TRBK, THRD = ',ITID
69!#elif defined(LINUX) || defined(SUN4)
70!  WRITE(0,*)'SDL_TRACEBACK: Calling LINUX_TRBK, THRD = ',ITID
71!  CALL LINUX_TRBK() ! See ifsaux/utilities/linuxtrbk.c
72!  WRITE(0,*)'SDL_TRACEBACK: Done LINUX_TRBK, THRD = ',ITID
73!#elif defined(NECSX)
74!  WRITE(0,*)'SDL_TRACEBACK: Calling NEC/MESPUT, THRD = ',ITID
75!  CALL MESPUT(CLNECMSG, LEN(CLNECMSG), 1)
76!  WRITE(0,*)'SDL_TRACEBACK: Done NEC/MESPUT, THRD = ',ITID
77!#else
78!  WRITE(0,*)'SDL_TRACEBACK: No proper traceback implemented.'
79!  ! A traceback using dbx-debugger, if available AND
80!  ! activated via 'export DBXDEBUGGER=1'
81!  WRITE(0,*)'SDL_TRACEBACK: Calling DBX_TRBK, THRD = ',ITID
82!  CALL DBX_TRBK() ! See ifsaux/utilities/linuxtrbk.c
83!  WRITE(0,*)'SDL_TRACEBACK: Done DBX_TRBK, THRD = ',ITID
84!  ! A traceback using gdb-debugger, if available AND
85!  ! activated via 'export GDBDEBUGGER=1'
86!  WRITE(0,*)'SDL_TRACEBACK: Calling GDB_TRBK, THRD = ',ITID
87!  CALL GDB_TRBK() ! See ifsaux/utilities/linuxtrbk.c
88!  WRITE(0,*)'SDL_TRACEBACK: Done GDB_TRBK, THRD = ',ITID
89!#endif
90
91END SUBROUTINE SDL_TRACEBACK
92!-----------------------------------------------------------------------------
93SUBROUTINE SDL_SRLABORT
94
95! Purpose :
96! -------
97!   To abort in serial environment
98
99!CALL EC_RAISE(SIGABRT)  ! EC_RAISE remplace par ABOR1 MPL 8.12.08
100CALL ABOR1('DANS SRLABORT')
101STOP 'SDL_SRLABORT'
102
103END SUBROUTINE SDL_SRLABORT
104!-----------------------------------------------------------------------------
105SUBROUTINE SDL_DISABORT(KCOMM)
106
107! Purpose :
108! -------
109!   To abort in distributed environment
110
111!   KCOMM : communicator
112
113INTEGER(KIND=JPIM), INTENT(IN) :: KCOMM
114
115INTEGER(KIND=JPIM) :: IRETURN_CODE,IERROR
116
117!MPL 4.12.08
118!#ifdef VPP
119!
120!CALL VPP_ABORT()
121!
122!#else
123!
124!IRETURN_CODE=1
125!CALL MPI_ABORT(KCOMM,IRETURN_CODE,IERROR)
126
127!#endif
128
129!CALL EC_RAISE(SIGABRT) ! In case ever ends up here
130CALL ABOR1('DANS SRLDISABORT')   ! EC_RAISE remplace par ABOR1 MPL 8.12.08
131STOP 'SDL_DISABORT'
132
133END SUBROUTINE SDL_DISABORT
134!-----------------------------------------------------------------------------
135
136END MODULE SDL_MODULE
Note: See TracBrowser for help on using the repository browser.