(git:39fe4c4)
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) &
182 CALL cp_abort(__location__, &
183 " Trying to access result ("//trim(description)//") which was never stored!")
184
185 DO i = 1, nlist
186 IF (trim(results%result_label(i)) == trim(description)) THEN
187 IF (results%result_value(i)%value%type_in_use /= result_type_real) &
188 cpabort("Attempt to retrieve a RESULT which is not a REAL!")
189
190 size_res = SIZE(results%result_value(i)%value%real_type)
191 EXIT
192 END IF
193 END DO
194 IF (PRESENT(n_entries)) n_entries = size_res
195 size_values = SIZE(values, 1)
196 IF (PRESENT(nval)) THEN
197 cpassert(size_res == size_values)
198 ELSE
199 cpassert(nrep*size_res == size_values)
200 END IF
201 k = 0
202 DO i = 1, nlist
203 IF (trim(results%result_label(i)) == trim(description)) THEN
204 k = k + 1
205 IF (PRESENT(nval)) THEN
206 IF (k == nval) THEN
207 values = results%result_value(i)%value%real_type
208 EXIT
209 END IF
210 ELSE
211 values((k - 1)*size_res + 1:k*size_res) = results%result_value(i)%value%real_type
212 END IF
213 END IF
214 END DO
215
216 END SUBROUTINE get_result_r1
217
218! **************************************************************************************************
219!> \brief gets the required part out of the result_list
220!> \param results ...
221!> \param description ...
222!> \param values ...
223!> \param nval : if more than one entry for a given description is given you may choose
224!> which entry you want
225!> \param n_rep : integer indicating how many times the section exists in result_list
226!> \param n_entries : gets the number of lines used for a given description
227!> \par History
228!> 12.2007 created
229!> 10.2008 Teodoro Laino [tlaino] - major rewriting
230!> \author fschiff
231! **************************************************************************************************
232 SUBROUTINE get_result_r2(results, description, values, nval, n_rep, n_entries)
233 TYPE(cp_result_type), POINTER :: results
234 CHARACTER(LEN=default_string_length), INTENT(IN) :: description
235 REAL(KIND=dp), DIMENSION(:, :), INTENT(OUT) :: values
236 INTEGER, INTENT(IN), OPTIONAL :: nval
237 INTEGER, INTENT(OUT), OPTIONAL :: n_rep, n_entries
238
239 INTEGER :: i, k, nlist, nrep, size_res, size_values
240
241 cpassert(ASSOCIATED(results))
242 nlist = SIZE(results%result_value)
243 cpassert(description(1:1) == '[')
244 cpassert(SIZE(results%result_label) == nlist)
245 nrep = 0
246 DO i = 1, nlist
247 IF (trim(results%result_label(i)) == trim(description)) nrep = nrep + 1
248 END DO
249
250 IF (PRESENT(n_rep)) THEN
251 n_rep = nrep
252 END IF
253
254 IF (nrep <= 0) &
255 CALL cp_abort(__location__, &
256 " Trying to access result ("//trim(description)//") which was never stored!")
257
258 DO i = 1, nlist
259 IF (trim(results%result_label(i)) == trim(description)) THEN
260 IF (results%result_value(i)%value%type_in_use /= result_type_real) &
261 cpabort("Attempt to retrieve a RESULT which is not a REAL!")
262
263 size_res = SIZE(results%result_value(i)%value%real_type)
264 EXIT
265 END IF
266 END DO
267 IF (PRESENT(n_entries)) n_entries = size_res
268 size_values = SIZE(values, 1)*SIZE(values, 2)
269 IF (PRESENT(nval)) THEN
270 cpassert(size_res == size_values)
271 ELSE
272 cpassert(nrep*size_res == size_values)
273 END IF
274 k = 0
275 DO i = 1, nlist
276 IF (trim(results%result_label(i)) == trim(description)) THEN
277 k = k + 1
278 IF (PRESENT(nval)) THEN
279 IF (k == nval) THEN
280 values = reshape(results%result_value(i)%value%real_type, [SIZE(values, 1), SIZE(values, 2)])
281 EXIT
282 END IF
283 ELSE
284 values((k - 1)*size_res + 1:k*size_res, :) = reshape(results%result_value(i)%value%real_type, &
285 [SIZE(values, 1), SIZE(values, 2)])
286 END IF
287 END IF
288 END DO
289
290 END SUBROUTINE get_result_r2
291
292! **************************************************************************************************
293!> \brief gets the required part out of the result_list
294!> \param results ...
295!> \param description ...
296!> \param n_rep : integer indicating how many times the section exists in result_list
297!> \param n_entries : gets the number of lines used for a given description
298!> \param type_in_use ...
299!> \par History
300!> 12.2007 created
301!> 10.2008 Teodoro Laino [tlaino] - major rewriting
302!> \author fschiff
303! **************************************************************************************************
304 SUBROUTINE get_nreps(results, description, n_rep, n_entries, type_in_use)
305 TYPE(cp_result_type), POINTER :: results
306 CHARACTER(LEN=default_string_length), INTENT(IN) :: description
307 INTEGER, INTENT(OUT), OPTIONAL :: n_rep, n_entries, type_in_use
308
309 INTEGER :: I, nlist
310
311 cpassert(ASSOCIATED(results))
312 nlist = SIZE(results%result_value)
313 cpassert(description(1:1) == '[')
314 cpassert(SIZE(results%result_label) == nlist)
315 IF (PRESENT(n_rep)) THEN
316 n_rep = 0
317 DO i = 1, nlist
318 IF (trim(results%result_label(i)) == trim(description)) n_rep = n_rep + 1
319 END DO
320 END IF
321 IF (PRESENT(n_entries)) THEN
322 n_entries = 0
323 DO i = 1, nlist
324 IF (trim(results%result_label(i)) == trim(description)) THEN
325 SELECT CASE (results%result_value(i)%value%type_in_use)
326 CASE (result_type_real)
327 n_entries = n_entries + SIZE(results%result_value(i)%value%real_type)
328 CASE (result_type_integer)
329 n_entries = n_entries + SIZE(results%result_value(i)%value%integer_type)
330 CASE (result_type_logical)
331 n_entries = n_entries + SIZE(results%result_value(i)%value%logical_type)
332 CASE DEFAULT
333 cpabort("Type not implemented in cp_result_type")
334 END SELECT
335 EXIT
336 END IF
337 END DO
338 END IF
339 IF (PRESENT(type_in_use)) THEN
340 DO i = 1, nlist
341 IF (trim(results%result_label(i)) == trim(description)) THEN
342 type_in_use = results%result_value(i)%value%type_in_use
343 EXIT
344 END IF
345 END DO
346 END IF
347 END SUBROUTINE get_nreps
348
349! **************************************************************************************************
350!> \brief erase a part of result_list
351!> \param results ...
352!> \param description ...
353!> \param nval : if more than one entry for a given description is given you may choose
354!> which entry you want to delete
355!> \par History
356!> 12.2007 created
357!> 10.2008 Teodoro Laino [tlaino] - major rewriting
358!> \author fschiff
359! **************************************************************************************************
360 SUBROUTINE cp_results_erase(results, description, nval)
361 TYPE(cp_result_type), POINTER :: results
362 CHARACTER(LEN=default_string_length), INTENT(IN), &
363 OPTIONAL :: description
364 INTEGER, INTENT(IN), OPTIONAL :: nval
365
366 INTEGER :: entry_deleted, i, k, new_size, nlist, &
367 nrep
368 TYPE(cp_result_type), POINTER :: clean_results
369
370 cpassert(ASSOCIATED(results))
371 new_size = 0
372 IF (PRESENT(description)) THEN
373 cpassert(description(1:1) == '[')
374 nlist = SIZE(results%result_value)
375 nrep = 0
376 DO i = 1, nlist
377 IF (trim(results%result_label(i)) == trim(description)) nrep = nrep + 1
378 END DO
379 IF (nrep /= 0) THEN
380 k = 0
381 entry_deleted = 0
382 DO i = 1, nlist
383 IF (trim(results%result_label(i)) == trim(description)) THEN
384 k = k + 1
385 IF (PRESENT(nval)) THEN
386 IF (nval == k) THEN
387 entry_deleted = entry_deleted + 1
388 EXIT
389 END IF
390 ELSE
391 entry_deleted = entry_deleted + 1
392 END IF
393 END IF
394 END DO
395 cpassert(nlist - entry_deleted >= 0)
396 new_size = nlist - entry_deleted
397 NULLIFY (clean_results)
398 CALL cp_result_create(clean_results)
399 CALL cp_result_clean(clean_results)
400 ALLOCATE (clean_results%result_label(new_size))
401 ALLOCATE (clean_results%result_value(new_size))
402 DO i = 1, new_size
403 NULLIFY (clean_results%result_value(i)%value)
404 CALL cp_result_value_create(clean_results%result_value(i)%value)
405 END DO
406 k = 0
407 DO i = 1, nlist
408 IF (trim(results%result_label(i)) /= trim(description)) THEN
409 k = k + 1
410 clean_results%result_label(k) = results%result_label(i)
411 CALL cp_result_value_copy(clean_results%result_value(k)%value, &
412 results%result_value(i)%value)
413 END IF
414 END DO
415 CALL cp_result_copy(clean_results, results)
416 CALL cp_result_release(clean_results)
417 END IF
418 ELSE
419 CALL cp_result_clean(results)
420 ALLOCATE (results%result_label(new_size))
421 ALLOCATE (results%result_value(new_size))
422 END IF
423 END SUBROUTINE cp_results_erase
424
425! **************************************************************************************************
426!> \brief broadcast results type
427!> \param results ...
428!> \param source ...
429!> \param para_env ...
430!> \author 10.2008 Teodoro Laino [tlaino] - University of Zurich
431! **************************************************************************************************
432 SUBROUTINE cp_results_mp_bcast(results, source, para_env)
433 TYPE(cp_result_type), POINTER :: results
434 INTEGER, INTENT(IN) :: source
435 TYPE(mp_para_env_type), POINTER :: para_env
436
437 INTEGER :: i, nlist
438 INTEGER, ALLOCATABLE, DIMENSION(:) :: size_value, type_in_use
439
440 cpassert(ASSOCIATED(results))
441 nlist = 0
442 IF (para_env%mepos == source) nlist = SIZE(results%result_value)
443 CALL para_env%bcast(nlist, source)
444
445 ALLOCATE (size_value(nlist))
446 ALLOCATE (type_in_use(nlist))
447 IF (para_env%mepos == source) THEN
448 DO i = 1, nlist
449 CALL get_nreps(results, description=results%result_label(i), &
450 n_entries=size_value(i), type_in_use=type_in_use(i))
451 END DO
452 END IF
453 CALL para_env%bcast(size_value, source)
454 CALL para_env%bcast(type_in_use, source)
455
456 IF (para_env%mepos /= source) THEN
457 CALL cp_result_clean(results)
458 ALLOCATE (results%result_value(nlist))
459 ALLOCATE (results%result_label(nlist))
460 DO i = 1, nlist
461 results%result_label(i) = ""
462 NULLIFY (results%result_value(i)%value)
463 CALL cp_result_value_create(results%result_value(i)%value)
464 CALL cp_result_value_init(results%result_value(i)%value, &
465 type_in_use=type_in_use(i), size_value=size_value(i))
466 END DO
467 END IF
468 DO i = 1, nlist
469 CALL para_env%bcast(results%result_label(i), source)
470 SELECT CASE (results%result_value(i)%value%type_in_use)
471 CASE (result_type_real)
472 CALL para_env%bcast(results%result_value(i)%value%real_type, source)
473 CASE (result_type_integer)
474 CALL para_env%bcast(results%result_value(i)%value%integer_type, source)
475 CASE (result_type_logical)
476 CALL para_env%bcast(results%result_value(i)%value%logical_type, source)
477 CASE DEFAULT
478 cpabort("Type not implemented in cp_result_type")
479 END SELECT
480 END DO
481 DEALLOCATE (type_in_use)
482 DEALLOCATE (size_value)
483 END SUBROUTINE cp_results_mp_bcast
484
485END 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:433
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:361
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:23
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:743