Line data Source code
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 : MODULE qs_fb_atomic_halo_types
9 :
10 : USE atomic_kind_types, ONLY: atomic_kind_type,&
11 : get_atomic_kind
12 : USE cell_types, ONLY: cell_type,&
13 : pbc
14 : USE cp_log_handling, ONLY: cp_get_default_logger,&
15 : cp_logger_type
16 : USE cp_output_handling, ONLY: cp_p_file,&
17 : cp_print_key_finished_output,&
18 : cp_print_key_should_output,&
19 : cp_print_key_unit_nr
20 : USE input_section_types, ONLY: section_vals_type
21 : USE kinds, ONLY: default_string_length,&
22 : dp
23 : USE memory_utilities, ONLY: reallocate
24 : USE message_passing, ONLY: mp_para_env_type
25 : USE particle_types, ONLY: particle_type
26 : USE qs_kind_types, ONLY: get_qs_kind,&
27 : qs_kind_type
28 : USE string_utilities, ONLY: compress
29 : USE util, ONLY: locate,&
30 : sort
31 : #include "./base/base_uses.f90"
32 :
33 : IMPLICIT NONE
34 :
35 : PRIVATE
36 :
37 : ! public types
38 : PUBLIC :: fb_atomic_halo_obj, &
39 : fb_atomic_halo_list_obj
40 :
41 : ! public methods
42 : !API
43 : PUBLIC :: fb_atomic_halo_release, &
44 : fb_atomic_halo_nullify, &
45 : fb_atomic_halo_has_data, &
46 : fb_atomic_halo_create, &
47 : fb_atomic_halo_init, &
48 : fb_atomic_halo_get, &
49 : fb_atomic_halo_set, &
50 : fb_atomic_halo_sort, &
51 : fb_atomic_halo_atom_global2halo, &
52 : fb_atomic_halo_nelectrons_estimate_Z, &
53 : fb_atomic_halo_cost, &
54 : fb_atomic_halo_build_halo_atoms, &
55 : fb_atomic_halo_list_release, &
56 : fb_atomic_halo_list_nullify, &
57 : fb_atomic_halo_list_has_data, &
58 : fb_atomic_halo_list_associate, &
59 : fb_atomic_halo_list_create, &
60 : fb_atomic_halo_list_get, &
61 : fb_atomic_halo_list_set, &
62 : fb_atomic_halo_list_write_info, &
63 : fb_build_pair_radii
64 :
65 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fb_atomic_halo_types'
66 :
67 : ! **************************************************************************************************
68 : !> \brief derived type containing the list of atoms in an atomic halo,
69 : !> used by filtered-basis diagonalisation method
70 : !> \param owner_atom : global atomic id of the atom this halo belongs to
71 : !> \param owner_id_in_halo : index of the owner_atom in the halo_atoms array
72 : !> \param natoms : number of atoms in the halo
73 : !> \param nelectrons : estimate of total number of electrons in halo
74 : !> \param halo_atoms : the list of global id of atoms in the halo
75 : !> \param sorted : whether the halo_atoms list is sorted or not
76 : !> \param cost : computational cost for the atomic matrix associated
77 : !> to this atomic halo
78 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
79 : ! **************************************************************************************************
80 : TYPE fb_atomic_halo_data
81 : INTEGER :: owner_atom = -1
82 : INTEGER :: owner_id_in_halo = -1
83 : INTEGER :: natoms = -1
84 : INTEGER :: nelectrons = -1
85 : INTEGER, DIMENSION(:), POINTER :: halo_atoms => NULL()
86 : LOGICAL :: sorted = .FALSE.
87 : REAL(KIND=dp) :: cost = -1.0_dp
88 : END TYPE fb_atomic_halo_data
89 :
90 : ! **************************************************************************************************
91 : !> \brief defines a fb_atomic_halo object
92 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
93 : ! **************************************************************************************************
94 : TYPE fb_atomic_halo_obj
95 : TYPE(fb_atomic_halo_data), POINTER, PRIVATE :: obj => NULL()
96 : END TYPE fb_atomic_halo_obj
97 :
98 : ! **************************************************************************************************
99 : !> \brief derived type describing an atomic halo list used by
100 : !> filtered-basis diagonalisation method
101 : !> \param nhalos : number of halos in the list
102 : !> \param max_nhalos : maximum of the number of halos amongst all of the procs
103 : !> \param halos : halos(ihalo) gives the ihalo-th fb_atomic_halo object
104 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
105 : ! **************************************************************************************************
106 : TYPE fb_atomic_halo_list_data
107 : INTEGER :: nhalos = -1
108 : INTEGER :: max_nhalos = -1
109 : TYPE(fb_atomic_halo_obj), DIMENSION(:), POINTER :: halos => NULL()
110 : END TYPE fb_atomic_halo_list_data
111 :
112 : ! **************************************************************************************************
113 : !> \brief defines a fb_atomic_halo_list object
114 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
115 : ! **************************************************************************************************
116 : TYPE fb_atomic_halo_list_obj
117 : TYPE(fb_atomic_halo_list_data), POINTER, PRIVATE :: obj => NULL()
118 : END TYPE fb_atomic_halo_list_obj
119 :
120 : CONTAINS
121 :
122 : ! **************************************************************************************************
123 : !> \brief Releases an fb_atomic_halo object
124 : !> \param atomic_halo the fb_atomic_halo object, its content must
125 : !> not be UNDEFINED, and the subroutine does nothing
126 : !> if the content points to NULL
127 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
128 : ! **************************************************************************************************
129 114 : SUBROUTINE fb_atomic_halo_release(atomic_halo)
130 : TYPE(fb_atomic_halo_obj), INTENT(INOUT) :: atomic_halo
131 :
132 114 : IF (ASSOCIATED(atomic_halo%obj)) THEN
133 114 : IF (ASSOCIATED(atomic_halo%obj%halo_atoms)) THEN
134 : ! note that if there are other pointers associated to the memory pointed
135 : ! by atomic_halo%obj%halo_atoms, their behaviour becomes undefined per
136 : ! FORTRAN standard (and thus becomes compiler dependent and unreliable)
137 : ! after the following DEALLOCATE
138 114 : DEALLOCATE (atomic_halo%obj%halo_atoms)
139 : END IF
140 114 : DEALLOCATE (atomic_halo%obj)
141 : ELSE
142 0 : NULLIFY (atomic_halo%obj)
143 : END IF
144 114 : END SUBROUTINE fb_atomic_halo_release
145 :
146 : ! **************************************************************************************************
147 : !> \brief Nullifies a fb_atomic_halo object, note that it does not
148 : !> release the original object. This procedure is used to nullify
149 : !> the pointer contained in the object which is used to associate
150 : !> to the actual object content
151 : !> \param atomic_halo the fb_atomic_halo object
152 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
153 : ! **************************************************************************************************
154 114 : SUBROUTINE fb_atomic_halo_nullify(atomic_halo)
155 : TYPE(fb_atomic_halo_obj), INTENT(INOUT) :: atomic_halo
156 :
157 114 : NULLIFY (atomic_halo%obj)
158 114 : END SUBROUTINE fb_atomic_halo_nullify
159 :
160 : ! **************************************************************************************************
161 : !> \brief Associates one fb_atomic_halo object to another
162 : !> \param a the fb_atomic_halo object to be associated
163 : !> \param b the fb_atomic_halo object that a is to be associated to
164 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
165 : ! **************************************************************************************************
166 0 : SUBROUTINE fb_atomic_halo_associate(a, b)
167 : TYPE(fb_atomic_halo_obj), INTENT(OUT) :: a
168 : TYPE(fb_atomic_halo_obj), INTENT(IN) :: b
169 :
170 0 : a%obj => b%obj
171 0 : END SUBROUTINE fb_atomic_halo_associate
172 :
173 : ! **************************************************************************************************
174 : !> \brief Checks if a fb_atomic_halo object is associated with an actual
175 : !> data content or not
176 : !> \param atomic_halo the fb_atomic_halo object
177 : !> \return ...
178 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
179 : ! **************************************************************************************************
180 128 : FUNCTION fb_atomic_halo_has_data(atomic_halo) RESULT(res)
181 : TYPE(fb_atomic_halo_obj), INTENT(IN) :: atomic_halo
182 : LOGICAL :: res
183 :
184 128 : res = ASSOCIATED(atomic_halo%obj)
185 128 : END FUNCTION fb_atomic_halo_has_data
186 :
187 : ! **************************************************************************************************
188 : !> \brief Creates and initialises an empty fb_atomic_halo object
189 : !> \param atomic_halo the fb_atomic_halo object, its content must
190 : !> be NULL and cannot be UNDEFINED
191 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
192 : ! **************************************************************************************************
193 114 : SUBROUTINE fb_atomic_halo_create(atomic_halo)
194 : TYPE(fb_atomic_halo_obj), INTENT(INOUT) :: atomic_halo
195 :
196 114 : CPASSERT(.NOT. ASSOCIATED(atomic_halo%obj))
197 114 : ALLOCATE (atomic_halo%obj)
198 114 : atomic_halo%obj%owner_atom = 0
199 114 : atomic_halo%obj%owner_id_in_halo = 0
200 114 : atomic_halo%obj%natoms = 0
201 114 : atomic_halo%obj%nelectrons = 0
202 : atomic_halo%obj%sorted = .FALSE.
203 114 : atomic_halo%obj%cost = 0.0_dp
204 : NULLIFY (atomic_halo%obj%halo_atoms)
205 114 : END SUBROUTINE fb_atomic_halo_create
206 :
207 : ! **************************************************************************************************
208 : !> \brief Initialises an fb_atomic_halo object, and makes it empty
209 : !> \param atomic_halo the fb_atomic_halo object, its content must
210 : !> not be NULL or UNDEFINED
211 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
212 : ! **************************************************************************************************
213 80 : SUBROUTINE fb_atomic_halo_init(atomic_halo)
214 : TYPE(fb_atomic_halo_obj), INTENT(INOUT) :: atomic_halo
215 :
216 80 : CPASSERT(ASSOCIATED(atomic_halo%obj))
217 : ! if halo_atoms are associated, then deallocate and de-associate
218 80 : IF (ASSOCIATED(atomic_halo%obj%halo_atoms)) THEN
219 70 : DEALLOCATE (atomic_halo%obj%halo_atoms)
220 : END IF
221 80 : atomic_halo%obj%owner_atom = 0
222 80 : atomic_halo%obj%owner_id_in_halo = 0
223 80 : atomic_halo%obj%natoms = 0
224 80 : atomic_halo%obj%nelectrons = 0
225 80 : atomic_halo%obj%sorted = .FALSE.
226 80 : atomic_halo%obj%cost = 0.0_dp
227 80 : END SUBROUTINE fb_atomic_halo_init
228 :
229 : ! **************************************************************************************************
230 : !> \brief Gets attributes from a fb_atomic_halo object, one should
231 : !> only access the data content in a fb_atomic_halo outside
232 : !> this module via this procedure.
233 : !> \param atomic_halo the fb_atomic_halo object, its content must
234 : !> not be NULL or UNDEFINED
235 : !> \param owner_atom [OPTIONAL]: if present, outputs atmic_halo%obj%owner_atom
236 : !> \param owner_id_in_halo ...
237 : !> \param natoms [OPTIONAL]: if present, outputs atomic_halo%obj%natoms
238 : !> \param nelectrons [OPTIONAL]: if present, outputs atomic_halo%obj%nelectrons
239 : !> \param halo_atoms [OPTIONAL]: if present, outputs pointer
240 : !> atomic_halo%obj%halo_atoms
241 : !> \param sorted [OPTIONAL]: if present, outputs atomic_halo%obj%sorted
242 : !> \param cost [OPTIONAL]: if present, outputs atomic_halo%obj%cost
243 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
244 : ! **************************************************************************************************
245 2408 : SUBROUTINE fb_atomic_halo_get(atomic_halo, &
246 : owner_atom, &
247 : owner_id_in_halo, &
248 : natoms, &
249 : nelectrons, &
250 : halo_atoms, &
251 : sorted, &
252 : cost)
253 : TYPE(fb_atomic_halo_obj), INTENT(IN) :: atomic_halo
254 : INTEGER, INTENT(OUT), OPTIONAL :: owner_atom, owner_id_in_halo, natoms, &
255 : nelectrons
256 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: halo_atoms
257 : LOGICAL, INTENT(OUT), OPTIONAL :: sorted
258 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: cost
259 :
260 2408 : CPASSERT(ASSOCIATED(atomic_halo%obj))
261 2408 : IF (PRESENT(owner_atom)) owner_atom = atomic_halo%obj%owner_atom
262 2408 : IF (PRESENT(owner_id_in_halo)) owner_id_in_halo = atomic_halo%obj%owner_id_in_halo
263 2408 : IF (PRESENT(natoms)) natoms = atomic_halo%obj%natoms
264 2408 : IF (PRESENT(nelectrons)) nelectrons = atomic_halo%obj%nelectrons
265 2408 : IF (PRESENT(halo_atoms)) halo_atoms => atomic_halo%obj%halo_atoms
266 2408 : IF (PRESENT(sorted)) sorted = atomic_halo%obj%sorted
267 2408 : IF (PRESENT(cost)) cost = atomic_halo%obj%cost
268 2408 : END SUBROUTINE fb_atomic_halo_get
269 :
270 : ! **************************************************************************************************
271 : !> \brief Sets attributes in a fb_atomic_halo object, one should
272 : !> only set the data content in a fb_atomic_halo from outside
273 : !> this module via this procedure.
274 : !> \param atomic_halo the fb_atomic_halo object, its content must
275 : !> not be NULL or UNDEFINED
276 : !> \param owner_atom [OPTIONAL]: if present, sets
277 : !> atmic_halo%obj%owner_atom = owner_atom
278 : !> \param owner_id_in_halo ...
279 : !> \param natoms [OPTIONAL]: if present, sets atomic_halo%obj%natoms = natoms
280 : !> \param nelectrons [OPTIONAL]: if present, sets atomic_halo%obj%nelectrons = nelectrons
281 : !> \param halo_atoms [OPTIONAL]: if present, reallocates atomic_halo%obj%halo_atoms
282 : !> to the size of halo_atoms, and copies
283 : !> contents of halo_atoms to atomic_halo%obj%halo_atoms
284 : !> \param sorted [OPTIONAL]: if present, sets atomic_halo%obj%sorted = sorted
285 : !> \param cost [OPTIONAL]: if present, sets atomic_halo%obj%cost = cost
286 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
287 : ! **************************************************************************************************
288 224 : SUBROUTINE fb_atomic_halo_set(atomic_halo, &
289 : owner_atom, &
290 : owner_id_in_halo, &
291 : natoms, &
292 : nelectrons, &
293 : halo_atoms, &
294 : sorted, &
295 : cost)
296 : TYPE(fb_atomic_halo_obj), INTENT(INOUT) :: atomic_halo
297 : INTEGER, INTENT(IN), OPTIONAL :: owner_atom, owner_id_in_halo, natoms, &
298 : nelectrons
299 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: halo_atoms
300 : LOGICAL, INTENT(IN), OPTIONAL :: sorted
301 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: cost
302 :
303 224 : CPASSERT(ASSOCIATED(atomic_halo%obj))
304 224 : IF (PRESENT(owner_atom)) atomic_halo%obj%owner_atom = owner_atom
305 224 : IF (PRESENT(owner_id_in_halo)) atomic_halo%obj%owner_id_in_halo = owner_id_in_halo
306 224 : IF (PRESENT(natoms)) atomic_halo%obj%natoms = natoms
307 224 : IF (PRESENT(nelectrons)) atomic_halo%obj%nelectrons = nelectrons
308 224 : IF (PRESENT(halo_atoms)) THEN
309 184 : IF (ASSOCIATED(atomic_halo%obj%halo_atoms)) THEN
310 0 : DEALLOCATE (atomic_halo%obj%halo_atoms)
311 : END IF
312 184 : atomic_halo%obj%halo_atoms => halo_atoms
313 : END IF
314 224 : IF (PRESENT(nelectrons)) atomic_halo%obj%nelectrons = nelectrons
315 224 : IF (PRESENT(sorted)) atomic_halo%obj%sorted = sorted
316 224 : IF (PRESENT(cost)) atomic_halo%obj%cost = cost
317 224 : END SUBROUTINE fb_atomic_halo_set
318 :
319 : ! **************************************************************************************************
320 : !> \brief Sort the list of atomic indices in the halo in ascending order.
321 : !> The atomic_halo must not be empty
322 : !> \param atomic_halo the atomic_halo object
323 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
324 : ! **************************************************************************************************
325 40 : SUBROUTINE fb_atomic_halo_sort(atomic_halo)
326 : TYPE(fb_atomic_halo_obj), INTENT(INOUT) :: atomic_halo
327 :
328 40 : INTEGER, ALLOCATABLE, DIMENSION(:) :: tmp_index
329 :
330 40 : CPASSERT(SIZE(atomic_halo%obj%halo_atoms) > 0)
331 120 : ALLOCATE (tmp_index(atomic_halo%obj%natoms))
332 40 : CALL sort(atomic_halo%obj%halo_atoms, atomic_halo%obj%natoms, tmp_index)
333 40 : DEALLOCATE (tmp_index)
334 40 : atomic_halo%obj%sorted = .TRUE.
335 40 : END SUBROUTINE fb_atomic_halo_sort
336 :
337 : ! **************************************************************************************************
338 : !> \brief Given a global atomic index, convert it to its index in a
339 : !> given atomic halo, if found.
340 : !> The atomic_halo object must already have been sorted
341 : !> \param atomic_halo the atomic_halo object
342 : !> \param iatom_global the global atomic index
343 : !> \param iatom_halo the atomic index inside the halo
344 : !> \param found returns true if given atom is in the halo, otherwise
345 : !> false
346 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
347 : ! **************************************************************************************************
348 36864 : SUBROUTINE fb_atomic_halo_atom_global2halo(atomic_halo, &
349 : iatom_global, &
350 : iatom_halo, &
351 : found)
352 : TYPE(fb_atomic_halo_obj), INTENT(IN) :: atomic_halo
353 : INTEGER, INTENT(IN) :: iatom_global
354 : INTEGER, INTENT(OUT) :: iatom_halo
355 : LOGICAL, INTENT(OUT) :: found
356 :
357 : CHARACTER(len=*), PARAMETER :: routineN = 'fb_atomic_halo_atom_global2halo'
358 :
359 : INTEGER :: handle
360 :
361 36864 : CALL timeset(routineN, handle)
362 :
363 36864 : CPASSERT(atomic_halo%obj%sorted)
364 36864 : iatom_halo = locate(atomic_halo%obj%halo_atoms, iatom_global)
365 36864 : IF (iatom_halo == 0) THEN
366 0 : found = .FALSE.
367 : ELSE
368 36864 : found = .TRUE.
369 : END IF
370 :
371 36864 : CALL timestop(handle)
372 :
373 36864 : END SUBROUTINE fb_atomic_halo_atom_global2halo
374 :
375 : ! **************************************************************************************************
376 : !> \brief Estimates the total number of electrons in a halo using atomic
377 : !> numbers
378 : !> \param atomic_halo the atomic_halo object
379 : !> \param particle_set an array of cp2k particle set objects (this
380 : !> gives atomic information)
381 : !> \return estimate of electron number
382 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
383 : ! **************************************************************************************************
384 40 : FUNCTION fb_atomic_halo_nelectrons_estimate_Z(atomic_halo, particle_set) RESULT(nelectrons)
385 : TYPE(fb_atomic_halo_obj), INTENT(IN) :: atomic_halo
386 : TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
387 : INTEGER :: nelectrons
388 :
389 : INTEGER :: iatom_global, iatom_halo, z
390 : TYPE(atomic_kind_type), POINTER :: atomic_kind
391 :
392 40 : nelectrons = 0
393 40 : IF (ASSOCIATED(atomic_halo%obj)) THEN
394 360 : DO iatom_halo = 1, atomic_halo%obj%natoms
395 320 : iatom_global = atomic_halo%obj%halo_atoms(iatom_halo)
396 320 : atomic_kind => particle_set(iatom_global)%atomic_kind
397 : CALL get_atomic_kind(atomic_kind=atomic_kind, &
398 320 : z=z)
399 360 : nelectrons = nelectrons + z
400 : END DO
401 : END IF
402 40 : END FUNCTION fb_atomic_halo_nelectrons_estimate_Z
403 :
404 : ! **************************************************************************************************
405 : !> \brief Estimates the computational cost with respect to the filter matrix
406 : !> calculation associated to an atomic halo. Given the bottle neck
407 : !> of the filter matrix generation will be the diagoanlisation of the
408 : !> atomic matrices (each consists of atoms in an atomic halo), the cost
409 : !> can be estimated by counting the total number of contracted gaussians
410 : !> in the halo
411 : !> \param atomic_halo : the atomic_halo object in question
412 : !> \param particle_set : an array of cp2k particle set objects, this
413 : !> provides atomic information
414 : !> \param qs_kind_set : cp2k qs_kind objects, provides information on the
415 : !> number of contracted gaussian functions each kind
416 : !> has
417 : !> \return : computation cost w.r.t. the filter matrix
418 : !> calculation for this atomic halo
419 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
420 : ! **************************************************************************************************
421 120 : FUNCTION fb_atomic_halo_cost(atomic_halo, &
422 120 : particle_set, &
423 120 : qs_kind_set) &
424 : RESULT(cost)
425 : TYPE(fb_atomic_halo_obj), INTENT(IN) :: atomic_halo
426 : TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
427 : TYPE(qs_kind_type), DIMENSION(:), INTENT(IN) :: qs_kind_set
428 : REAL(KIND=dp) :: cost
429 :
430 : INTEGER :: iatom, ii, ikind, ncgf
431 :
432 120 : cost = 0.0_dp
433 1080 : DO ii = 1, atomic_halo%obj%natoms
434 960 : iatom = atomic_halo%obj%halo_atoms(ii)
435 : CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, &
436 960 : kind_number=ikind)
437 : CALL get_qs_kind(qs_kind=qs_kind_set(ikind), &
438 960 : ncgf=ncgf)
439 1080 : cost = cost + REAL(ncgf, dp)
440 : END DO
441 : ! diagonalisation is N**3 process, so cost must reflect that
442 120 : cost = cost**3
443 120 : END FUNCTION fb_atomic_halo_cost
444 :
445 : ! **************************************************************************************************
446 : !> \brief Builds halo atoms for a given (owner) atom
447 : !> \param owner_atom : the atom the halo is going to be built for
448 : !> \param particle_set : an array of cp2k particle set objects, this
449 : !> provides atomic information
450 : !> \param cell : cp2k cell object, used for resolving periodic
451 : !> boundary conditions
452 : !> \param pair_radii : 2D array storing interaction radii between two kinds
453 : !> \param halo_atoms : must be NULL pointer on input, and outputs an
454 : !> array of halo atoms corresponding to the owner atom
455 : !> \param nhalo_atoms : outputs number of halo atoms
456 : !> \param owner_id_in_halo : the index of the owner atom in the halo_atoms list
457 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
458 : ! **************************************************************************************************
459 120 : SUBROUTINE fb_atomic_halo_build_halo_atoms(owner_atom, &
460 120 : particle_set, &
461 : cell, &
462 120 : pair_radii, &
463 : halo_atoms, &
464 : nhalo_atoms, &
465 : owner_id_in_halo)
466 : INTEGER, INTENT(IN) :: owner_atom
467 : TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
468 : TYPE(cell_type), POINTER :: cell
469 : REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: pair_radii
470 : INTEGER, DIMENSION(:), POINTER :: halo_atoms
471 : INTEGER, INTENT(OUT) :: nhalo_atoms, owner_id_in_halo
472 :
473 : INTEGER :: iatom, ikind, jatom, jkind, natoms_global
474 : LOGICAL :: check_ok
475 : REAL(KIND=dp) :: rij
476 : REAL(KIND=dp), DIMENSION(3) :: ri, rij_pbc, rj
477 : TYPE(atomic_kind_type), POINTER :: atomic_kind
478 :
479 120 : check_ok = .NOT. ASSOCIATED(halo_atoms)
480 120 : CPASSERT(check_ok)
481 :
482 120 : NULLIFY (atomic_kind)
483 :
484 120 : iatom = owner_atom
485 120 : atomic_kind => particle_set(iatom)%atomic_kind
486 : CALL get_atomic_kind(atomic_kind=atomic_kind, &
487 120 : kind_number=ikind)
488 120 : natoms_global = SIZE(particle_set)
489 360 : ALLOCATE (halo_atoms(natoms_global))
490 120 : owner_id_in_halo = 0
491 120 : nhalo_atoms = 0
492 1080 : DO jatom = 1, natoms_global
493 960 : atomic_kind => particle_set(jatom)%atomic_kind
494 : CALL get_atomic_kind(atomic_kind=atomic_kind, &
495 960 : kind_number=jkind)
496 : ! calculate the minimum distance between iatom and
497 : ! jatom, taking account of the periodic boundary
498 : ! conditions
499 3840 : ri(1:3) = particle_set(iatom)%r(1:3)
500 3840 : rj(1:3) = particle_set(jatom)%r(1:3)
501 960 : rij_pbc = pbc(ri, rj, cell)
502 : rij = rij_pbc(1)*rij_pbc(1) + &
503 : rij_pbc(2)*rij_pbc(2) + &
504 960 : rij_pbc(3)*rij_pbc(3)
505 960 : rij = SQRT(rij)
506 2040 : IF (rij .LE. pair_radii(ikind, jkind)) THEN
507 : ! jatom is in iatom's halo
508 960 : nhalo_atoms = nhalo_atoms + 1
509 960 : halo_atoms(nhalo_atoms) = jatom
510 960 : IF (jatom == iatom) owner_id_in_halo = nhalo_atoms
511 : END IF
512 : END DO
513 120 : CALL reallocate(halo_atoms, 1, nhalo_atoms)
514 120 : END SUBROUTINE fb_atomic_halo_build_halo_atoms
515 :
516 : ! **************************************************************************************************
517 : !> \brief Releases an fb_atomic_halo_list object
518 : !> \param atomic_halos the fb_atomic_halo object, its content must
519 : !> not be UNDEFINED, and does nothing if it is NULL
520 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
521 : ! **************************************************************************************************
522 20 : SUBROUTINE fb_atomic_halo_list_release(atomic_halos)
523 : TYPE(fb_atomic_halo_list_obj), INTENT(INOUT) :: atomic_halos
524 :
525 : INTEGER :: ii
526 :
527 20 : IF (ASSOCIATED(atomic_halos%obj)) THEN
528 10 : IF (ASSOCIATED(atomic_halos%obj%halos)) THEN
529 50 : DO ii = 1, SIZE(atomic_halos%obj%halos)
530 50 : CALL fb_atomic_halo_release(atomic_halos%obj%halos(ii))
531 : END DO
532 10 : DEALLOCATE (atomic_halos%obj%halos)
533 : END IF
534 10 : DEALLOCATE (atomic_halos%obj)
535 : ELSE
536 10 : NULLIFY (atomic_halos%obj)
537 : END IF
538 20 : END SUBROUTINE fb_atomic_halo_list_release
539 :
540 : ! **************************************************************************************************
541 : !> \brief Nullifies a fb_atomic_halo_list object, note that it does
542 : !> not release the original object. This procedure is used to
543 : !> nullify the pointer contained in the object which is used to
544 : !> associate to the actual object content
545 : !> \param atomic_halos the fb_atomic_halo_list object
546 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
547 : ! **************************************************************************************************
548 100 : SUBROUTINE fb_atomic_halo_list_nullify(atomic_halos)
549 : TYPE(fb_atomic_halo_list_obj), INTENT(INOUT) :: atomic_halos
550 :
551 100 : NULLIFY (atomic_halos%obj)
552 100 : END SUBROUTINE fb_atomic_halo_list_nullify
553 :
554 : ! **************************************************************************************************
555 : !> \brief Checks if a fb_atomic_halo_list object is associated with
556 : !> an actual data content or not
557 : !> \param atomic_halos the fb_atomic_halo_list object
558 : !> \return ...
559 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
560 : ! **************************************************************************************************
561 0 : FUNCTION fb_atomic_halo_list_has_data(atomic_halos) RESULT(res)
562 : TYPE(fb_atomic_halo_list_obj), INTENT(IN) :: atomic_halos
563 : LOGICAL :: res
564 :
565 0 : res = ASSOCIATED(atomic_halos%obj)
566 0 : END FUNCTION fb_atomic_halo_list_has_data
567 :
568 : ! **************************************************************************************************
569 : !> \brief Associates one fb_atomic_halo_list object to another
570 : !> \param a the fb_atomic_halo_list object to be associated
571 : !> \param b the fb_atomic_halo_list object that a is to be associated to
572 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
573 : ! **************************************************************************************************
574 90 : SUBROUTINE fb_atomic_halo_list_associate(a, b)
575 : TYPE(fb_atomic_halo_list_obj), INTENT(OUT) :: a
576 : TYPE(fb_atomic_halo_list_obj), INTENT(IN) :: b
577 :
578 90 : a%obj => b%obj
579 90 : END SUBROUTINE fb_atomic_halo_list_associate
580 :
581 : ! **************************************************************************************************
582 : !> \brief Creates and initialises an empty fb_atomic_halo_list object
583 : !> \param atomic_halos the fb_atomic_halo object, its content must
584 : !> not be NULL or UNDEFINED
585 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
586 : ! **************************************************************************************************
587 10 : SUBROUTINE fb_atomic_halo_list_create(atomic_halos)
588 : TYPE(fb_atomic_halo_list_obj), INTENT(INOUT) :: atomic_halos
589 :
590 10 : CPASSERT(.NOT. ASSOCIATED(atomic_halos%obj))
591 10 : ALLOCATE (atomic_halos%obj)
592 10 : atomic_halos%obj%nhalos = 0
593 10 : atomic_halos%obj%max_nhalos = 0
594 : NULLIFY (atomic_halos%obj%halos)
595 10 : END SUBROUTINE fb_atomic_halo_list_create
596 :
597 : ! **************************************************************************************************
598 : !> \brief Initialises an fb_atomic_halo_list object and make it empty
599 : !> \param atomic_halos the fb_atomic_halo object, its content must
600 : !> not be NULL or UNDEFINED
601 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
602 : ! **************************************************************************************************
603 0 : SUBROUTINE fb_atomic_halo_list_init(atomic_halos)
604 : TYPE(fb_atomic_halo_list_obj), INTENT(INOUT) :: atomic_halos
605 :
606 : INTEGER :: ii
607 :
608 0 : CPASSERT(ASSOCIATED(atomic_halos%obj))
609 : ! if the arrays are associated, then deallocate and de-associate
610 0 : IF (ASSOCIATED(atomic_halos%obj%halos)) THEN
611 0 : DO ii = 1, SIZE(atomic_halos%obj%halos)
612 0 : CALL fb_atomic_halo_release(atomic_halos%obj%halos(ii))
613 : END DO
614 0 : DEALLOCATE (atomic_halos%obj%halos)
615 : END IF
616 0 : atomic_halos%obj%nhalos = 0
617 0 : atomic_halos%obj%max_nhalos = 0
618 0 : END SUBROUTINE fb_atomic_halo_list_init
619 :
620 : ! **************************************************************************************************
621 : !> \brief Gets attributes from an fb_atomic_halo_list object, one should
622 : !> only access the data content in a fb_atomic_halo_list outside
623 : !> this module via this procedure.
624 : !> \param atomic_halos the fb_atomic_halo object, its content must
625 : !> not be NULL or UNDEFINED
626 : !> \param nhalos [OPTIONAL]: if present, gives nhalos = atomic_halos%obj%nhalos
627 : !> \param max_nhalos [OPTIONAL]: if present, gives max_nhalos = atomic_halos%obj%max_nhalos
628 : !> \param halos [OPTIONAL]: if present, gives halos => atomic_halos%obj%halos
629 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
630 : ! **************************************************************************************************
631 138 : SUBROUTINE fb_atomic_halo_list_get(atomic_halos, nhalos, max_nhalos, halos)
632 : TYPE(fb_atomic_halo_list_obj), INTENT(IN) :: atomic_halos
633 : INTEGER, INTENT(OUT), OPTIONAL :: nhalos, max_nhalos
634 : TYPE(fb_atomic_halo_obj), DIMENSION(:), OPTIONAL, &
635 : POINTER :: halos
636 :
637 138 : CPASSERT(ASSOCIATED(atomic_halos%obj))
638 138 : IF (PRESENT(nhalos)) nhalos = atomic_halos%obj%nhalos
639 138 : IF (PRESENT(max_nhalos)) max_nhalos = atomic_halos%obj%max_nhalos
640 138 : IF (PRESENT(halos)) halos => atomic_halos%obj%halos
641 138 : END SUBROUTINE fb_atomic_halo_list_get
642 :
643 : ! **************************************************************************************************
644 : !> \brief Sets attributes from an fb_atomic_halo_list object, one should
645 : !> only set the data content in a fb_atomic_halo_list outside
646 : !> this module via this procedure.
647 : !> \param atomic_halos the fb_atomic_halo object, its content must
648 : !> not be NULL or UNDEFINED
649 : !> \param nhalos [OPTIONAL]: if present, sets atomic_halos%obj%nhalos = nhalos
650 : !> \param max_nhalos [OPTIONAL]: if present, sets atomic_halos%obj%max_nhalos = max_nhalos
651 : !> \param halos [OPTIONAL]: if present, reallocates atomic_halos%obj%halos
652 : !> to the size of halos
653 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
654 : ! **************************************************************************************************
655 20 : SUBROUTINE fb_atomic_halo_list_set(atomic_halos, nhalos, max_nhalos, halos)
656 : TYPE(fb_atomic_halo_list_obj), INTENT(INOUT) :: atomic_halos
657 : INTEGER, INTENT(IN), OPTIONAL :: nhalos, max_nhalos
658 : TYPE(fb_atomic_halo_obj), DIMENSION(:), OPTIONAL, &
659 : POINTER :: halos
660 :
661 : INTEGER :: ihalo
662 :
663 20 : CPASSERT(ASSOCIATED(atomic_halos%obj))
664 20 : IF (PRESENT(nhalos)) atomic_halos%obj%nhalos = nhalos
665 20 : IF (PRESENT(max_nhalos)) atomic_halos%obj%max_nhalos = max_nhalos
666 20 : IF (PRESENT(halos)) THEN
667 10 : IF (ASSOCIATED(atomic_halos%obj%halos)) THEN
668 0 : DO ihalo = 1, SIZE(atomic_halos%obj%halos)
669 0 : CALL fb_atomic_halo_release(atomic_halos%obj%halos(ihalo))
670 : END DO
671 0 : DEALLOCATE (atomic_halos%obj%halos)
672 : END IF
673 10 : atomic_halos%obj%halos => halos
674 : END IF
675 20 : END SUBROUTINE fb_atomic_halo_list_set
676 :
677 : ! **************************************************************************************************
678 : !> \brief Writes out the atomic halo list from an fb_atomic_halo_list
679 : !> object using information
680 : !> \param atomic_halos the fb_atomic_halo object
681 : !> \param para_env pointer to a para_env_type object containing MPI info
682 : !> \param fb_section pointer to the input section to filtered basis method
683 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
684 : ! **************************************************************************************************
685 0 : SUBROUTINE fb_atomic_halo_list_write(atomic_halos, para_env, fb_section)
686 : TYPE(fb_atomic_halo_list_obj), INTENT(IN) :: atomic_halos
687 : TYPE(mp_para_env_type), POINTER :: para_env
688 : TYPE(section_vals_type), POINTER :: fb_section
689 :
690 : CHARACTER(LEN=default_string_length) :: string
691 : INTEGER :: ihalo, jatom, mype, nhalo_atoms, nhalos, &
692 : owner_atom, print_unit
693 0 : INTEGER, DIMENSION(:), POINTER :: halo_atoms
694 : LOGICAL :: new_file
695 : TYPE(cp_logger_type), POINTER :: logger
696 0 : TYPE(fb_atomic_halo_obj), DIMENSION(:), POINTER :: halos
697 :
698 0 : NULLIFY (logger)
699 0 : logger => cp_get_default_logger()
700 :
701 0 : IF (BTEST(cp_print_key_should_output(logger%iter_info, fb_section, &
702 : "PRINT%ATOMIC_HALOS"), &
703 : cp_p_file)) THEN
704 : print_unit = cp_print_key_unit_nr(logger=logger, &
705 : basis_section=fb_section, &
706 : print_key_path="PRINT%ATOMIC_HALOS", &
707 : extension=".out", &
708 : local=.TRUE., &
709 : log_filename=.FALSE., &
710 : file_position="REWIND", &
711 : file_action="WRITE", &
712 0 : is_new_file=new_file)
713 0 : mype = para_env%mepos
714 : ! print headline
715 0 : string = ""
716 : WRITE (UNIT=string, FMT="(A,I5,A)") &
717 0 : "ATOMIC HALOS IN (PROCESS ", mype, ")"
718 0 : CALL compress(string)
719 0 : IF (print_unit > 0) THEN
720 0 : WRITE (UNIT=print_unit, FMT="(/,/,T2,A)") TRIM(string)
721 : WRITE (UNIT=print_unit, FMT="(/,T2,A)") &
722 0 : "atom : list of atoms in the atomic halo"
723 : END IF
724 : ! print content
725 : CALL fb_atomic_halo_list_get(atomic_halos=atomic_halos, &
726 : nhalos=nhalos, &
727 0 : halos=halos)
728 0 : DO ihalo = 1, nhalos
729 : CALL fb_atomic_halo_get(halos(ihalo), &
730 : owner_atom=owner_atom, &
731 : natoms=nhalo_atoms, &
732 0 : halo_atoms=halo_atoms)
733 : WRITE (UNIT=print_unit, FMT="(2X,I6,A)", ADVANCE="no") &
734 0 : owner_atom, " : "
735 0 : DO jatom = 1, nhalo_atoms
736 : WRITE (UNIT=print_unit, FMT="(I6)", ADVANCE="no") &
737 0 : halo_atoms(jatom)
738 : END DO
739 0 : WRITE (UNIT=print_unit) ""
740 : END DO
741 : ! finish
742 : CALL cp_print_key_finished_output(print_unit, logger, fb_section, &
743 0 : "PRINT%ATOMIC_HALOS")
744 : END IF
745 0 : END SUBROUTINE fb_atomic_halo_list_write
746 :
747 : ! **************************************************************************************************
748 : !> \brief Writes out the atomic halo list summary, no detailed neighbour lists,
749 : !> just average, min and max number of halo atoms in the halo list
750 : !> \param atomic_halos : the fb_atomic_halo object
751 : !> \param para_env : pointer to a para_env_type object containing MPI info
752 : !> \param scf_section : pointer to the scf input section
753 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
754 : ! **************************************************************************************************
755 20 : SUBROUTINE fb_atomic_halo_list_write_info(atomic_halos, para_env, scf_section)
756 : TYPE(fb_atomic_halo_list_obj), INTENT(IN) :: atomic_halos
757 : TYPE(mp_para_env_type), POINTER :: para_env
758 : TYPE(section_vals_type), POINTER :: scf_section
759 :
760 : INTEGER :: ihalo, max_natoms, min_natoms, &
761 : nhalo_atoms, nhalos, &
762 : total_n_halo_atoms, total_n_halos, &
763 : unit_nr
764 : REAL(KIND=dp) :: ave_natoms
765 : TYPE(cp_logger_type), POINTER :: logger
766 10 : TYPE(fb_atomic_halo_obj), DIMENSION(:), POINTER :: halos
767 :
768 10 : NULLIFY (logger, halos)
769 20 : logger => cp_get_default_logger()
770 : unit_nr = cp_print_key_unit_nr(logger, scf_section, &
771 : "PRINT%FILTER_MATRIX", &
772 10 : extension="")
773 :
774 : ! obtain data
775 : CALL fb_atomic_halo_list_get(atomic_halos=atomic_halos, &
776 : halos=halos, &
777 10 : nhalos=nhalos)
778 10 : max_natoms = 0
779 10 : min_natoms = HUGE(0)
780 10 : total_n_halo_atoms = 0
781 10 : total_n_halos = nhalos
782 50 : DO ihalo = 1, nhalos
783 : CALL fb_atomic_halo_get(atomic_halo=halos(ihalo), &
784 40 : natoms=nhalo_atoms)
785 40 : total_n_halo_atoms = total_n_halo_atoms + nhalo_atoms
786 40 : max_natoms = MAX(max_natoms, nhalo_atoms)
787 50 : min_natoms = MIN(min_natoms, nhalo_atoms)
788 : END DO
789 10 : CALL para_env%max(max_natoms)
790 10 : CALL para_env%min(min_natoms)
791 10 : CALL para_env%sum(total_n_halos)
792 10 : CALL para_env%sum(total_n_halo_atoms)
793 10 : ave_natoms = REAL(total_n_halo_atoms, dp)/REAL(total_n_halos, dp)
794 : ! write info
795 10 : IF (unit_nr > 0) THEN
796 : WRITE (UNIT=unit_nr, FMT="(/,A)") &
797 5 : " FILTER_MAT_DIAG| Atomic matrix neighbor lists information:"
798 : WRITE (UNIT=unit_nr, FMT="(A,I10)") &
799 5 : " FILTER_MAT_DIAG| Number of atomic matrices: ", &
800 10 : total_n_halos
801 : WRITE (UNIT=unit_nr, &
802 : FMT="(A,T45,A,T57,A,T69,A,T81,A)") &
803 5 : " FILTER_MAT_DIAG| ", "Average", "Max", "Min"
804 : WRITE (UNIT=unit_nr, &
805 : FMT="(A,T45,F10.1,T57,I10,T69,I10,T81,I10)") &
806 5 : " FILTER_MAT_DIAG| N neighbors per atom:", &
807 10 : ave_natoms, max_natoms, min_natoms
808 : END IF
809 : ! finish
810 : CALL cp_print_key_finished_output(unit_nr, logger, scf_section, &
811 10 : "PRINT%FILTER_MATRIX")
812 10 : END SUBROUTINE fb_atomic_halo_list_write_info
813 :
814 : ! **************************************************************************************************
815 : !> \brief Builds the required pair_radii array required for building the
816 : !> halo atoms from a given set of cut off radii
817 : !> \param rcut : rcut(ikind) is the cutoff radii for determining the halo
818 : !> corresponding to atomic kind ikind
819 : !> \param nkinds : total number of atomic kinds in rcut
820 : !> \param pair_radii : output array pair_radii(ikind,jkind) gives the
821 : !> corresponding interaction range between a pair of atoms
822 : !> of kinds ikind and jkind
823 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
824 : ! **************************************************************************************************
825 20 : PURE SUBROUTINE fb_build_pair_radii(rcut, nkinds, pair_radii)
826 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: rcut
827 : INTEGER, INTENT(IN) :: nkinds
828 : REAL(KIND=dp), DIMENSION(:, :), INTENT(OUT) :: pair_radii
829 :
830 : INTEGER :: ii, jj
831 :
832 60 : pair_radii = 0.0_dp
833 40 : DO ii = 1, nkinds
834 60 : DO jj = 1, nkinds
835 40 : pair_radii(ii, jj) = rcut(ii) + rcut(jj)
836 : END DO
837 : END DO
838 20 : END SUBROUTINE fb_build_pair_radii
839 :
840 0 : END MODULE qs_fb_atomic_halo_types
|
