(git:374b731)
Loading...
Searching...
No Matches
base_hooks.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Central dispatch for basic hooks
10!> \author Ole Schuett
11! **************************************************************************************************
12MODULE base_hooks
13 USE kinds, ONLY: default_string_length
14 USE machine, ONLY: default_output_unit,&
15 m_abort,&
16 m_flush
17
18 IMPLICIT NONE
19 PRIVATE
20
21 !API
22 PUBLIC :: cp_abort, cp_warn, cp_hint, timeset, timestop
23 !API
24 PUBLIC :: cp_abort_hook, cp_warn_hook, cp_hint_hook, timeset_hook, timestop_hook
25 !API
26 PUBLIC :: cp__a, cp__b, cp__w, cp__h, cp__l
27
28 ! this interface (with subroutines in it) must to be defined right before
29 ! the regular subroutines/functions - otherwise prettify.py will screw up.
30 INTERFACE
31 SUBROUTINE cp_abort_interface(location, message)
32 CHARACTER(len=*), INTENT(in) :: location, message
33
34 END SUBROUTINE cp_abort_interface
35
36 SUBROUTINE cp_warn_interface(location, message)
37 CHARACTER(len=*), INTENT(in) :: location, message
38
39 END SUBROUTINE cp_warn_interface
40
41 SUBROUTINE cp_hint_interface(location, message)
42 CHARACTER(len=*), INTENT(in) :: location, message
43
44 END SUBROUTINE cp_hint_interface
45
46 SUBROUTINE timeset_interface(routineN, handle)
47 CHARACTER(LEN=*), INTENT(IN) :: routineN
48 INTEGER, INTENT(OUT) :: handle
49
50 END SUBROUTINE timeset_interface
51
52 SUBROUTINE timestop_interface(handle)
53 INTEGER, INTENT(IN) :: handle
54
55 END SUBROUTINE timestop_interface
56 END INTERFACE
57
58 PROCEDURE(cp_abort_interface), POINTER :: cp_abort_hook => null()
59 PROCEDURE(cp_warn_interface), POINTER :: cp_warn_hook => null()
60 PROCEDURE(cp_hint_interface), POINTER :: cp_hint_hook => null()
61 PROCEDURE(timeset_interface), POINTER :: timeset_hook => null()
62 PROCEDURE(timestop_interface), POINTER :: timestop_hook => null()
63
64CONTAINS
65
66! **************************************************************************************************
67!> \brief Terminate the program
68!> \param location ...
69!> \param message ...
70!> \author Ole Schuett
71! **************************************************************************************************
72 SUBROUTINE cp_abort(location, message)
73 CHARACTER(len=*), INTENT(in) :: location, message
74
75 IF (ASSOCIATED(cp_abort_hook)) THEN
76 CALL cp_abort_hook(location, message)
77 ELSE
78 WRITE (default_output_unit, *) "ABORT in "//trim(location)//" "//trim(message)
79 CALL m_flush(default_output_unit)
80 CALL m_abort()
81 END IF
82 ! compiler hint
83 stop "Never return from here"
84 END SUBROUTINE cp_abort
85
86! **************************************************************************************************
87!> \brief Issue a warning
88!> \param location ...
89!> \param message ...
90!> \author Ole Schuett
91! **************************************************************************************************
92 SUBROUTINE cp_warn(location, message)
93 CHARACTER(len=*), INTENT(in) :: location, message
94
95 IF (ASSOCIATED(cp_warn_hook)) THEN
96 CALL cp_warn_hook(location, message)
97 ELSE
98 WRITE (default_output_unit, *) "WARNING in "//trim(location)//" "//trim(message)
99 CALL m_flush(default_output_unit)
100 END IF
101 END SUBROUTINE cp_warn
102
103! **************************************************************************************************
104!> \brief Issue a hint
105!> \param location ...
106!> \param message ...
107!> \author Hans Pabst
108! **************************************************************************************************
109 SUBROUTINE cp_hint(location, message)
110 CHARACTER(len=*), INTENT(in) :: location, message
111
112 IF (ASSOCIATED(cp_hint_hook)) THEN
113 CALL cp_hint_hook(location, message)
114 ELSE
115 WRITE (default_output_unit, *) "HINT in "//trim(location)//" "//trim(message)
116 CALL m_flush(default_output_unit)
117 END IF
118 END SUBROUTINE cp_hint
119
120! **************************************************************************************************
121!> \brief Start timer
122!> \param routineN ...
123!> \param handle ...
124!> \author Ole Schuett
125! **************************************************************************************************
126 SUBROUTINE timeset(routineN, handle)
127 CHARACTER(LEN=*), INTENT(IN) :: routinen
128 INTEGER, INTENT(OUT) :: handle
129
130 IF (ASSOCIATED(timeset_hook)) THEN
131 CALL timeset_hook(routinen, handle)
132 ELSE
133 handle = -1
134 END IF
135 END SUBROUTINE timeset
136
137! **************************************************************************************************
138!> \brief Stop timer
139!> \param handle ...
140!> \author Ole Schuett
141! **************************************************************************************************
142 SUBROUTINE timestop(handle)
143 INTEGER, INTENT(IN) :: handle
144
145 IF (ASSOCIATED(timestop_hook)) THEN
146 CALL timestop_hook(handle)
147 ELSE
148 IF (handle /= -1) &
149 CALL cp_abort(cp__l("base_hooks.F", __line__), "Got wrong handle")
150 END IF
151 END SUBROUTINE timestop
152
153! **************************************************************************************************
154!> \brief CPASSERT handler
155!> \param filename ...
156!> \param lineNr ...
157!> \author Ole Schuett
158! **************************************************************************************************
159 SUBROUTINE cp__a(filename, lineNr)
160 CHARACTER(len=*), INTENT(in) :: filename
161 INTEGER, INTENT(in) :: linenr
162
163 CALL cp_abort(location=cp__l(filename, linenr), message="CPASSERT failed")
164 ! compiler hint
165 stop "Never return from here"
166 END SUBROUTINE cp__a
167
168! **************************************************************************************************
169!> \brief CPABORT handler
170!> \param filename ...
171!> \param lineNr ...
172!> \param message ...
173!> \author Ole Schuett
174! **************************************************************************************************
175 SUBROUTINE cp__b(filename, lineNr, message)
176 CHARACTER(len=*), INTENT(in) :: filename
177 INTEGER, INTENT(in) :: linenr
178 CHARACTER(len=*), INTENT(in) :: message
179
180 CALL cp_abort(location=cp__l(filename, linenr), message=message)
181 ! compiler hint
182 stop "Never return from here"
183 END SUBROUTINE cp__b
184
185! **************************************************************************************************
186!> \brief CPWARN handler
187!> \param filename ...
188!> \param lineNr ...
189!> \param message ...
190!> \author Ole Schuett
191! **************************************************************************************************
192 SUBROUTINE cp__w(filename, lineNr, message)
193 CHARACTER(len=*), INTENT(in) :: filename
194 INTEGER, INTENT(in) :: linenr
195 CHARACTER(len=*), INTENT(in) :: message
196
197 CALL cp_warn(location=cp__l(filename, linenr), message=message)
198 END SUBROUTINE cp__w
199
200! **************************************************************************************************
201!> \brief CPHINT handler
202!> \param filename ...
203!> \param lineNr ...
204!> \param message ...
205!> \author Hans Pabst
206! **************************************************************************************************
207 SUBROUTINE cp__h(filename, lineNr, message)
208 CHARACTER(len=*), INTENT(in) :: filename
209 INTEGER, INTENT(in) :: linenr
210 CHARACTER(len=*), INTENT(in) :: message
211
212 CALL cp_hint(location=cp__l(filename, linenr), message=message)
213 END SUBROUTINE cp__h
214
215! **************************************************************************************************
216!> \brief Helper routine to assemble __LOCATION__
217!> \param filename ...
218!> \param lineNr ...
219!> \return ...
220!> \author Ole Schuett
221! **************************************************************************************************
222 FUNCTION cp__l(filename, lineNr) RESULT(location)
223 CHARACTER(len=*), INTENT(in) :: filename
224 INTEGER, INTENT(in) :: linenr
225 CHARACTER(len=default_string_length) :: location
226
227 CHARACTER(len=15) :: linenr_str
228
229 WRITE (linenr_str, fmt='(I10)') linenr
230 location = trim(filename)//":"//trim(adjustl(linenr_str))
231
232 END FUNCTION cp__l
233
234END MODULE base_hooks
base_hooks
Central dispatch for basic hooks.
Definition base_hooks.F:12
base_hooks::cp_warn_hook
procedure(cp_warn_interface), pointer, public cp_warn_hook
Definition base_hooks.F:59
base_hooks::cp_abort
subroutine, public cp_abort(location, message)
Terminate the program.
Definition base_hooks.F:73
base_hooks::cp__w
subroutine, public cp__w(filename, linenr, message)
CPWARN handler.
Definition base_hooks.F:193
base_hooks::timeset
subroutine, public timeset(routinen, handle)
Start timer.
Definition base_hooks.F:127
base_hooks::cp__a
subroutine, public cp__a(filename, linenr)
CPASSERT handler.
Definition base_hooks.F:160
base_hooks::cp__l
character(len=default_string_length) function, public cp__l(filename, linenr)
Helper routine to assemble LOCATION
Definition base_hooks.F:223
base_hooks::cp_hint
subroutine, public cp_hint(location, message)
Issue a hint.
Definition base_hooks.F:110
base_hooks::cp_abort_hook
procedure(cp_abort_interface), pointer, public cp_abort_hook
Definition base_hooks.F:58
base_hooks::cp_hint_hook
procedure(cp_hint_interface), pointer, public cp_hint_hook
Definition base_hooks.F:60
base_hooks::timeset_hook
procedure(timeset_interface), pointer, public timeset_hook
Definition base_hooks.F:61
base_hooks::timestop
subroutine, public timestop(handle)
Stop timer.
Definition base_hooks.F:143
base_hooks::cp__h
subroutine, public cp__h(filename, linenr, message)
CPHINT handler.
Definition base_hooks.F:208
base_hooks::cp_warn
subroutine, public cp_warn(location, message)
Issue a warning.
Definition base_hooks.F:93
base_hooks::cp__b
subroutine, public cp__b(filename, linenr, message)
CPABORT handler.
Definition base_hooks.F:176
base_hooks::timestop_hook
procedure(timestop_interface), pointer, public timestop_hook
Definition base_hooks.F:62
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
machine
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
machine::default_output_unit
integer, parameter, public default_output_unit
Definition machine.F:45
machine::m_flush
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:106
machine::m_abort
subroutine, public m_abort()
Can be used to get a nice core.
Definition machine.F:284