Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief set of type/routines to handle the storage of results in force_envs
10 : !> \author fschiff (12.2007)
11 : !> \par History
12 : !> - 10.2008 Teodoro Laino [tlaino] - University of Zurich
13 : !> major rewriting:
14 : !> - information stored in a proper type (not in a character!)
15 : !> - module more lean
16 : !> - splitting types and creating methods for cp_results
17 : ! **************************************************************************************************
18 : MODULE cp_result_types
19 :
20 : USE kinds, ONLY: default_string_length,&
21 : dp
22 : #include "../base/base_uses.f90"
23 :
24 : IMPLICIT NONE
25 :
26 : PRIVATE
27 :
28 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_result_types'
29 :
30 : INTEGER, PARAMETER, PUBLIC :: result_type_logical = 1, &
31 : result_type_integer = 2, &
32 : result_type_real = 3
33 :
34 : ! *** Public data types ***
35 : PUBLIC :: cp_result_type, &
36 : cp_result_p_type
37 :
38 : ! *** Public subroutines ***
39 : PUBLIC :: cp_result_create, &
40 : cp_result_release, &
41 : cp_result_retain, &
42 : cp_result_clean, &
43 : cp_result_copy, &
44 : cp_result_value_create, &
45 : cp_result_value_copy, &
46 : cp_result_value_p_reallocate, &
47 : cp_result_value_init
48 :
49 : ! **************************************************************************************************
50 : !> \brief low level type for storing real informations
51 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
52 : ! **************************************************************************************************
53 : TYPE cp_result_value_type
54 : INTEGER :: type_in_use = -1
55 : LOGICAL, DIMENSION(:), POINTER :: logical_type => NULL()
56 : INTEGER, DIMENSION(:), POINTER :: integer_type => NULL()
57 : REAL(KIND=dp), DIMENSION(:), POINTER :: real_type => NULL()
58 : END TYPE cp_result_value_type
59 :
60 : ! **************************************************************************************************
61 : TYPE cp_result_value_p_type
62 : TYPE(cp_result_value_type), POINTER :: value => NULL()
63 : END TYPE cp_result_value_p_type
64 :
65 : ! **************************************************************************************************
66 : !> \brief contains arbitrary information which need to be stored
67 : !> \note
68 : !> result_list is a character list, in which everything can be stored
69 : !> before passing any variable just name the variable like '[NAME]'
70 : !> brackets will be used to identify the start of a new set
71 : !> \author fschiff (12.2007)
72 : ! **************************************************************************************************
73 : TYPE cp_result_type
74 : INTEGER :: ref_count = -1
75 : TYPE(cp_result_value_p_type), POINTER, DIMENSION(:) :: result_value => NULL()
76 : CHARACTER(LEN=default_string_length), DIMENSION(:), &
77 : POINTER :: result_label => NULL()
78 : END TYPE cp_result_type
79 :
80 : ! **************************************************************************************************
81 : TYPE cp_result_p_type
82 : TYPE(cp_result_type), POINTER :: results => NULL()
83 : END TYPE cp_result_p_type
84 :
85 : CONTAINS
86 :
87 : ! **************************************************************************************************
88 : !> \brief Allocates and intitializes the cp_result
89 : !> \param results ...
90 : !> \par History
91 : !> 12.2007 created
92 : !> 10.2008 Teodoro Laino [tlaino] - major rewriting
93 : !> \author fschiff
94 : ! **************************************************************************************************
95 43789 : SUBROUTINE cp_result_create(results)
96 : TYPE(cp_result_type), POINTER :: results
97 :
98 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_result_create'
99 :
100 : INTEGER :: handle
101 :
102 43789 : CALL timeset(routineN, handle)
103 43789 : ALLOCATE (results)
104 : NULLIFY (results%result_value, results%result_label)
105 43789 : results%ref_count = 1
106 43789 : ALLOCATE (results%result_label(0))
107 43789 : ALLOCATE (results%result_value(0))
108 43789 : CALL timestop(handle)
109 43789 : END SUBROUTINE cp_result_create
110 :
111 : ! **************************************************************************************************
112 : !> \brief Releases cp_result type
113 : !> \param results ...
114 : !> \par History
115 : !> 12.2007 created
116 : !> 10.2008 Teodoro Laino [tlaino] - major rewriting
117 : !> \author fschiff
118 : ! **************************************************************************************************
119 49139 : SUBROUTINE cp_result_release(results)
120 : TYPE(cp_result_type), POINTER :: results
121 :
122 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_result_release'
123 :
124 : INTEGER :: handle, i
125 :
126 49139 : CALL timeset(routineN, handle)
127 49139 : IF (ASSOCIATED(results)) THEN
128 49139 : CPASSERT(results%ref_count > 0)
129 49139 : results%ref_count = results%ref_count - 1
130 49139 : IF (results%ref_count == 0) THEN
131 : ! Description
132 43789 : IF (ASSOCIATED(results%result_label)) THEN
133 43789 : DEALLOCATE (results%result_label)
134 : END IF
135 : ! Values
136 43789 : IF (ASSOCIATED(results%result_value)) THEN
137 88933 : DO i = 1, SIZE(results%result_value)
138 88933 : CALL cp_result_value_release(results%result_value(i)%value)
139 : END DO
140 43789 : DEALLOCATE (results%result_value)
141 : END IF
142 43789 : DEALLOCATE (results)
143 : END IF
144 : END IF
145 49139 : CALL timestop(handle)
146 49139 : END SUBROUTINE cp_result_release
147 :
148 : ! **************************************************************************************************
149 : !> \brief Releases cp_result clean
150 : !> \param results ...
151 : !> \author Teodoro Laino [tlaino] - University of Zurich - 10.2008
152 : ! **************************************************************************************************
153 70408 : SUBROUTINE cp_result_clean(results)
154 : TYPE(cp_result_type), INTENT(INOUT) :: results
155 :
156 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_result_clean'
157 :
158 : INTEGER :: handle, i
159 :
160 70408 : CALL timeset(routineN, handle)
161 : ! Description
162 70408 : IF (ASSOCIATED(results%result_label)) THEN
163 70408 : DEALLOCATE (results%result_label)
164 : END IF
165 : ! Values
166 70408 : IF (ASSOCIATED(results%result_value)) THEN
167 136168 : DO i = 1, SIZE(results%result_value)
168 136168 : CALL cp_result_value_release(results%result_value(i)%value)
169 : END DO
170 70408 : DEALLOCATE (results%result_value)
171 : END IF
172 70408 : CALL timestop(handle)
173 70408 : END SUBROUTINE cp_result_clean
174 :
175 : ! **************************************************************************************************
176 : !> \brief Retains cp_result type
177 : !> \param results ...
178 : !> \par History
179 : !> 12.2007 created
180 : !> \author fschiff
181 : ! **************************************************************************************************
182 5350 : SUBROUTINE cp_result_retain(results)
183 : TYPE(cp_result_type), INTENT(INOUT) :: results
184 :
185 5350 : CPASSERT(results%ref_count > 0)
186 5350 : results%ref_count = results%ref_count + 1
187 5350 : END SUBROUTINE cp_result_retain
188 :
189 : ! **************************************************************************************************
190 : !> \brief Allocates and intitializes the cp_result_value type
191 : !> \param value ...
192 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
193 : ! **************************************************************************************************
194 158412 : SUBROUTINE cp_result_value_create(value)
195 : TYPE(cp_result_value_type), POINTER :: value
196 :
197 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_result_value_create'
198 :
199 : INTEGER :: handle
200 :
201 158412 : CALL timeset(routineN, handle)
202 158412 : ALLOCATE (value)
203 158412 : CALL timestop(handle)
204 158412 : END SUBROUTINE cp_result_value_create
205 :
206 : ! **************************************************************************************************
207 : !> \brief Setup of the cp_result_value type
208 : !> \param value ...
209 : !> \param type_in_use ...
210 : !> \param size_value ...
211 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
212 : ! **************************************************************************************************
213 43738 : SUBROUTINE cp_result_value_init(value, type_in_use, size_value)
214 : TYPE(cp_result_value_type), INTENT(INOUT) :: value
215 : INTEGER, INTENT(IN) :: type_in_use, size_value
216 :
217 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_result_value_init'
218 :
219 : INTEGER :: handle
220 :
221 43738 : CALL timeset(routineN, handle)
222 43738 : value%type_in_use = type_in_use
223 43738 : SELECT CASE (value%type_in_use)
224 : CASE (result_type_real)
225 131214 : ALLOCATE (value%real_type(size_value))
226 : CASE (result_type_integer)
227 0 : ALLOCATE (value%integer_type(size_value))
228 : CASE (result_type_logical)
229 0 : ALLOCATE (value%logical_type(size_value))
230 : CASE DEFAULT
231 : ! Type not implemented in cp_result_type
232 43738 : CPABORT("")
233 : END SELECT
234 43738 : CALL timestop(handle)
235 43738 : END SUBROUTINE cp_result_value_init
236 :
237 : ! **************************************************************************************************
238 : !> \brief Releases the cp_result_value type
239 : !> \param value ...
240 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
241 : ! **************************************************************************************************
242 158412 : SUBROUTINE cp_result_value_release(value)
243 : TYPE(cp_result_value_type), POINTER :: value
244 :
245 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_result_value_release'
246 :
247 : INTEGER :: handle
248 :
249 158412 : CALL timeset(routineN, handle)
250 158412 : IF (ASSOCIATED(value)) THEN
251 316824 : SELECT CASE (value%type_in_use)
252 : CASE (result_type_real)
253 158412 : IF (ASSOCIATED(value%real_type)) THEN
254 158412 : DEALLOCATE (value%real_type)
255 : END IF
256 158412 : CPASSERT(.NOT. ASSOCIATED(value%integer_type))
257 158412 : CPASSERT(.NOT. ASSOCIATED(value%logical_type))
258 : CASE (result_type_integer)
259 0 : IF (ASSOCIATED(value%integer_type)) THEN
260 0 : DEALLOCATE (value%integer_type)
261 : END IF
262 0 : CPASSERT(.NOT. ASSOCIATED(value%real_type))
263 0 : CPASSERT(.NOT. ASSOCIATED(value%logical_type))
264 : CASE (result_type_logical)
265 0 : IF (ASSOCIATED(value%logical_type)) THEN
266 0 : DEALLOCATE (value%logical_type)
267 : END IF
268 0 : CPASSERT(.NOT. ASSOCIATED(value%integer_type))
269 0 : CPASSERT(.NOT. ASSOCIATED(value%real_type))
270 : CASE DEFAULT
271 : ! Type not implemented in cp_result_type
272 158412 : CPABORT("")
273 : END SELECT
274 158412 : DEALLOCATE (value)
275 : END IF
276 158412 : CALL timestop(handle)
277 158412 : END SUBROUTINE cp_result_value_release
278 :
279 : ! **************************************************************************************************
280 : !> \brief Copies the cp_result type
281 : !> \param results_in ...
282 : !> \param results_out ...
283 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
284 : ! **************************************************************************************************
285 32598 : SUBROUTINE cp_result_copy(results_in, results_out)
286 : TYPE(cp_result_type), INTENT(INOUT) :: results_in, results_out
287 :
288 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_result_copy'
289 :
290 : INTEGER :: handle, i, ndim
291 : LOGICAL :: check
292 :
293 32598 : CALL timeset(routineN, handle)
294 32598 : CALL cp_result_clean(results_out)
295 :
296 32598 : check = SIZE(results_in%result_label) == SIZE(results_in%result_value)
297 32598 : CPASSERT(check)
298 32598 : ndim = SIZE(results_in%result_value)
299 76156 : ALLOCATE (results_out%result_label(ndim))
300 109932 : ALLOCATE (results_out%result_value(ndim))
301 66374 : DO i = 1, ndim
302 33776 : results_out%result_label(i) = results_in%result_label(i)
303 33776 : CALL cp_result_value_create(results_out%result_value(i)%value)
304 : CALL cp_result_value_copy(results_out%result_value(i)%value, &
305 66374 : results_in%result_value(i)%value)
306 : END DO
307 32598 : CALL timestop(handle)
308 32598 : END SUBROUTINE cp_result_copy
309 :
310 : ! **************************************************************************************************
311 : !> \brief Copies the cp_result_value type
312 : !> \param value_out ...
313 : !> \param value_in ...
314 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
315 : ! **************************************************************************************************
316 114674 : SUBROUTINE cp_result_value_copy(value_out, value_in)
317 : TYPE(cp_result_value_type), INTENT(INOUT) :: value_out, value_in
318 :
319 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_result_value_copy'
320 :
321 : INTEGER :: handle, isize
322 :
323 114674 : CALL timeset(routineN, handle)
324 114674 : value_out%type_in_use = value_in%type_in_use
325 114674 : SELECT CASE (value_out%type_in_use)
326 : CASE (result_type_real)
327 114674 : isize = SIZE(value_in%real_type)
328 344022 : ALLOCATE (value_out%real_type(isize))
329 1315453 : value_out%real_type = value_in%real_type
330 : CASE (result_type_integer)
331 0 : isize = SIZE(value_in%integer_type)
332 0 : ALLOCATE (value_out%integer_type(isize))
333 0 : value_out%integer_type = value_in%integer_type
334 : CASE (result_type_logical)
335 0 : isize = SIZE(value_in%logical_type)
336 0 : ALLOCATE (value_out%logical_type(isize))
337 0 : value_out%logical_type = value_in%logical_type
338 : CASE DEFAULT
339 : ! Type not implemented in cp_result_type
340 114674 : CPABORT("")
341 : END SELECT
342 114674 : CALL timestop(handle)
343 114674 : END SUBROUTINE cp_result_value_copy
344 :
345 : ! **************************************************************************************************
346 : !> \brief Reallocates the cp_result_value type
347 : !> \param result_value ...
348 : !> \param istart ...
349 : !> \param iend ...
350 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
351 : ! **************************************************************************************************
352 43264 : SUBROUTINE cp_result_value_p_reallocate(result_value, istart, iend)
353 : TYPE(cp_result_value_p_type), DIMENSION(:), &
354 : POINTER :: result_value
355 : INTEGER, INTENT(in) :: istart, iend
356 :
357 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_result_value_p_reallocate'
358 :
359 : INTEGER :: handle, i, lb_size, ub_size
360 : TYPE(cp_result_value_p_type), DIMENSION(:), &
361 43264 : POINTER :: tmp_value
362 :
363 43264 : CALL timeset(routineN, handle)
364 43264 : ub_size = 0
365 43264 : lb_size = 0
366 43264 : IF (ASSOCIATED(result_value)) THEN
367 43264 : ub_size = UBOUND(result_value, 1)
368 43264 : lb_size = LBOUND(result_value, 1)
369 : END IF
370 : ! Allocate and copy new values while releases old
371 263828 : ALLOCATE (tmp_value(istart:iend))
372 134036 : DO i = istart, iend
373 90772 : NULLIFY (tmp_value(i)%value)
374 90772 : CALL cp_result_value_create(tmp_value(i)%value)
375 134036 : IF ((i <= ub_size) .AND. (i >= lb_size)) THEN
376 47508 : CALL cp_result_value_copy(tmp_value(i)%value, result_value(i)%value)
377 47508 : CALL cp_result_value_release(result_value(i)%value)
378 : END IF
379 : END DO
380 43264 : DEALLOCATE (result_value)
381 43264 : result_value => tmp_value
382 43264 : CALL timestop(handle)
383 43264 : END SUBROUTINE cp_result_value_p_reallocate
384 :
385 0 : END MODULE cp_result_types
|
