Line data Source code
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 : ! **************************************************************************************************
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 44679 : 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 44679 : CALL timeset(routineN, handle)
103 44679 : ALLOCATE (results)
104 : NULLIFY (results%result_value, results%result_label)
105 44679 : results%ref_count = 1
106 44679 : ALLOCATE (results%result_label(0))
107 44679 : ALLOCATE (results%result_value(0))
108 44679 : CALL timestop(handle)
109 44679 : 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 50471 : 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 50471 : CALL timeset(routineN, handle)
127 50471 : IF (ASSOCIATED(results)) THEN
128 50471 : CPASSERT(results%ref_count > 0)
129 50471 : results%ref_count = results%ref_count - 1
130 50471 : IF (results%ref_count == 0) THEN
131 : ! Description
132 44679 : IF (ASSOCIATED(results%result_label)) THEN
133 44679 : DEALLOCATE (results%result_label)
134 : END IF
135 : ! Values
136 44679 : IF (ASSOCIATED(results%result_value)) THEN
137 93749 : DO i = 1, SIZE(results%result_value)
138 93749 : CALL cp_result_value_release(results%result_value(i)%value)
139 : END DO
140 44679 : DEALLOCATE (results%result_value)
141 : END IF
142 44679 : DEALLOCATE (results)
143 : END IF
144 : END IF
145 50471 : CALL timestop(handle)
146 50471 : 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 70256 : 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 70256 : CALL timeset(routineN, handle)
161 : ! Description
162 70256 : IF (ASSOCIATED(results%result_label)) THEN
163 70256 : DEALLOCATE (results%result_label)
164 : END IF
165 : ! Values
166 70256 : IF (ASSOCIATED(results%result_value)) THEN
167 138284 : DO i = 1, SIZE(results%result_value)
168 138284 : CALL cp_result_value_release(results%result_value(i)%value)
169 : END DO
170 70256 : DEALLOCATE (results%result_value)
171 : END IF
172 70256 : CALL timestop(handle)
173 70256 : 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 5792 : SUBROUTINE cp_result_retain(results)
183 : TYPE(cp_result_type), INTENT(INOUT) :: results
184 :
185 5792 : CPASSERT(results%ref_count > 0)
186 5792 : results%ref_count = results%ref_count + 1
187 5792 : 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 169148 : 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 169148 : CALL timeset(routineN, handle)
202 169148 : ALLOCATE (value)
203 169148 : CALL timestop(handle)
204 169148 : 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 44764 : 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 44764 : CALL timeset(routineN, handle)
222 44764 : value%type_in_use = type_in_use
223 44764 : SELECT CASE (value%type_in_use)
224 : CASE (result_type_real)
225 134292 : 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 44764 : CPABORT("Type not implemented in cp_result_type")
232 : END SELECT
233 44764 : CALL timestop(handle)
234 44764 : 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 169148 : 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 169148 : CALL timeset(routineN, handle)
249 169148 : IF (ASSOCIATED(value)) THEN
250 338296 : SELECT CASE (value%type_in_use)
251 : CASE (result_type_real)
252 169148 : IF (ASSOCIATED(value%real_type)) THEN
253 169148 : DEALLOCATE (value%real_type)
254 : END IF
255 169148 : CPASSERT(.NOT. ASSOCIATED(value%integer_type))
256 169148 : CPASSERT(.NOT. ASSOCIATED(value%logical_type))
257 : CASE (result_type_integer)
258 0 : IF (ASSOCIATED(value%integer_type)) THEN
259 0 : DEALLOCATE (value%integer_type)
260 : END IF
261 0 : CPASSERT(.NOT. ASSOCIATED(value%real_type))
262 0 : CPASSERT(.NOT. ASSOCIATED(value%logical_type))
263 : CASE (result_type_logical)
264 0 : IF (ASSOCIATED(value%logical_type)) THEN
265 0 : DEALLOCATE (value%logical_type)
266 : END IF
267 0 : CPASSERT(.NOT. ASSOCIATED(value%integer_type))
268 0 : CPASSERT(.NOT. ASSOCIATED(value%real_type))
269 : CASE DEFAULT
270 169148 : CPABORT("Type not implemented in cp_result_type")
271 : END SELECT
272 169148 : DEALLOCATE (value)
273 : END IF
274 169148 : CALL timestop(handle)
275 169148 : 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 32300 : 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 32300 : CALL timeset(routineN, handle)
292 32300 : CALL cp_result_clean(results_out)
293 :
294 32300 : check = SIZE(results_in%result_label) == SIZE(results_in%result_value)
295 32300 : CPASSERT(check)
296 32300 : ndim = SIZE(results_in%result_value)
297 76346 : ALLOCATE (results_out%result_label(ndim))
298 112718 : ALLOCATE (results_out%result_value(ndim))
299 68672 : DO i = 1, ndim
300 36372 : results_out%result_label(i) = results_in%result_label(i)
301 36372 : CALL cp_result_value_create(results_out%result_value(i)%value)
302 : CALL cp_result_value_copy(results_out%result_value(i)%value, &
303 68672 : results_in%result_value(i)%value)
304 : END DO
305 32300 : CALL timestop(handle)
306 32300 : 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 124384 : 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 124384 : CALL timeset(routineN, handle)
322 124384 : value_out%type_in_use = value_in%type_in_use
323 124384 : SELECT CASE (value_out%type_in_use)
324 : CASE (result_type_real)
325 124384 : isize = SIZE(value_in%real_type)
326 373152 : ALLOCATE (value_out%real_type(isize))
327 1367655 : value_out%real_type = value_in%real_type
328 : CASE (result_type_integer)
329 0 : isize = SIZE(value_in%integer_type)
330 0 : ALLOCATE (value_out%integer_type(isize))
331 0 : value_out%integer_type = value_in%integer_type
332 : CASE (result_type_logical)
333 0 : isize = SIZE(value_in%logical_type)
334 0 : ALLOCATE (value_out%logical_type(isize))
335 0 : value_out%logical_type = value_in%logical_type
336 : CASE DEFAULT
337 124384 : CPABORT("Type not implemented in cp_result_type")
338 : END SELECT
339 124384 : CALL timestop(handle)
340 124384 : 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 44266 : 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 44266 : POINTER :: tmp_value
359 :
360 44266 : CALL timeset(routineN, handle)
361 44266 : ub_size = 0
362 44266 : lb_size = 0
363 44266 : IF (ASSOCIATED(result_value)) THEN
364 44266 : ub_size = UBOUND(result_value, 1)
365 44266 : lb_size = LBOUND(result_value, 1)
366 : END IF
367 : ! Allocate and copy new values while releases old
368 273380 : ALLOCATE (tmp_value(istart:iend))
369 140582 : DO i = istart, iend
370 96316 : NULLIFY (tmp_value(i)%value)
371 96316 : CALL cp_result_value_create(tmp_value(i)%value)
372 140582 : IF ((i <= ub_size) .AND. (i >= lb_size)) THEN
373 52050 : CALL cp_result_value_copy(tmp_value(i)%value, result_value(i)%value)
374 52050 : CALL cp_result_value_release(result_value(i)%value)
375 : END IF
376 : END DO
377 44266 : DEALLOCATE (result_value)
378 44266 : result_value => tmp_value
379 44266 : CALL timestop(handle)
380 44266 : END SUBROUTINE cp_result_value_p_reallocate
381 :
382 0 : END MODULE cp_result_types
|
