(git:374b731)
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-2024 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 ! Type not implemented in cp_result_type
232 cpabort("")
233 END SELECT
234 CALL timestop(handle)
235 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 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 CALL timeset(routinen, handle)
250 IF (ASSOCIATED(value)) THEN
251 SELECT CASE (value%type_in_use)
252 CASE (result_type_real)
253 IF (ASSOCIATED(value%real_type)) THEN
254 DEALLOCATE (value%real_type)
255 END IF
256 cpassert(.NOT. ASSOCIATED(value%integer_type))
257 cpassert(.NOT. ASSOCIATED(value%logical_type))
258 CASE (result_type_integer)
259 IF (ASSOCIATED(value%integer_type)) THEN
260 DEALLOCATE (value%integer_type)
261 END IF
262 cpassert(.NOT. ASSOCIATED(value%real_type))
263 cpassert(.NOT. ASSOCIATED(value%logical_type))
264 CASE (result_type_logical)
265 IF (ASSOCIATED(value%logical_type)) THEN
266 DEALLOCATE (value%logical_type)
267 END IF
268 cpassert(.NOT. ASSOCIATED(value%integer_type))
269 cpassert(.NOT. ASSOCIATED(value%real_type))
270 CASE DEFAULT
271 ! Type not implemented in cp_result_type
272 cpabort("")
273 END SELECT
274 DEALLOCATE (value)
275 END IF
276 CALL timestop(handle)
277 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 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 CALL timeset(routinen, handle)
294 CALL cp_result_clean(results_out)
295
296 check = SIZE(results_in%result_label) == SIZE(results_in%result_value)
297 cpassert(check)
298 ndim = SIZE(results_in%result_value)
299 ALLOCATE (results_out%result_label(ndim))
300 ALLOCATE (results_out%result_value(ndim))
301 DO i = 1, ndim
302 results_out%result_label(i) = results_in%result_label(i)
303 CALL cp_result_value_create(results_out%result_value(i)%value)
304 CALL cp_result_value_copy(results_out%result_value(i)%value, &
305 results_in%result_value(i)%value)
306 END DO
307 CALL timestop(handle)
308 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 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 CALL timeset(routinen, handle)
324 value_out%type_in_use = value_in%type_in_use
325 SELECT CASE (value_out%type_in_use)
326 CASE (result_type_real)
327 isize = SIZE(value_in%real_type)
328 ALLOCATE (value_out%real_type(isize))
329 value_out%real_type = value_in%real_type
330 CASE (result_type_integer)
331 isize = SIZE(value_in%integer_type)
332 ALLOCATE (value_out%integer_type(isize))
333 value_out%integer_type = value_in%integer_type
334 CASE (result_type_logical)
335 isize = SIZE(value_in%logical_type)
336 ALLOCATE (value_out%logical_type(isize))
337 value_out%logical_type = value_in%logical_type
338 CASE DEFAULT
339 ! Type not implemented in cp_result_type
340 cpabort("")
341 END SELECT
342 CALL timestop(handle)
343 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 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 POINTER :: tmp_value
362
363 CALL timeset(routinen, handle)
364 ub_size = 0
365 lb_size = 0
366 IF (ASSOCIATED(result_value)) THEN
367 ub_size = ubound(result_value, 1)
368 lb_size = lbound(result_value, 1)
369 END IF
370 ! Allocate and copy new values while releases old
371 ALLOCATE (tmp_value(istart:iend))
372 DO i = istart, iend
373 NULLIFY (tmp_value(i)%value)
374 CALL cp_result_value_create(tmp_value(i)%value)
375 IF ((i <= ub_size) .AND. (i >= lb_size)) THEN
376 CALL cp_result_value_copy(tmp_value(i)%value, result_value(i)%value)
377 CALL cp_result_value_release(result_value(i)%value)
378 END IF
379 END DO
380 DEALLOCATE (result_value)
381 result_value => tmp_value
382 CALL timestop(handle)
383 END SUBROUTINE cp_result_value_p_reallocate
384
385END 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:286
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:353
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:317
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