(git:295f299)
Loading...
Searching...
No Matches
cp_result_types.F
Go to the documentation of this file.
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 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! **************************************************************************************************
18MODULE 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
85CONTAINS
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 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 CALL timeset(routinen, handle)
103 ALLOCATE (results)
104 NULLIFY (results%result_value, results%result_label)
105 results%ref_count = 1
106 ALLOCATE (results%result_label(0))
107 ALLOCATE (results%result_value(0))
108 CALL timestop(handle)
109 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 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 CALL timeset(routinen, handle)
127 IF (ASSOCIATED(results)) THEN
128 cpassert(results%ref_count > 0)
129 results%ref_count = results%ref_count - 1
130 IF (results%ref_count == 0) THEN
131 ! Description
132 IF (ASSOCIATED(results%result_label)) THEN
133 DEALLOCATE (results%result_label)
134 END IF
135 ! Values
136 IF (ASSOCIATED(results%result_value)) THEN
137 DO i = 1, SIZE(results%result_value)
138 CALL cp_result_value_release(results%result_value(i)%value)
139 END DO
140 DEALLOCATE (results%result_value)
141 END IF
142 DEALLOCATE (results)
143 END IF
144 END IF
145 CALL timestop(handle)
146 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 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 CALL timeset(routinen, handle)
161 ! Description
162 IF (ASSOCIATED(results%result_label)) THEN
163 DEALLOCATE (results%result_label)
164 END IF
165 ! Values
166 IF (ASSOCIATED(results%result_value)) THEN
167 DO i = 1, SIZE(results%result_value)
168 CALL cp_result_value_release(results%result_value(i)%value)
169 END DO
170 DEALLOCATE (results%result_value)
171 END IF
172 CALL timestop(handle)
173 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 SUBROUTINE cp_result_retain(results)
183 TYPE(cp_result_type), INTENT(INOUT) :: results
184
185 cpassert(results%ref_count > 0)
186 results%ref_count = results%ref_count + 1
187 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 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 CALL timeset(routinen, handle)
202 ALLOCATE (value)
203 CALL timestop(handle)
204 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 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 CALL timeset(routinen, handle)
222 value%type_in_use = type_in_use
223 SELECT CASE (value%type_in_use)
224 CASE (result_type_real)
225 ALLOCATE (value%real_type(size_value))
226 CASE (result_type_integer)
227 ALLOCATE (value%integer_type(size_value))
228 CASE (result_type_logical)
229 ALLOCATE (value%logical_type(size_value))
230 CASE DEFAULT
231 cpabort("Type not implemented in cp_result_type")
232 END SELECT
233 CALL timestop(handle)
234 END SUBROUTINE cp_result_value_init
235
236! **************************************************************************************************
237!> \brief Releases the cp_result_value type
238!> \param value ...
239!> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
240! **************************************************************************************************
241 SUBROUTINE cp_result_value_release(value)
242 TYPE(cp_result_value_type), POINTER :: value
243
244 CHARACTER(len=*), PARAMETER :: routinen = 'cp_result_value_release'
245
246 INTEGER :: handle
247
248 CALL timeset(routinen, handle)
249 IF (ASSOCIATED(value)) THEN
250 SELECT CASE (value%type_in_use)
251 CASE (result_type_real)
252 IF (ASSOCIATED(value%real_type)) THEN
253 DEALLOCATE (value%real_type)
254 END IF
255 cpassert(.NOT. ASSOCIATED(value%integer_type))
256 cpassert(.NOT. ASSOCIATED(value%logical_type))
257 CASE (result_type_integer)
258 IF (ASSOCIATED(value%integer_type)) THEN
259 DEALLOCATE (value%integer_type)
260 END IF
261 cpassert(.NOT. ASSOCIATED(value%real_type))
262 cpassert(.NOT. ASSOCIATED(value%logical_type))
263 CASE (result_type_logical)
264 IF (ASSOCIATED(value%logical_type)) THEN
265 DEALLOCATE (value%logical_type)
266 END IF
267 cpassert(.NOT. ASSOCIATED(value%integer_type))
268 cpassert(.NOT. ASSOCIATED(value%real_type))
269 CASE DEFAULT
270 cpabort("Type not implemented in cp_result_type")
271 END SELECT
272 DEALLOCATE (value)
273 END IF
274 CALL timestop(handle)
275 END SUBROUTINE cp_result_value_release
276
277! **************************************************************************************************
278!> \brief Copies the cp_result type
279!> \param results_in ...
280!> \param results_out ...
281!> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
282! **************************************************************************************************
283 SUBROUTINE cp_result_copy(results_in, results_out)
284 TYPE(cp_result_type), INTENT(INOUT) :: results_in, results_out
285
286 CHARACTER(len=*), PARAMETER :: routinen = 'cp_result_copy'
287
288 INTEGER :: handle, i, ndim
289 LOGICAL :: check
290
291 CALL timeset(routinen, handle)
292 CALL cp_result_clean(results_out)
293
294 check = SIZE(results_in%result_label) == SIZE(results_in%result_value)
295 cpassert(check)
296 ndim = SIZE(results_in%result_value)
297 ALLOCATE (results_out%result_label(ndim))
298 ALLOCATE (results_out%result_value(ndim))
299 DO i = 1, ndim
300 results_out%result_label(i) = results_in%result_label(i)
301 CALL cp_result_value_create(results_out%result_value(i)%value)
302 CALL cp_result_value_copy(results_out%result_value(i)%value, &
303 results_in%result_value(i)%value)
304 END DO
305 CALL timestop(handle)
306 END SUBROUTINE cp_result_copy
307
308! **************************************************************************************************
309!> \brief Copies the cp_result_value type
310!> \param value_out ...
311!> \param value_in ...
312!> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
313! **************************************************************************************************
314 SUBROUTINE cp_result_value_copy(value_out, value_in)
315 TYPE(cp_result_value_type), INTENT(INOUT) :: value_out, value_in
316
317 CHARACTER(len=*), PARAMETER :: routinen = 'cp_result_value_copy'
318
319 INTEGER :: handle, isize
320
321 CALL timeset(routinen, handle)
322 value_out%type_in_use = value_in%type_in_use
323 SELECT CASE (value_out%type_in_use)
324 CASE (result_type_real)
325 isize = SIZE(value_in%real_type)
326 ALLOCATE (value_out%real_type(isize))
327 value_out%real_type = value_in%real_type
328 CASE (result_type_integer)
329 isize = SIZE(value_in%integer_type)
330 ALLOCATE (value_out%integer_type(isize))
331 value_out%integer_type = value_in%integer_type
332 CASE (result_type_logical)
333 isize = SIZE(value_in%logical_type)
334 ALLOCATE (value_out%logical_type(isize))
335 value_out%logical_type = value_in%logical_type
336 CASE DEFAULT
337 cpabort("Type not implemented in cp_result_type")
338 END SELECT
339 CALL timestop(handle)
340 END SUBROUTINE cp_result_value_copy
341
342! **************************************************************************************************
343!> \brief Reallocates the cp_result_value type
344!> \param result_value ...
345!> \param istart ...
346!> \param iend ...
347!> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
348! **************************************************************************************************
349 SUBROUTINE cp_result_value_p_reallocate(result_value, istart, iend)
350 TYPE(cp_result_value_p_type), DIMENSION(:), &
351 POINTER :: result_value
352 INTEGER, INTENT(in) :: istart, iend
353
354 CHARACTER(len=*), PARAMETER :: routinen = 'cp_result_value_p_reallocate'
355
356 INTEGER :: handle, i, lb_size, ub_size
357 TYPE(cp_result_value_p_type), DIMENSION(:), &
358 POINTER :: tmp_value
359
360 CALL timeset(routinen, handle)
361 ub_size = 0
362 lb_size = 0
363 IF (ASSOCIATED(result_value)) THEN
364 ub_size = ubound(result_value, 1)
365 lb_size = lbound(result_value, 1)
366 END IF
367 ! Allocate and copy new values while releases old
368 ALLOCATE (tmp_value(istart:iend))
369 DO i = istart, iend
370 NULLIFY (tmp_value(i)%value)
371 CALL cp_result_value_create(tmp_value(i)%value)
372 IF ((i <= ub_size) .AND. (i >= lb_size)) THEN
373 CALL cp_result_value_copy(tmp_value(i)%value, result_value(i)%value)
374 CALL cp_result_value_release(result_value(i)%value)
375 END IF
376 END DO
377 DEALLOCATE (result_value)
378 result_value => tmp_value
379 CALL timestop(handle)
380 END SUBROUTINE cp_result_value_p_reallocate
381
382END MODULE cp_result_types
cp_result_types
set of type/routines to handle the storage of results in force_envs
Definition cp_result_types.F:18
cp_result_types::result_type_real
integer, parameter, public result_type_real
Definition cp_result_types.F:30
cp_result_types::cp_result_copy
subroutine, public cp_result_copy(results_in, results_out)
Copies the cp_result type.
Definition cp_result_types.F:284
cp_result_types::result_type_logical
integer, parameter, public result_type_logical
Definition cp_result_types.F:30
cp_result_types::cp_result_retain
subroutine, public cp_result_retain(results)
Retains cp_result type.
Definition cp_result_types.F:183
cp_result_types::cp_result_release
subroutine, public cp_result_release(results)
Releases cp_result type.
Definition cp_result_types.F:120
cp_result_types::cp_result_value_create
subroutine, public cp_result_value_create(value)
Allocates and intitializes the cp_result_value type.
Definition cp_result_types.F:195
cp_result_types::cp_result_clean
subroutine, public cp_result_clean(results)
Releases cp_result clean.
Definition cp_result_types.F:154
cp_result_types::result_type_integer
integer, parameter, public result_type_integer
Definition cp_result_types.F:30
cp_result_types::cp_result_create
subroutine, public cp_result_create(results)
Allocates and intitializes the cp_result.
Definition cp_result_types.F:96
cp_result_types::cp_result_value_p_reallocate
subroutine, public cp_result_value_p_reallocate(result_value, istart, iend)
Reallocates the cp_result_value type.
Definition cp_result_types.F:350
cp_result_types::cp_result_value_copy
subroutine, public cp_result_value_copy(value_out, value_in)
Copies the cp_result_value type.
Definition cp_result_types.F:315
cp_result_types::cp_result_value_init
subroutine, public cp_result_value_init(value, type_in_use, size_value)
Setup of the cp_result_value type.
Definition cp_result_types.F:214
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
cp_result_types::cp_result_p_type
Definition cp_result_types.F:81
cp_result_types::cp_result_type
contains arbitrary information which need to be stored
Definition cp_result_types.F:73