(git:0de0cc2)
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 ! **************************************************************************************************
12 MODULE 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
23  !API
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 
64 CONTAINS
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)
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)
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)
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 
234 END MODULE base_hooks
Central dispatch for basic hooks.
Definition: base_hooks.F:12
subroutine, public cp__a(filename, lineNr)
CPASSERT handler.
Definition: base_hooks.F:160
procedure(cp_warn_interface), pointer, public cp_warn_hook
Definition: base_hooks.F:59
subroutine, public cp_abort(location, message)
Terminate the program.
Definition: base_hooks.F:73
subroutine, public timeset(routineN, handle)
Start timer.
Definition: base_hooks.F:127
subroutine, public cp__w(filename, lineNr, message)
CPWARN handler.
Definition: base_hooks.F:193
subroutine, public cp__b(filename, lineNr, message)
CPABORT handler.
Definition: base_hooks.F:176
subroutine, public cp_hint(location, message)
Issue a hint.
Definition: base_hooks.F:110
procedure(cp_abort_interface), pointer, public cp_abort_hook
Definition: base_hooks.F:58
subroutine, public cp__h(filename, lineNr, message)
CPHINT handler.
Definition: base_hooks.F:208
procedure(cp_hint_interface), pointer, public cp_hint_hook
Definition: base_hooks.F:60
procedure(timeset_interface), pointer, public timeset_hook
Definition: base_hooks.F:61
character(len=default_string_length) function, public cp__l(filename, lineNr)
Helper routine to assemble LOCATION
Definition: base_hooks.F:223
subroutine, public timestop(handle)
Stop timer.
Definition: base_hooks.F:143
subroutine, public cp_warn(location, message)
Issue a warning.
Definition: base_hooks.F:93
procedure(timestop_interface), pointer, public timestop_hook
Definition: base_hooks.F:62
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public default_string_length
Definition: kinds.F:57
Machine interface based on Fortran 2003 and POSIX.
Definition: machine.F:17
integer, parameter, public default_output_unit
Definition: machine.F:45
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition: machine.F:106
subroutine, public m_abort()
Can be used to get a nice core.
Definition: machine.F:284