(git:d2a9ebd)
Loading...
Searching...
No Matches
cp_result_methods.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! **************************************************************************************************
17MODULE cp_result_methods
18 USE cp_result_types, ONLY: &
19 cp_result_clean, cp_result_copy, cp_result_create, cp_result_release, cp_result_type, &
20 cp_result_value_copy, cp_result_value_create, cp_result_value_init, &
21 cp_result_value_p_reallocate, result_type_integer, result_type_logical, result_type_real
22 USE kinds, ONLY: default_string_length,&
23 dp
24 USE memory_utilities, ONLY: reallocate
25 USE message_passing, ONLY: mp_para_env_type
26#include "../base/base_uses.f90"
27
28 IMPLICIT NONE
29 PRIVATE
30
31 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_result_methods'
32
33 PUBLIC :: put_results, &
34 test_for_result, &
35 get_results, &
36 cp_results_erase, &
37 cp_results_mp_bcast
38
39 INTERFACE put_results
40 MODULE PROCEDURE put_result_r1, put_result_r2
41 END INTERFACE
42
43 INTERFACE get_results
44 MODULE PROCEDURE get_result_r1, get_result_r2, get_nreps
45 END INTERFACE
46
47CONTAINS
48
49! **************************************************************************************************
50!> \brief Store a 1D array of reals in result_list
51!> \param results ...
52!> \param description ...
53!> \param values ...
54!> \par History
55!> 12.2007 created
56!> 10.2008 Teodoro Laino [tlaino] - major rewriting
57!> \author fschiff
58! **************************************************************************************************
59 SUBROUTINE put_result_r1(results, description, values)
60 TYPE(cp_result_type), POINTER :: results
61 CHARACTER(LEN=default_string_length), INTENT(IN) :: description
62 REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: values
63
64 INTEGER :: isize, jsize
65 LOGICAL :: check
66
67 cpassert(ASSOCIATED(results))
68 cpassert(description(1:1) == '[')
69 check = SIZE(results%result_label) == SIZE(results%result_value)
70 cpassert(check)
71 isize = SIZE(results%result_label)
72 jsize = SIZE(values)
73
74 CALL reallocate(results%result_label, 1, isize + 1)
75 CALL cp_result_value_p_reallocate(results%result_value, 1, isize + 1)
76
77 results%result_label(isize + 1) = description
78 CALL cp_result_value_init(results%result_value(isize + 1)%value, result_type_real, jsize)
79 results%result_value(isize + 1)%value%real_type = values
80
81 END SUBROUTINE put_result_r1
82
83! **************************************************************************************************
84!> \brief Store a 2D array of reals in result_list
85!> \param results ...
86!> \param description ...
87!> \param values ...
88!> \par History
89!> 12.2007 created
90!> 10.2008 Teodoro Laino [tlaino] - major rewriting
91!> \author fschiff
92! **************************************************************************************************
93 SUBROUTINE put_result_r2(results, description, values)
94 TYPE(cp_result_type), POINTER :: results
95 CHARACTER(LEN=default_string_length), INTENT(IN) :: description
96 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: values
97
98 INTEGER :: isize, jsize
99 LOGICAL :: check
100
101 cpassert(ASSOCIATED(results))
102 cpassert(description(1:1) == '[')
103 check = SIZE(results%result_label) == SIZE(results%result_value)
104 cpassert(check)
105 isize = SIZE(results%result_label)
106 jsize = SIZE(values, 1)*SIZE(values, 2)
107
108 CALL reallocate(results%result_label, 1, isize + 1)
109 CALL cp_result_value_p_reallocate(results%result_value, 1, isize + 1)
110
111 results%result_label(isize + 1) = description
112 CALL cp_result_value_init(results%result_value(isize + 1)%value, result_type_real, jsize)
113 results%result_value(isize + 1)%value%real_type = reshape(values, [jsize])
114
115 END SUBROUTINE put_result_r2
116
117! **************************************************************************************************
118!> \brief test for a certain result in the result_list
119!> \param results ...
120!> \param description ...
121!> \return ...
122!> \par History
123!> 10.2013
124!> \author Mandes
125! **************************************************************************************************
126 FUNCTION test_for_result(results, description) RESULT(res_exist)
127 TYPE(cp_result_type), POINTER :: results
128 CHARACTER(LEN=default_string_length), INTENT(IN) :: description
129 LOGICAL :: res_exist
130
131 INTEGER :: i, nlist
132
133 cpassert(ASSOCIATED(results))
134 nlist = SIZE(results%result_value)
135 res_exist = .false.
136 DO i = 1, nlist
137 IF (trim(results%result_label(i)) == trim(description)) THEN
138 res_exist = .true.
139 EXIT
140 END IF
141 END DO
142
143 END FUNCTION test_for_result
144
145! **************************************************************************************************
146!> \brief gets the required part out of the result_list
147!> \param results ...
148!> \param description ...
149!> \param values ...
150!> \param nval : if more than one entry for a given description is given you may choose
151!> which entry you want
152!> \param n_rep : integer indicating how many times the section exists in result_list
153!> \param n_entries : gets the number of lines used for a given description
154!> \par History
155!> 12.2007 created
156!> 10.2008 Teodoro Laino [tlaino] - major rewriting
157!> \author fschiff
158! **************************************************************************************************
159 SUBROUTINE get_result_r1(results, description, values, nval, n_rep, n_entries)
160 TYPE(cp_result_type), POINTER :: results
161 CHARACTER(LEN=default_string_length), INTENT(IN) :: description
162 REAL(KIND=dp), DIMENSION(:), INTENT(OUT) :: values
163 INTEGER, INTENT(IN), OPTIONAL :: nval
164 INTEGER, INTENT(OUT), OPTIONAL :: n_rep, n_entries
165
166 INTEGER :: i, k, nlist, nrep, size_res, size_values
167
168 cpassert(ASSOCIATED(results))
169 nlist = SIZE(results%result_value)
170 cpassert(description(1:1) == '[')
171 cpassert(SIZE(results%result_label) == nlist)
172 nrep = 0
173 DO i = 1, nlist
174 IF (trim(results%result_label(i)) == trim(description)) nrep = nrep + 1
175 END DO
176
177 IF (PRESENT(n_rep)) THEN
178 n_rep = nrep
179 END IF
180
181 IF (nrep <= 0) THEN
182 CALL cp_abort(__location__, &
183 " Trying to access result ("//trim(description)//") which was never stored!")
184 END IF
185
186 DO i = 1, nlist
187 IF (trim(results%result_label(i)) == trim(description)) THEN
188 IF (results%result_value(i)%value%type_in_use /= result_type_real) THEN
189 cpabort("Attempt to retrieve a RESULT which is not a REAL!")
190 END IF
191
192 size_res = SIZE(results%result_value(i)%value%real_type)
193 EXIT
194 END IF
195 END DO
196 IF (PRESENT(n_entries)) n_entries = size_res
197 size_values = SIZE(values, 1)
198 IF (PRESENT(nval)) THEN
199 cpassert(size_res == size_values)
200 ELSE
201 cpassert(nrep*size_res == size_values)
202 END IF
203 k = 0
204 DO i = 1, nlist
205 IF (trim(results%result_label(i)) == trim(description)) THEN
206 k = k + 1
207 IF (PRESENT(nval)) THEN
208 IF (k == nval) THEN
209 values = results%result_value(i)%value%real_type
210 EXIT
211 END IF
212 ELSE
213 values((k - 1)*size_res + 1:k*size_res) = results%result_value(i)%value%real_type
214 END IF
215 END IF
216 END DO
217
218 END SUBROUTINE get_result_r1
219
220! **************************************************************************************************
221!> \brief gets the required part out of the result_list
222!> \param results ...
223!> \param description ...
224!> \param values ...
225!> \param nval : if more than one entry for a given description is given you may choose
226!> which entry you want
227!> \param n_rep : integer indicating how many times the section exists in result_list
228!> \param n_entries : gets the number of lines used for a given description
229!> \par History
230!> 12.2007 created
231!> 10.2008 Teodoro Laino [tlaino] - major rewriting
232!> \author fschiff
233! **************************************************************************************************
234 SUBROUTINE get_result_r2(results, description, values, nval, n_rep, n_entries)
235 TYPE(cp_result_type), POINTER :: results
236 CHARACTER(LEN=default_string_length), INTENT(IN) :: description
237 REAL(KIND=dp), DIMENSION(:, :), INTENT(OUT) :: values
238 INTEGER, INTENT(IN), OPTIONAL :: nval
239 INTEGER, INTENT(OUT), OPTIONAL :: n_rep, n_entries
240
241 INTEGER :: i, k, nlist, nrep, size_res, size_values
242
243 cpassert(ASSOCIATED(results))
244 nlist = SIZE(results%result_value)
245 cpassert(description(1:1) == '[')
246 cpassert(SIZE(results%result_label) == nlist)
247 nrep = 0
248 DO i = 1, nlist
249 IF (trim(results%result_label(i)) == trim(description)) nrep = nrep + 1
250 END DO
251
252 IF (PRESENT(n_rep)) THEN
253 n_rep = nrep
254 END IF
255
256 IF (nrep <= 0) THEN
257 CALL cp_abort(__location__, &
258 " Trying to access result ("//trim(description)//") which was never stored!")
259 END IF
260
261 DO i = 1, nlist
262 IF (trim(results%result_label(i)) == trim(description)) THEN
263 IF (results%result_value(i)%value%type_in_use /= result_type_real) THEN
264 cpabort("Attempt to retrieve a RESULT which is not a REAL!")
265 END IF
266
267 size_res = SIZE(results%result_value(i)%value%real_type)
268 EXIT
269 END IF
270 END DO
271 IF (PRESENT(n_entries)) n_entries = size_res
272 size_values = SIZE(values, 1)*SIZE(values, 2)
273 IF (PRESENT(nval)) THEN
274 cpassert(size_res == size_values)
275 ELSE
276 cpassert(nrep*size_res == size_values)
277 END IF
278 k = 0
279 DO i = 1, nlist
280 IF (trim(results%result_label(i)) == trim(description)) THEN
281 k = k + 1
282 IF (PRESENT(nval)) THEN
283 IF (k == nval) THEN
284 values = reshape(results%result_value(i)%value%real_type, [SIZE(values, 1), SIZE(values, 2)])
285 EXIT
286 END IF
287 ELSE
288 values((k - 1)*size_res + 1:k*size_res, :) = reshape(results%result_value(i)%value%real_type, &
289 [SIZE(values, 1), SIZE(values, 2)])
290 END IF
291 END IF
292 END DO
293
294 END SUBROUTINE get_result_r2
295
296! **************************************************************************************************
297!> \brief gets the required part out of the result_list
298!> \param results ...
299!> \param description ...
300!> \param n_rep : integer indicating how many times the section exists in result_list
301!> \param n_entries : gets the number of lines used for a given description
302!> \param type_in_use ...
303!> \par History
304!> 12.2007 created
305!> 10.2008 Teodoro Laino [tlaino] - major rewriting
306!> \author fschiff
307! **************************************************************************************************
308 SUBROUTINE get_nreps(results, description, n_rep, n_entries, type_in_use)
309 TYPE(cp_result_type), POINTER :: results
310 CHARACTER(LEN=default_string_length), INTENT(IN) :: description
311 INTEGER, INTENT(OUT), OPTIONAL :: n_rep, n_entries, type_in_use
312
313 INTEGER :: I, nlist
314
315 cpassert(ASSOCIATED(results))
316 nlist = SIZE(results%result_value)
317 cpassert(description(1:1) == '[')
318 cpassert(SIZE(results%result_label) == nlist)
319 IF (PRESENT(n_rep)) THEN
320 n_rep = 0
321 DO i = 1, nlist
322 IF (trim(results%result_label(i)) == trim(description)) n_rep = n_rep + 1
323 END DO
324 END IF
325 IF (PRESENT(n_entries)) THEN
326 n_entries = 0
327 DO i = 1, nlist
328 IF (trim(results%result_label(i)) == trim(description)) THEN
329 SELECT CASE (results%result_value(i)%value%type_in_use)
330 CASE (result_type_real)
331 n_entries = n_entries + SIZE(results%result_value(i)%value%real_type)
332 CASE (result_type_integer)
333 n_entries = n_entries + SIZE(results%result_value(i)%value%integer_type)
334 CASE (result_type_logical)
335 n_entries = n_entries + SIZE(results%result_value(i)%value%logical_type)
336 CASE DEFAULT
337 cpabort("Type not implemented in cp_result_type")
338 END SELECT
339 EXIT
340 END IF
341 END DO
342 END IF
343 IF (PRESENT(type_in_use)) THEN
344 DO i = 1, nlist
345 IF (trim(results%result_label(i)) == trim(description)) THEN
346 type_in_use = results%result_value(i)%value%type_in_use
347 EXIT
348 END IF
349 END DO
350 END IF
351 END SUBROUTINE get_nreps
352
353! **************************************************************************************************
354!> \brief erase a part of result_list
355!> \param results ...
356!> \param description ...
357!> \param nval : if more than one entry for a given description is given you may choose
358!> which entry you want to delete
359!> \par History
360!> 12.2007 created
361!> 10.2008 Teodoro Laino [tlaino] - major rewriting
362!> \author fschiff
363! **************************************************************************************************
364 SUBROUTINE cp_results_erase(results, description, nval)
365 TYPE(cp_result_type), POINTER :: results
366 CHARACTER(LEN=default_string_length), INTENT(IN), &
367 OPTIONAL :: description
368 INTEGER, INTENT(IN), OPTIONAL :: nval
369
370 INTEGER :: entry_deleted, i, k, new_size, nlist, &
371 nrep
372 TYPE(cp_result_type), POINTER :: clean_results
373
374 cpassert(ASSOCIATED(results))
375 new_size = 0
376 IF (PRESENT(description)) THEN
377 cpassert(description(1:1) == '[')
378 nlist = SIZE(results%result_value)
379 nrep = 0
380 DO i = 1, nlist
381 IF (trim(results%result_label(i)) == trim(description)) nrep = nrep + 1
382 END DO
383 IF (nrep /= 0) THEN
384 k = 0
385 entry_deleted = 0
386 DO i = 1, nlist
387 IF (trim(results%result_label(i)) == trim(description)) THEN
388 k = k + 1
389 IF (PRESENT(nval)) THEN
390 IF (nval == k) THEN
391 entry_deleted = entry_deleted + 1
392 EXIT
393 END IF
394 ELSE
395 entry_deleted = entry_deleted + 1
396 END IF
397 END IF
398 END DO
399 cpassert(nlist - entry_deleted >= 0)
400 new_size = nlist - entry_deleted
401 NULLIFY (clean_results)
402 CALL cp_result_create(clean_results)
403 CALL cp_result_clean(clean_results)
404 ALLOCATE (clean_results%result_label(new_size))
405 ALLOCATE (clean_results%result_value(new_size))
406 DO i = 1, new_size
407 NULLIFY (clean_results%result_value(i)%value)
408 CALL cp_result_value_create(clean_results%result_value(i)%value)
409 END DO
410 k = 0
411 DO i = 1, nlist
412 IF (trim(results%result_label(i)) /= trim(description)) THEN
413 k = k + 1
414 clean_results%result_label(k) = results%result_label(i)
415 CALL cp_result_value_copy(clean_results%result_value(k)%value, &
416 results%result_value(i)%value)
417 END IF
418 END DO
419 CALL cp_result_copy(clean_results, results)
420 CALL cp_result_release(clean_results)
421 END IF
422 ELSE
423 CALL cp_result_clean(results)
424 ALLOCATE (results%result_label(new_size))
425 ALLOCATE (results%result_value(new_size))
426 END IF
427 END SUBROUTINE cp_results_erase
428
429! **************************************************************************************************
430!> \brief broadcast results type
431!> \param results ...
432!> \param source ...
433!> \param para_env ...
434!> \author 10.2008 Teodoro Laino [tlaino] - University of Zurich
435! **************************************************************************************************
436 SUBROUTINE cp_results_mp_bcast(results, source, para_env)
437 TYPE(cp_result_type), POINTER :: results
438 INTEGER, INTENT(IN) :: source
439 TYPE(mp_para_env_type), POINTER :: para_env
440
441 INTEGER :: i, nlist
442 INTEGER, ALLOCATABLE, DIMENSION(:) :: size_value, type_in_use
443
444 cpassert(ASSOCIATED(results))
445 nlist = 0
446 IF (para_env%mepos == source) nlist = SIZE(results%result_value)
447 CALL para_env%bcast(nlist, source)
448
449 ALLOCATE (size_value(nlist))
450 ALLOCATE (type_in_use(nlist))
451 IF (para_env%mepos == source) THEN
452 DO i = 1, nlist
453 CALL get_nreps(results, description=results%result_label(i), &
454 n_entries=size_value(i), type_in_use=type_in_use(i))
455 END DO
456 END IF
457 CALL para_env%bcast(size_value, source)
458 CALL para_env%bcast(type_in_use, source)
459
460 IF (para_env%mepos /= source) THEN
461 CALL cp_result_clean(results)
462 ALLOCATE (results%result_value(nlist))
463 ALLOCATE (results%result_label(nlist))
464 DO i = 1, nlist
465 results%result_label(i) = ""
466 NULLIFY (results%result_value(i)%value)
467 CALL cp_result_value_create(results%result_value(i)%value)
468 CALL cp_result_value_init(results%result_value(i)%value, &
469 type_in_use=type_in_use(i), size_value=size_value(i))
470 END DO
471 END IF
472 DO i = 1, nlist
473 CALL para_env%bcast(results%result_label(i), source)
474 SELECT CASE (results%result_value(i)%value%type_in_use)
475 CASE (result_type_real)
476 CALL para_env%bcast(results%result_value(i)%value%real_type, source)
477 CASE (result_type_integer)
478 CALL para_env%bcast(results%result_value(i)%value%integer_type, source)
479 CASE (result_type_logical)
480 CALL para_env%bcast(results%result_value(i)%value%logical_type, source)
481 CASE DEFAULT
482 cpabort("Type not implemented in cp_result_type")
483 END SELECT
484 END DO
485 DEALLOCATE (type_in_use)
486 DEALLOCATE (size_value)
487 END SUBROUTINE cp_results_mp_bcast
488
489END MODULE cp_result_methods
cp_result_methods::get_results
Definition cp_result_methods.F:43
cp_result_methods::put_results
Definition cp_result_methods.F:39
memory_utilities::reallocate
Definition memory_utilities.F:27
cp_result_methods
set of type/routines to handle the storage of results in force_envs
Definition cp_result_methods.F:17
cp_result_methods::cp_results_mp_bcast
subroutine, public cp_results_mp_bcast(results, source, para_env)
broadcast results type
Definition cp_result_methods.F:437
cp_result_methods::cp_results_erase
subroutine, public cp_results_erase(results, description, nval)
erase a part of result_list
Definition cp_result_methods.F:365
cp_result_methods::test_for_result
logical function, public test_for_result(results, description)
test for a certain result in the result_list
Definition cp_result_methods.F:127
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_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
memory_utilities
Utility routines for the memory handling.
Definition memory_utilities.F:14
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:25
cp_result_types::cp_result_type
contains arbitrary information which need to be stored
Definition cp_result_types.F:73
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:759