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 : ! **************************************************************************************************
17 : MODULE 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 :
47 : CONTAINS
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 39094 : 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 39094 : CPASSERT(ASSOCIATED(results))
68 39094 : CPASSERT(description(1:1) == '[')
69 39094 : check = SIZE(results%result_label) == SIZE(results%result_value)
70 39094 : CPASSERT(check)
71 39094 : isize = SIZE(results%result_label)
72 39094 : jsize = SIZE(values)
73 :
74 39094 : CALL reallocate(results%result_label, 1, isize + 1)
75 39094 : CALL cp_result_value_p_reallocate(results%result_value, 1, isize + 1)
76 :
77 39094 : results%result_label(isize + 1) = description
78 39094 : CALL cp_result_value_init(results%result_value(isize + 1)%value, result_type_real, jsize)
79 176308 : results%result_value(isize + 1)%value%real_type = values
80 :
81 39094 : 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 5428 : 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 5428 : CPASSERT(ASSOCIATED(results))
102 5428 : CPASSERT(description(1:1) == '[')
103 5428 : check = SIZE(results%result_label) == SIZE(results%result_value)
104 5428 : CPASSERT(check)
105 5428 : isize = SIZE(results%result_label)
106 5428 : jsize = SIZE(values, 1)*SIZE(values, 2)
107 :
108 5428 : CALL reallocate(results%result_label, 1, isize + 1)
109 5428 : CALL cp_result_value_p_reallocate(results%result_value, 1, isize + 1)
110 :
111 5428 : results%result_label(isize + 1) = description
112 5428 : CALL cp_result_value_init(results%result_value(isize + 1)%value, result_type_real, jsize)
113 174514 : results%result_value(isize + 1)%value%real_type = RESHAPE(values, [jsize])
114 :
115 5428 : 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 25551 : 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 25551 : CPASSERT(ASSOCIATED(results))
134 25551 : nlist = SIZE(results%result_value)
135 25551 : res_exist = .FALSE.
136 36455 : DO i = 1, nlist
137 36455 : IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
138 : res_exist = .TRUE.
139 : EXIT
140 : END IF
141 : END DO
142 :
143 25551 : 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 1765 : 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 1765 : CPASSERT(ASSOCIATED(results))
169 1765 : nlist = SIZE(results%result_value)
170 1765 : CPASSERT(description(1:1) == '[')
171 1765 : CPASSERT(SIZE(results%result_label) == nlist)
172 1765 : nrep = 0
173 4465 : DO i = 1, nlist
174 4465 : IF (TRIM(results%result_label(i)) == TRIM(description)) nrep = nrep + 1
175 : END DO
176 :
177 1765 : IF (PRESENT(n_rep)) THEN
178 0 : n_rep = nrep
179 : END IF
180 :
181 1765 : IF (nrep <= 0) THEN
182 : CALL cp_abort(__LOCATION__, &
183 0 : " Trying to access result ("//TRIM(description)//") which was never stored!")
184 : END IF
185 :
186 2671 : DO i = 1, nlist
187 2671 : IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
188 1765 : IF (results%result_value(i)%value%type_in_use /= result_type_real) THEN
189 0 : CPABORT("Attempt to retrieve a RESULT which is not a REAL!")
190 : END IF
191 :
192 1765 : size_res = SIZE(results%result_value(i)%value%real_type)
193 1765 : EXIT
194 : END IF
195 : END DO
196 1765 : IF (PRESENT(n_entries)) n_entries = size_res
197 1765 : size_values = SIZE(values, 1)
198 1765 : IF (PRESENT(nval)) THEN
199 917 : CPASSERT(size_res == size_values)
200 : ELSE
201 848 : CPASSERT(nrep*size_res == size_values)
202 : END IF
203 : k = 0
204 3519 : DO i = 1, nlist
205 3519 : IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
206 1765 : k = k + 1
207 1765 : IF (PRESENT(nval)) THEN
208 917 : IF (k == nval) THEN
209 3668 : values = results%result_value(i)%value%real_type
210 : EXIT
211 : END IF
212 : ELSE
213 3788 : 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 1765 : 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 24 : 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 24 : CPASSERT(ASSOCIATED(results))
244 24 : nlist = SIZE(results%result_value)
245 24 : CPASSERT(description(1:1) == '[')
246 24 : CPASSERT(SIZE(results%result_label) == nlist)
247 24 : nrep = 0
248 168 : DO i = 1, nlist
249 168 : IF (TRIM(results%result_label(i)) == TRIM(description)) nrep = nrep + 1
250 : END DO
251 :
252 24 : IF (PRESENT(n_rep)) THEN
253 0 : n_rep = nrep
254 : END IF
255 :
256 24 : IF (nrep <= 0) THEN
257 : CALL cp_abort(__LOCATION__, &
258 0 : " Trying to access result ("//TRIM(description)//") which was never stored!")
259 : END IF
260 :
261 144 : DO i = 1, nlist
262 144 : IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
263 24 : IF (results%result_value(i)%value%type_in_use /= result_type_real) THEN
264 0 : CPABORT("Attempt to retrieve a RESULT which is not a REAL!")
265 : END IF
266 :
267 24 : size_res = SIZE(results%result_value(i)%value%real_type)
268 24 : EXIT
269 : END IF
270 : END DO
271 24 : IF (PRESENT(n_entries)) n_entries = size_res
272 24 : size_values = SIZE(values, 1)*SIZE(values, 2)
273 24 : IF (PRESENT(nval)) THEN
274 24 : CPASSERT(size_res == size_values)
275 : ELSE
276 0 : CPASSERT(nrep*size_res == size_values)
277 : END IF
278 : k = 0
279 144 : DO i = 1, nlist
280 144 : IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
281 24 : k = k + 1
282 24 : IF (PRESENT(nval)) THEN
283 24 : IF (k == nval) THEN
284 72 : values = RESHAPE(results%result_value(i)%value%real_type, [SIZE(values, 1), SIZE(values, 2)])
285 24 : 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 0 : [SIZE(values, 1), SIZE(values, 2)])
290 : END IF
291 : END IF
292 : END DO
293 :
294 24 : 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 2322 : 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 2322 : CPASSERT(ASSOCIATED(results))
316 2322 : nlist = SIZE(results%result_value)
317 2322 : CPASSERT(description(1:1) == '[')
318 2322 : CPASSERT(SIZE(results%result_label) == nlist)
319 2322 : IF (PRESENT(n_rep)) THEN
320 1292 : n_rep = 0
321 2661 : DO i = 1, nlist
322 2661 : IF (TRIM(results%result_label(i)) == TRIM(description)) n_rep = n_rep + 1
323 : END DO
324 : END IF
325 2322 : IF (PRESENT(n_entries)) THEN
326 1030 : n_entries = 0
327 1636 : DO i = 1, nlist
328 1636 : IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
329 2060 : SELECT CASE (results%result_value(i)%value%type_in_use)
330 : CASE (result_type_real)
331 1030 : n_entries = n_entries + SIZE(results%result_value(i)%value%real_type)
332 : CASE (result_type_integer)
333 0 : n_entries = n_entries + SIZE(results%result_value(i)%value%integer_type)
334 : CASE (result_type_logical)
335 0 : n_entries = n_entries + SIZE(results%result_value(i)%value%logical_type)
336 : CASE DEFAULT
337 1030 : CPABORT("Type not implemented in cp_result_type")
338 : END SELECT
339 : EXIT
340 : END IF
341 : END DO
342 : END IF
343 2322 : IF (PRESENT(type_in_use)) THEN
344 1636 : DO i = 1, nlist
345 1636 : IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
346 1030 : type_in_use = results%result_value(i)%value%type_in_use
347 1030 : EXIT
348 : END IF
349 : END DO
350 : END IF
351 2322 : 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 45052 : 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 45052 : CPASSERT(ASSOCIATED(results))
375 45052 : new_size = 0
376 45052 : IF (PRESENT(description)) THEN
377 44522 : CPASSERT(description(1:1) == '[')
378 44522 : nlist = SIZE(results%result_value)
379 44522 : nrep = 0
380 129080 : DO i = 1, nlist
381 129080 : IF (TRIM(results%result_label(i)) == TRIM(description)) nrep = nrep + 1
382 : END DO
383 44522 : IF (nrep /= 0) THEN
384 : k = 0
385 : entry_deleted = 0
386 100338 : DO i = 1, nlist
387 100338 : IF (TRIM(results%result_label(i)) == TRIM(description)) THEN
388 31900 : k = k + 1
389 31900 : IF (PRESENT(nval)) THEN
390 0 : IF (nval == k) THEN
391 0 : entry_deleted = entry_deleted + 1
392 0 : EXIT
393 : END IF
394 : ELSE
395 31900 : entry_deleted = entry_deleted + 1
396 : END IF
397 : END IF
398 : END DO
399 31900 : CPASSERT(nlist - entry_deleted >= 0)
400 31900 : new_size = nlist - entry_deleted
401 31900 : NULLIFY (clean_results)
402 31900 : CALL cp_result_create(clean_results)
403 31900 : CALL cp_result_clean(clean_results)
404 75540 : ALLOCATE (clean_results%result_label(new_size))
405 112078 : ALLOCATE (clean_results%result_value(new_size))
406 68438 : DO i = 1, new_size
407 36538 : NULLIFY (clean_results%result_value(i)%value)
408 68438 : CALL cp_result_value_create(clean_results%result_value(i)%value)
409 : END DO
410 : k = 0
411 100338 : DO i = 1, nlist
412 100338 : IF (TRIM(results%result_label(i)) /= TRIM(description)) THEN
413 36538 : k = k + 1
414 36538 : clean_results%result_label(k) = results%result_label(i)
415 : CALL cp_result_value_copy(clean_results%result_value(k)%value, &
416 36538 : results%result_value(i)%value)
417 : END IF
418 : END DO
419 31900 : CALL cp_result_copy(clean_results, results)
420 31900 : CALL cp_result_release(clean_results)
421 : END IF
422 : ELSE
423 530 : CALL cp_result_clean(results)
424 530 : ALLOCATE (results%result_label(new_size))
425 530 : ALLOCATE (results%result_value(new_size))
426 : END IF
427 45052 : 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 11970 : 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 11970 : INTEGER, ALLOCATABLE, DIMENSION(:) :: size_value, type_in_use
443 :
444 11970 : CPASSERT(ASSOCIATED(results))
445 11970 : nlist = 0
446 11970 : IF (para_env%mepos == source) nlist = SIZE(results%result_value)
447 11970 : CALL para_env%bcast(nlist, source)
448 :
449 25122 : ALLOCATE (size_value(nlist))
450 13152 : ALLOCATE (type_in_use(nlist))
451 11970 : IF (para_env%mepos == source) THEN
452 7250 : DO i = 1, nlist
453 : CALL get_nreps(results, description=results%result_label(i), &
454 7250 : n_entries=size_value(i), type_in_use=type_in_use(i))
455 : END DO
456 : END IF
457 11970 : CALL para_env%bcast(size_value, source)
458 11970 : CALL para_env%bcast(type_in_use, source)
459 :
460 11970 : IF (para_env%mepos /= source) THEN
461 5750 : CALL cp_result_clean(results)
462 12388 : ALLOCATE (results%result_value(nlist))
463 11890 : ALLOCATE (results%result_label(nlist))
464 6248 : DO i = 1, nlist
465 498 : results%result_label(i) = ""
466 498 : NULLIFY (results%result_value(i)%value)
467 498 : CALL cp_result_value_create(results%result_value(i)%value)
468 : CALL cp_result_value_init(results%result_value(i)%value, &
469 6248 : type_in_use=type_in_use(i), size_value=size_value(i))
470 : END DO
471 : END IF
472 13498 : DO i = 1, nlist
473 1528 : CALL para_env%bcast(results%result_label(i), source)
474 11970 : SELECT CASE (results%result_value(i)%value%type_in_use)
475 : CASE (result_type_real)
476 12704 : CALL para_env%bcast(results%result_value(i)%value%real_type, source)
477 : CASE (result_type_integer)
478 0 : CALL para_env%bcast(results%result_value(i)%value%integer_type, source)
479 : CASE (result_type_logical)
480 0 : CALL para_env%bcast(results%result_value(i)%value%logical_type, source)
481 : CASE DEFAULT
482 1528 : CPABORT("Type not implemented in cp_result_type")
483 : END SELECT
484 : END DO
485 11970 : DEALLOCATE (type_in_use)
486 11970 : DEALLOCATE (size_value)
487 11970 : END SUBROUTINE cp_results_mp_bcast
488 :
489 : END MODULE cp_result_methods
|
