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 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 37177 : 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 37177 : CALL timeset(routineN, handle)
103 37177 : ALLOCATE (results)
104 : NULLIFY (results%result_value, results%result_label)
105 37177 : results%ref_count = 1
106 37177 : ALLOCATE (results%result_label(0))
107 37177 : ALLOCATE (results%result_value(0))
108 37177 : CALL timestop(handle)
109 37177 : 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 42527 : 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 42527 : CALL timeset(routineN, handle)
127 42527 : IF (ASSOCIATED(results)) THEN
128 42527 : CPASSERT(results%ref_count > 0)
129 42527 : results%ref_count = results%ref_count - 1
130 42527 : IF (results%ref_count == 0) THEN
131 : ! Description
132 37177 : IF (ASSOCIATED(results%result_label)) THEN
133 37177 : DEALLOCATE (results%result_label)
134 : END IF
135 : ! Values
136 37177 : IF (ASSOCIATED(results%result_value)) THEN
137 50143 : DO i = 1, SIZE(results%result_value)
138 50143 : CALL cp_result_value_release(results%result_value(i)%value)
139 : END DO
140 37177 : DEALLOCATE (results%result_value)
141 : END IF
142 37177 : DEALLOCATE (results)
143 : END IF
144 : END IF
145 42527 : CALL timestop(handle)
146 42527 : 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 58620 : 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 58620 : CALL timeset(routineN, handle)
161 : ! Description
162 58620 : IF (ASSOCIATED(results%result_label)) THEN
163 58620 : DEALLOCATE (results%result_label)
164 : END IF
165 : ! Values
166 58620 : IF (ASSOCIATED(results%result_value)) THEN
167 91026 : DO i = 1, SIZE(results%result_value)
168 91026 : CALL cp_result_value_release(results%result_value(i)%value)
169 : END DO
170 58620 : DEALLOCATE (results%result_value)
171 : END IF
172 58620 : CALL timestop(handle)
173 58620 : 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 53874 : 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 53874 : CALL timeset(routineN, handle)
202 53874 : ALLOCATE (value)
203 53874 : CALL timestop(handle)
204 53874 : 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 33130 : 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 33130 : CALL timeset(routineN, handle)
222 33130 : value%type_in_use = type_in_use
223 33130 : SELECT CASE (value%type_in_use)
224 : CASE (result_type_real)
225 99390 : 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 33130 : CPABORT("")
233 : END SELECT
234 33130 : CALL timestop(handle)
235 33130 : 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 53874 : 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 53874 : CALL timeset(routineN, handle)
250 53874 : IF (ASSOCIATED(value)) THEN
251 107748 : SELECT CASE (value%type_in_use)
252 : CASE (result_type_real)
253 53874 : IF (ASSOCIATED(value%real_type)) THEN
254 53874 : DEALLOCATE (value%real_type)
255 : END IF
256 53874 : CPASSERT(.NOT. ASSOCIATED(value%integer_type))
257 53874 : 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 53874 : CPABORT("")
273 : END SELECT
274 53874 : DEALLOCATE (value)
275 : END IF
276 53874 : CALL timestop(handle)
277 53874 : 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 26704 : 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 26704 : CALL timeset(routineN, handle)
294 26704 : CALL cp_result_clean(results_out)
295 :
296 26704 : check = SIZE(results_in%result_label) == SIZE(results_in%result_value)
297 26704 : CPASSERT(check)
298 26704 : ndim = SIZE(results_in%result_value)
299 58860 : ALLOCATE (results_out%result_label(ndim))
300 65124 : ALLOCATE (results_out%result_value(ndim))
301 32968 : DO i = 1, ndim
302 6264 : results_out%result_label(i) = results_in%result_label(i)
303 6264 : CALL cp_result_value_create(results_out%result_value(i)%value)
304 : CALL cp_result_value_copy(results_out%result_value(i)%value, &
305 32968 : results_in%result_value(i)%value)
306 : END DO
307 26704 : CALL timestop(handle)
308 26704 : 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 20744 : 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 20744 : CALL timeset(routineN, handle)
324 20744 : value_out%type_in_use = value_in%type_in_use
325 20744 : SELECT CASE (value_out%type_in_use)
326 : CASE (result_type_real)
327 20744 : isize = SIZE(value_in%real_type)
328 62232 : ALLOCATE (value_out%real_type(isize))
329 102084 : 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 20744 : CPABORT("")
341 : END SELECT
342 20744 : CALL timestop(handle)
343 20744 : 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 32716 : 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 32716 : POINTER :: tmp_value
362 :
363 32716 : CALL timeset(routineN, handle)
364 32716 : ub_size = 0
365 32716 : lb_size = 0
366 32716 : IF (ASSOCIATED(result_value)) THEN
367 32716 : ub_size = UBOUND(result_value, 1)
368 32716 : lb_size = LBOUND(result_value, 1)
369 : END IF
370 : ! Allocate and copy new values while releases old
371 172082 : ALLOCATE (tmp_value(istart:iend))
372 73934 : DO i = istart, iend
373 41218 : NULLIFY (tmp_value(i)%value)
374 41218 : CALL cp_result_value_create(tmp_value(i)%value)
375 73934 : IF ((i <= ub_size) .AND. (i >= lb_size)) THEN
376 8502 : CALL cp_result_value_copy(tmp_value(i)%value, result_value(i)%value)
377 8502 : CALL cp_result_value_release(result_value(i)%value)
378 : END IF
379 : END DO
380 32716 : DEALLOCATE (result_value)
381 32716 : result_value => tmp_value
382 32716 : CALL timestop(handle)
383 32716 : END SUBROUTINE cp_result_value_p_reallocate
384 :
385 0 : END MODULE cp_result_types
|
