Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 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
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 :
64 : CONTAINS
65 :
66 : ! **************************************************************************************************
67 : !> \brief Terminate the program
68 : !> \param location ...
69 : !> \param message ...
70 : !> \author Ole Schuett
71 : ! **************************************************************************************************
72 0 : SUBROUTINE cp_abort(location, message)
73 : CHARACTER(len=*), INTENT(in) :: location, message
74 :
75 0 : IF (ASSOCIATED(cp_abort_hook)) THEN
76 0 : CALL cp_abort_hook(location, message)
77 : ELSE
78 0 : WRITE (default_output_unit, *) "ABORT in "//TRIM(location)//" "//TRIM(message)
79 0 : CALL m_flush(default_output_unit)
80 0 : CALL m_abort()
81 : END IF
82 : ! compiler hint
83 0 : 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 24364 : SUBROUTINE cp_warn(location, message)
93 : CHARACTER(len=*), INTENT(in) :: location, message
94 :
95 24364 : IF (ASSOCIATED(cp_warn_hook)) THEN
96 24364 : CALL cp_warn_hook(location, message)
97 : ELSE
98 0 : WRITE (default_output_unit, *) "WARNING in "//TRIM(location)//" "//TRIM(message)
99 0 : CALL m_flush(default_output_unit)
100 : END IF
101 24364 : END SUBROUTINE cp_warn
102 :
103 : ! **************************************************************************************************
104 : !> \brief Issue a hint
105 : !> \param location ...
106 : !> \param message ...
107 : !> \author Hans Pabst
108 : ! **************************************************************************************************
109 59 : SUBROUTINE cp_hint(location, message)
110 : CHARACTER(len=*), INTENT(in) :: location, message
111 :
112 59 : IF (ASSOCIATED(cp_hint_hook)) THEN
113 59 : CALL cp_hint_hook(location, message)
114 : ELSE
115 0 : WRITE (default_output_unit, *) "HINT in "//TRIM(location)//" "//TRIM(message)
116 0 : CALL m_flush(default_output_unit)
117 : END IF
118 59 : END SUBROUTINE cp_hint
119 :
120 : ! **************************************************************************************************
121 : !> \brief Start timer
122 : !> \param routineN ...
123 : !> \param handle ...
124 : !> \author Ole Schuett
125 : ! **************************************************************************************************
126 493273828 : SUBROUTINE timeset(routineN, handle)
127 : CHARACTER(LEN=*), INTENT(IN) :: routineN
128 : INTEGER, INTENT(OUT) :: handle
129 :
130 493273828 : IF (ASSOCIATED(timeset_hook)) THEN
131 493254046 : CALL timeset_hook(routineN, handle)
132 : ELSE
133 19782 : handle = -1
134 : END IF
135 493273828 : END SUBROUTINE timeset
136 :
137 : ! **************************************************************************************************
138 : !> \brief Stop timer
139 : !> \param handle ...
140 : !> \author Ole Schuett
141 : ! **************************************************************************************************
142 493273828 : SUBROUTINE timestop(handle)
143 : INTEGER, INTENT(IN) :: handle
144 :
145 493273828 : IF (ASSOCIATED(timestop_hook)) THEN
146 493254046 : CALL timestop_hook(handle)
147 : ELSE
148 19782 : IF (handle /= -1) THEN
149 0 : CALL cp_abort(cp__l("base_hooks.F", __LINE__), "Got wrong handle")
150 : END IF
151 : END IF
152 493273828 : END SUBROUTINE timestop
153 :
154 : ! **************************************************************************************************
155 : !> \brief CPASSERT handler
156 : !> \param filename ...
157 : !> \param lineNr ...
158 : !> \author Ole Schuett
159 : ! **************************************************************************************************
160 0 : SUBROUTINE cp__a(filename, lineNr)
161 : CHARACTER(len=*), INTENT(in) :: filename
162 : INTEGER, INTENT(in) :: lineNr
163 :
164 0 : CALL cp_abort(location=cp__l(filename, lineNr), message="CPASSERT failed")
165 : ! compiler hint
166 0 : STOP "Never return from here"
167 : END SUBROUTINE cp__a
168 :
169 : ! **************************************************************************************************
170 : !> \brief CPABORT handler
171 : !> \param filename ...
172 : !> \param lineNr ...
173 : !> \param message ...
174 : !> \author Ole Schuett
175 : ! **************************************************************************************************
176 0 : SUBROUTINE cp__b(filename, lineNr, message)
177 : CHARACTER(len=*), INTENT(in) :: filename
178 : INTEGER, INTENT(in) :: lineNr
179 : CHARACTER(len=*), INTENT(in) :: message
180 :
181 0 : CALL cp_abort(location=cp__l(filename, lineNr), message=message)
182 : ! compiler hint
183 0 : STOP "Never return from here"
184 : END SUBROUTINE cp__b
185 :
186 : ! **************************************************************************************************
187 : !> \brief CPWARN handler
188 : !> \param filename ...
189 : !> \param lineNr ...
190 : !> \param message ...
191 : !> \author Ole Schuett
192 : ! **************************************************************************************************
193 14965 : SUBROUTINE cp__w(filename, lineNr, message)
194 : CHARACTER(len=*), INTENT(in) :: filename
195 : INTEGER, INTENT(in) :: lineNr
196 : CHARACTER(len=*), INTENT(in) :: message
197 :
198 14965 : CALL cp_warn(location=cp__l(filename, lineNr), message=message)
199 14965 : END SUBROUTINE cp__w
200 :
201 : ! **************************************************************************************************
202 : !> \brief CPHINT handler
203 : !> \param filename ...
204 : !> \param lineNr ...
205 : !> \param message ...
206 : !> \author Hans Pabst
207 : ! **************************************************************************************************
208 56 : SUBROUTINE cp__h(filename, lineNr, message)
209 : CHARACTER(len=*), INTENT(in) :: filename
210 : INTEGER, INTENT(in) :: lineNr
211 : CHARACTER(len=*), INTENT(in) :: message
212 :
213 56 : CALL cp_hint(location=cp__l(filename, lineNr), message=message)
214 56 : END SUBROUTINE cp__h
215 :
216 : ! **************************************************************************************************
217 : !> \brief Helper routine to assemble __LOCATION__
218 : !> \param filename ...
219 : !> \param lineNr ...
220 : !> \return ...
221 : !> \author Ole Schuett
222 : ! **************************************************************************************************
223 946534337 : FUNCTION cp__l(filename, lineNr) RESULT(location)
224 : CHARACTER(len=*), INTENT(in) :: filename
225 : INTEGER, INTENT(in) :: lineNr
226 : CHARACTER(len=default_string_length) :: location
227 :
228 : CHARACTER(len=15) :: lineNr_str
229 :
230 946534337 : WRITE (lineNr_str, FMT='(I10)') lineNr
231 946534337 : location = TRIM(filename)//":"//TRIM(ADJUSTL(lineNr_str))
232 :
233 946534337 : END FUNCTION cp__l
234 :
235 : END MODULE base_hooks
|
