Line data Source code
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
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 20532 : SUBROUTINE cp_warn(location, message)
93 : CHARACTER(len=*), INTENT(in) :: location, message
94 :
95 20532 : IF (ASSOCIATED(cp_warn_hook)) THEN
96 20532 : 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 20532 : END SUBROUTINE cp_warn
102 :
103 : ! **************************************************************************************************
104 : !> \brief Issue a hint
105 : !> \param location ...
106 : !> \param message ...
107 : !> \author Hans Pabst
108 : ! **************************************************************************************************
109 56 : SUBROUTINE cp_hint(location, message)
110 : CHARACTER(len=*), INTENT(in) :: location, message
111 :
112 56 : IF (ASSOCIATED(cp_hint_hook)) THEN
113 56 : 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 56 : END SUBROUTINE cp_hint
119 :
120 : ! **************************************************************************************************
121 : !> \brief Start timer
122 : !> \param routineN ...
123 : !> \param handle ...
124 : !> \author Ole Schuett
125 : ! **************************************************************************************************
126 376309499 : SUBROUTINE timeset(routineN, handle)
127 : CHARACTER(LEN=*), INTENT(IN) :: routineN
128 : INTEGER, INTENT(OUT) :: handle
129 :
130 376309499 : IF (ASSOCIATED(timeset_hook)) THEN
131 376289737 : CALL timeset_hook(routineN, handle)
132 : ELSE
133 19762 : handle = -1
134 : END IF
135 376309499 : END SUBROUTINE timeset
136 :
137 : ! **************************************************************************************************
138 : !> \brief Stop timer
139 : !> \param handle ...
140 : !> \author Ole Schuett
141 : ! **************************************************************************************************
142 376309499 : SUBROUTINE timestop(handle)
143 : INTEGER, INTENT(IN) :: handle
144 :
145 376309499 : IF (ASSOCIATED(timestop_hook)) THEN
146 376289737 : CALL timestop_hook(handle)
147 : ELSE
148 19762 : IF (handle /= -1) &
149 0 : CALL cp_abort(cp__l("base_hooks.F", __LINE__), "Got wrong handle")
150 : END IF
151 376309499 : END SUBROUTINE timestop
152 :
153 : ! **************************************************************************************************
154 : !> \brief CPASSERT handler
155 : !> \param filename ...
156 : !> \param lineNr ...
157 : !> \author Ole Schuett
158 : ! **************************************************************************************************
159 0 : SUBROUTINE cp__a(filename, lineNr)
160 : CHARACTER(len=*), INTENT(in) :: filename
161 : INTEGER, INTENT(in) :: lineNr
162 :
163 0 : CALL cp_abort(location=cp__l(filename, lineNr), message="CPASSERT failed")
164 : ! compiler hint
165 0 : 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 0 : 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 0 : CALL cp_abort(location=cp__l(filename, lineNr), message=message)
181 : ! compiler hint
182 0 : 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 13207 : 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 13207 : CALL cp_warn(location=cp__l(filename, lineNr), message=message)
198 13207 : 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 56 : 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 56 : CALL cp_hint(location=cp__l(filename, lineNr), message=message)
213 56 : 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 611962215 : 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 611962215 : WRITE (lineNr_str, FMT='(I10)') lineNr
230 611962215 : location = TRIM(filename)//":"//TRIM(ADJUSTL(lineNr_str))
231 :
232 611962215 : END FUNCTION cp__l
233 :
234 : END MODULE base_hooks
|
