(git:374b731)
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-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! **************************************************************************************************
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 .LE. 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 .LE. 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 ! Type not implemented in cp_result_type
334 cpabort("")
335 END SELECT
336 EXIT
337 END IF
338 END DO
339 END IF
340 IF (PRESENT(type_in_use)) THEN
341 DO i = 1, nlist
342 IF (trim(results%result_label(i)) == trim(description)) THEN
343 type_in_use = results%result_value(i)%value%type_in_use
344 EXIT
345 END IF
346 END DO
347 END IF
348 END SUBROUTINE get_nreps
349
350! **************************************************************************************************
351!> \brief erase a part of result_list
352!> \param results ...
353!> \param description ...
354!> \param nval : if more than one entry for a given description is given you may choose
355!> which entry you want to delete
356!> \par History
357!> 12.2007 created
358!> 10.2008 Teodoro Laino [tlaino] - major rewriting
359!> \author fschiff
360! **************************************************************************************************
361 SUBROUTINE cp_results_erase(results, description, nval)
362 TYPE(cp_result_type), POINTER :: results
363 CHARACTER(LEN=default_string_length), INTENT(IN), &
364 OPTIONAL :: description
365 INTEGER, INTENT(IN), OPTIONAL :: nval
366
367 INTEGER :: entry_deleted, i, k, new_size, nlist, &
368 nrep
369 TYPE(cp_result_type), POINTER :: clean_results
370
371 cpassert(ASSOCIATED(results))
372 new_size = 0
373 IF (PRESENT(description)) THEN
374 cpassert(description(1:1) == '[')
375 nlist = SIZE(results%result_value)
376 nrep = 0
377 DO i = 1, nlist
378 IF (trim(results%result_label(i)) == trim(description)) nrep = nrep + 1
379 END DO
380 IF (nrep .NE. 0) THEN
381 k = 0
382 entry_deleted = 0
383 DO i = 1, nlist
384 IF (trim(results%result_label(i)) == trim(description)) THEN
385 k = k + 1
386 IF (PRESENT(nval)) THEN
387 IF (nval == k) THEN
388 entry_deleted = entry_deleted + 1
389 EXIT
390 END IF
391 ELSE
392 entry_deleted = entry_deleted + 1
393 END IF
394 END IF
395 END DO
396 cpassert(nlist - entry_deleted >= 0)
397 new_size = nlist - entry_deleted
398 NULLIFY (clean_results)
399 CALL cp_result_create(clean_results)
400 CALL cp_result_clean(clean_results)
401 ALLOCATE (clean_results%result_label(new_size))
402 ALLOCATE (clean_results%result_value(new_size))
403 DO i = 1, new_size
404 NULLIFY (clean_results%result_value(i)%value)
405 CALL cp_result_value_create(clean_results%result_value(i)%value)
406 END DO
407 k = 0
408 DO i = 1, nlist
409 IF (trim(results%result_label(i)) /= trim(description)) THEN
410 k = k + 1
411 clean_results%result_label(k) = results%result_label(i)
412 CALL cp_result_value_copy(clean_results%result_value(k)%value, &
413 results%result_value(i)%value)
414 END IF
415 END DO
416 CALL cp_result_copy(clean_results, results)
417 CALL cp_result_release(clean_results)
418 END IF
419 ELSE
420 CALL cp_result_clean(results)
421 ALLOCATE (results%result_label(new_size))
422 ALLOCATE (results%result_value(new_size))
423 END IF
424 END SUBROUTINE cp_results_erase
425
426! **************************************************************************************************
427!> \brief broadcast results type
428!> \param results ...
429!> \param source ...
430!> \param para_env ...
431!> \author 10.2008 Teodoro Laino [tlaino] - University of Zurich
432! **************************************************************************************************
433 SUBROUTINE cp_results_mp_bcast(results, source, para_env)
434 TYPE(cp_result_type), POINTER :: results
435 INTEGER, INTENT(IN) :: source
436 TYPE(mp_para_env_type), POINTER :: para_env
437
438 INTEGER :: i, nlist
439 INTEGER, ALLOCATABLE, DIMENSION(:) :: size_value, type_in_use
440
441 cpassert(ASSOCIATED(results))
442 nlist = 0
443 IF (para_env%mepos == source) nlist = SIZE(results%result_value)
444 CALL para_env%bcast(nlist, source)
445
446 ALLOCATE (size_value(nlist))
447 ALLOCATE (type_in_use(nlist))
448 IF (para_env%mepos == source) THEN
449 DO i = 1, nlist
450 CALL get_nreps(results, description=results%result_label(i), &
451 n_entries=size_value(i), type_in_use=type_in_use(i))
452 END DO
453 END IF
454 CALL para_env%bcast(size_value, source)
455 CALL para_env%bcast(type_in_use, source)
456
457 IF (para_env%mepos /= source) THEN
458 CALL cp_result_clean(results)
459 ALLOCATE (results%result_value(nlist))
460 ALLOCATE (results%result_label(nlist))
461 DO i = 1, nlist
462 results%result_label(i) = ""
463 NULLIFY (results%result_value(i)%value)
464 CALL cp_result_value_create(results%result_value(i)%value)
465 CALL cp_result_value_init(results%result_value(i)%value, &
466 type_in_use=type_in_use(i), size_value=size_value(i))
467 END DO
468 END IF
469 DO i = 1, nlist
470 CALL para_env%bcast(results%result_label(i), source)
471 SELECT CASE (results%result_value(i)%value%type_in_use)
472 CASE (result_type_real)
473 CALL para_env%bcast(results%result_value(i)%value%real_type, source)
474 CASE (result_type_integer)
475 CALL para_env%bcast(results%result_value(i)%value%integer_type, source)
476 CASE (result_type_logical)
477 CALL para_env%bcast(results%result_value(i)%value%logical_type, source)
478 CASE DEFAULT
479 cpabort("Type not implemented in cp_result_type")
480 END SELECT
481 END DO
482 DEALLOCATE (type_in_use)
483 DEALLOCATE (size_value)
484 END SUBROUTINE cp_results_mp_bcast
485
486END 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:434
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:362
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:286
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: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
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:763