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_env_types
9 :
10 : USE kinds, ONLY: dp
11 : USE qs_fb_atomic_halo_types, ONLY: fb_atomic_halo_list_associate,&
12 : fb_atomic_halo_list_nullify,&
13 : fb_atomic_halo_list_obj,&
14 : fb_atomic_halo_list_release
15 : USE qs_fb_trial_fns_types, ONLY: fb_trial_fns_associate,&
16 : fb_trial_fns_has_data,&
17 : fb_trial_fns_nullify,&
18 : fb_trial_fns_obj,&
19 : fb_trial_fns_release,&
20 : fb_trial_fns_retain
21 : #include "./base/base_uses.f90"
22 :
23 : IMPLICIT NONE
24 :
25 : PRIVATE
26 :
27 : ! public types
28 : PUBLIC :: fb_env_obj
29 :
30 : ! public methods
31 : PUBLIC :: fb_env_release, &
32 : fb_env_nullify, &
33 : fb_env_has_data, &
34 : fb_env_create, &
35 : fb_env_get, &
36 : fb_env_set
37 :
38 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fb_env_types'
39 :
40 : ! **********************************************************************
41 : !> \brief wrapper to the simulation parameters used for filtered basis
42 : !> method
43 : !> \param rcut : cutoff for included filtered basis set centred at
44 : !> each atom. These defines the ranges of the atomic
45 : !> halos. rcut(ikind) gives the range for atom of
46 : !> global kind ikind
47 : !> \param atomic_halos : stores information on the neighbors of each
48 : !> atom ii, which are defined by rcut
49 : !> \param filter_temperature : parameter controlling the smoothness of
50 : !> the filter function during the construction
51 : !> of the filter matrix
52 : !> \param auto_cutoff_scale : scale multiplied to max atomic orbital
53 : !> radii used for automatic construction of
54 : !> rcut
55 : !> \param eps_default : anything less than it is regarded as zero
56 : !> \param collective_com : whether the MPI communications are
57 : !> to be done collectively together
58 : !> at the start and end of each
59 : !> filter matrix calculation. This makes
60 : !> communication more efficient in the
61 : !> expense of larger memory usage
62 : !> \param local_atoms : atoms corresponding to the
63 : !> atomic halos responsible by this processor
64 : !> \param ref_count : reference counter of this object
65 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
66 : ! **********************************************************************
67 : TYPE fb_env_data
68 : INTEGER :: ref_count = -1
69 : REAL(KIND=dp), DIMENSION(:), POINTER :: rcut => NULL()
70 : TYPE(fb_atomic_halo_list_obj) :: atomic_halos = fb_atomic_halo_list_obj()
71 : TYPE(fb_trial_fns_obj) :: trial_fns = fb_trial_fns_obj()
72 : REAL(KIND=dp) :: filter_temperature = -1.0_dp
73 : REAL(KIND=dp) :: auto_cutoff_scale = -1.0_dp
74 : REAL(KIND=dp) :: eps_default = -1.0_dp
75 : LOGICAL :: collective_com = .FALSE.
76 : INTEGER, DIMENSION(:), POINTER :: local_atoms => NULL()
77 : INTEGER :: nlocal_atoms = -1
78 : END TYPE fb_env_data
79 :
80 : ! **************************************************************************************************
81 : !> \brief the object container which allows for the creation of an array of
82 : !> pointers to fb_env
83 : !> \param obj : pointer to a filtered basis environment
84 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
85 : ! **************************************************************************************************
86 : TYPE fb_env_obj
87 : TYPE(fb_env_data), POINTER, PRIVATE :: obj => NULL()
88 : END TYPE fb_env_obj
89 :
90 : CONTAINS
91 :
92 : ! **********************************************************************
93 : !> \brief retains the given fb_env
94 : !> \param fb_env : the fb_env to retain
95 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
96 : ! **************************************************************************************************
97 0 : SUBROUTINE fb_env_retain(fb_env)
98 : TYPE(fb_env_obj), INTENT(IN) :: fb_env
99 :
100 0 : CPASSERT(ASSOCIATED(fb_env%obj))
101 0 : CPASSERT(fb_env%obj%ref_count > 0)
102 0 : fb_env%obj%ref_count = fb_env%obj%ref_count + 1
103 0 : END SUBROUTINE fb_env_retain
104 :
105 : ! **********************************************************************
106 : !> \brief releases a given fb_env
107 : !> \brief ...
108 : !> \param fb_env : the fb_env to release
109 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
110 : ! **************************************************************************************************
111 10 : SUBROUTINE fb_env_release(fb_env)
112 : TYPE(fb_env_obj), INTENT(INOUT) :: fb_env
113 :
114 10 : IF (ASSOCIATED(fb_env%obj)) THEN
115 10 : CPASSERT(fb_env%obj%ref_count > 0)
116 10 : fb_env%obj%ref_count = fb_env%obj%ref_count - 1
117 10 : IF (fb_env%obj%ref_count == 0) THEN
118 10 : fb_env%obj%ref_count = 1
119 10 : IF (ASSOCIATED(fb_env%obj%rcut)) THEN
120 10 : DEALLOCATE (fb_env%obj%rcut)
121 : END IF
122 10 : IF (ASSOCIATED(fb_env%obj%local_atoms)) THEN
123 10 : DEALLOCATE (fb_env%obj%local_atoms)
124 : END IF
125 10 : CALL fb_atomic_halo_list_release(fb_env%obj%atomic_halos)
126 10 : CALL fb_trial_fns_release(fb_env%obj%trial_fns)
127 10 : fb_env%obj%ref_count = 0
128 10 : DEALLOCATE (fb_env%obj)
129 : END IF
130 : ELSE
131 0 : NULLIFY (fb_env%obj)
132 : END IF
133 10 : END SUBROUTINE fb_env_release
134 :
135 : ! **********************************************************************
136 : !> \brief nullifies a fb_env object, note that this does not
137 : !> release the original object. This procedure is used mainly
138 : !> to nullify the pointer inside the object which is used to
139 : !> point to the actual data content of the object.
140 : !> \param fb_env : its content must be a NULL fb_env pointer on input,
141 : !> and the output returns an empty fb_env object
142 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
143 : ! **************************************************************************************************
144 5599 : SUBROUTINE fb_env_nullify(fb_env)
145 : TYPE(fb_env_obj), INTENT(INOUT) :: fb_env
146 :
147 5599 : NULLIFY (fb_env%obj)
148 5599 : END SUBROUTINE fb_env_nullify
149 :
150 : ! **********************************************************************
151 : !> \brief Associates one fb_env object to another
152 : !> \param a the fb_env object to be associated
153 : !> \param b the fb_env object that a is to be associated to
154 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
155 : ! **************************************************************************************************
156 0 : SUBROUTINE fb_env_associate(a, b)
157 : TYPE(fb_env_obj), INTENT(OUT) :: a
158 : TYPE(fb_env_obj), INTENT(IN) :: b
159 :
160 0 : a%obj => b%obj
161 0 : END SUBROUTINE fb_env_associate
162 :
163 : ! **********************************************************************
164 : !> \brief Checks if a fb_env object is associated with an actual
165 : !> data content or not
166 : !> \param fb_env the fb_env object
167 : !> \return ...
168 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
169 : ! **************************************************************************************************
170 5699 : FUNCTION fb_env_has_data(fb_env) RESULT(res)
171 : TYPE(fb_env_obj), INTENT(IN) :: fb_env
172 : LOGICAL :: res
173 :
174 5699 : res = ASSOCIATED(fb_env%obj)
175 5699 : END FUNCTION fb_env_has_data
176 :
177 : ! **********************************************************************
178 : !> \brief creates an empty fb_env object
179 : !> \param fb_env : its content must be a NULL fb_env pointer on input,
180 : !> and the output returns an empty fb_env object
181 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
182 : ! **************************************************************************************************
183 10 : SUBROUTINE fb_env_create(fb_env)
184 : TYPE(fb_env_obj), INTENT(INOUT) :: fb_env
185 :
186 10 : CPASSERT(.NOT. ASSOCIATED(fb_env%obj))
187 10 : ALLOCATE (fb_env%obj)
188 : NULLIFY (fb_env%obj%rcut)
189 10 : CALL fb_atomic_halo_list_nullify(fb_env%obj%atomic_halos)
190 10 : CALL fb_trial_fns_nullify(fb_env%obj%trial_fns)
191 10 : fb_env%obj%filter_temperature = 0.0_dp
192 10 : fb_env%obj%auto_cutoff_scale = 1.0_dp
193 10 : fb_env%obj%eps_default = 0.0_dp
194 10 : fb_env%obj%collective_com = .TRUE.
195 10 : NULLIFY (fb_env%obj%local_atoms)
196 10 : fb_env%obj%nlocal_atoms = 0
197 10 : fb_env%obj%ref_count = 1
198 10 : END SUBROUTINE fb_env_create
199 :
200 : ! **********************************************************************
201 : !> \brief initialises a fb_env object to become empty
202 : !> \brief ...
203 : !> \param fb_env : the fb_env object, which must not be NULL or
204 : !> UNDEFINED upon entry
205 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
206 : ! **************************************************************************************************
207 0 : SUBROUTINE fb_env_init(fb_env)
208 : TYPE(fb_env_obj), INTENT(INOUT) :: fb_env
209 :
210 0 : CPASSERT(ASSOCIATED(fb_env%obj))
211 0 : IF (ASSOCIATED(fb_env%obj%rcut)) THEN
212 0 : DEALLOCATE (fb_env%obj%rcut)
213 : END IF
214 0 : CALL fb_atomic_halo_list_release(fb_env%obj%atomic_halos)
215 0 : CALL fb_trial_fns_release(fb_env%obj%trial_fns)
216 0 : fb_env%obj%filter_temperature = 0.0_dp
217 0 : fb_env%obj%auto_cutoff_scale = 1.0_dp
218 0 : fb_env%obj%eps_default = 0.0_dp
219 0 : fb_env%obj%collective_com = .TRUE.
220 0 : IF (ASSOCIATED(fb_env%obj%local_atoms)) THEN
221 0 : DEALLOCATE (fb_env%obj%local_atoms)
222 : END IF
223 0 : fb_env%obj%nlocal_atoms = 0
224 0 : END SUBROUTINE fb_env_init
225 :
226 : ! **********************************************************************
227 : !> \brief method to get attributes from a given fb_env object
228 : !> \brief ...
229 : !> \param fb_env : the fb_env object in question
230 : !> \param rcut : outputs pointer to rcut attribute of fb_env (optional)
231 : !> \param filter_temperature : outputs filter_temperature attribute
232 : !> of fb_env (optional)
233 : !> \param auto_cutoff_scale : outputs auto_cutoff_scale attribute
234 : !> of fb_env (optional)
235 : !> \param eps_default : outputs eps_default attribute
236 : !> of fb_env (optional)
237 : !> \param atomic_halos : outputs pointer to atomic_halos
238 : !> attribute of fb_env (optional)
239 : !> \param trial_fns : outputs pointer to trial_fns
240 : !> attribute of fb_env (optional)
241 : !> \param collective_com : outputs pointer to trial_fns
242 : !> \param local_atoms : outputs pointer to local_atoms
243 : !> \param nlocal_atoms : outputs pointer to nlocal_atoms
244 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
245 : ! **************************************************************************************************
246 280 : SUBROUTINE fb_env_get(fb_env, &
247 : rcut, &
248 : filter_temperature, &
249 : auto_cutoff_scale, &
250 : eps_default, &
251 : atomic_halos, &
252 : trial_fns, &
253 : collective_com, &
254 : local_atoms, &
255 : nlocal_atoms)
256 : TYPE(fb_env_obj), INTENT(IN) :: fb_env
257 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: rcut
258 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: filter_temperature, auto_cutoff_scale, &
259 : eps_default
260 : TYPE(fb_atomic_halo_list_obj), INTENT(OUT), &
261 : OPTIONAL :: atomic_halos
262 : TYPE(fb_trial_fns_obj), INTENT(OUT), OPTIONAL :: trial_fns
263 : LOGICAL, INTENT(OUT), OPTIONAL :: collective_com
264 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: local_atoms
265 : INTEGER, INTENT(OUT), OPTIONAL :: nlocal_atoms
266 :
267 280 : CPASSERT(ASSOCIATED(fb_env%obj))
268 280 : CPASSERT(fb_env%obj%ref_count > 0)
269 280 : IF (PRESENT(rcut)) &
270 30 : rcut => fb_env%obj%rcut
271 280 : IF (PRESENT(filter_temperature)) &
272 90 : filter_temperature = fb_env%obj%filter_temperature
273 280 : IF (PRESENT(auto_cutoff_scale)) &
274 20 : auto_cutoff_scale = fb_env%obj%auto_cutoff_scale
275 280 : IF (PRESENT(eps_default)) &
276 80 : eps_default = fb_env%obj%eps_default
277 280 : IF (PRESENT(atomic_halos)) &
278 80 : CALL fb_atomic_halo_list_associate(atomic_halos, fb_env%obj%atomic_halos)
279 280 : IF (PRESENT(trial_fns)) &
280 80 : CALL fb_trial_fns_associate(trial_fns, fb_env%obj%trial_fns)
281 280 : IF (PRESENT(collective_com)) &
282 90 : collective_com = fb_env%obj%collective_com
283 280 : IF (PRESENT(local_atoms)) &
284 10 : local_atoms => fb_env%obj%local_atoms
285 280 : IF (PRESENT(nlocal_atoms)) &
286 10 : nlocal_atoms = fb_env%obj%nlocal_atoms
287 280 : END SUBROUTINE fb_env_get
288 :
289 : ! **********************************************************************
290 : !> \brief method to set attributes from a given fb_env object
291 : !> \brief ...
292 : !> \param fb_env : the fb_env object in question
293 : !> \param rcut : sets rcut attribute of fb_env (optional)
294 : !> \param filter_temperature : sets filter_temperature attribute of fb_env (optional)
295 : !> \param auto_cutoff_scale : sets auto_cutoff_scale attribute of fb_env (optional)
296 : !> \param eps_default : sets eps_default attribute of fb_env (optional)
297 : !> \param atomic_halos : sets atomic_halos attribute of fb_env (optional)
298 : !> \param trial_fns : sets trial_fns attribute of fb_env (optional)
299 : !> \param collective_com : sets collective_com attribute of fb_env (optional)
300 : !> \param local_atoms : sets local_atoms attribute of fb_env (optional)
301 : !> \param nlocal_atoms : sets nlocal_atoms attribute of fb_env (optional)
302 : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
303 : ! **************************************************************************************************
304 150 : SUBROUTINE fb_env_set(fb_env, &
305 : rcut, &
306 : filter_temperature, &
307 : auto_cutoff_scale, &
308 : eps_default, &
309 : atomic_halos, &
310 : trial_fns, &
311 : collective_com, &
312 : local_atoms, &
313 : nlocal_atoms)
314 : TYPE(fb_env_obj), INTENT(INOUT) :: fb_env
315 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: rcut
316 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: filter_temperature, auto_cutoff_scale, &
317 : eps_default
318 : TYPE(fb_atomic_halo_list_obj), INTENT(IN), &
319 : OPTIONAL :: atomic_halos
320 : TYPE(fb_trial_fns_obj), INTENT(IN), OPTIONAL :: trial_fns
321 : LOGICAL, INTENT(IN), OPTIONAL :: collective_com
322 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: local_atoms
323 : INTEGER, INTENT(IN), OPTIONAL :: nlocal_atoms
324 :
325 150 : CPASSERT(ASSOCIATED(fb_env%obj))
326 150 : IF (PRESENT(rcut)) THEN
327 10 : IF (ASSOCIATED(fb_env%obj%rcut)) THEN
328 0 : DEALLOCATE (fb_env%obj%rcut)
329 : END IF
330 10 : fb_env%obj%rcut => rcut
331 : END IF
332 150 : IF (PRESENT(filter_temperature)) &
333 10 : fb_env%obj%filter_temperature = filter_temperature
334 150 : IF (PRESENT(auto_cutoff_scale)) &
335 10 : fb_env%obj%auto_cutoff_scale = auto_cutoff_scale
336 150 : IF (PRESENT(eps_default)) &
337 10 : fb_env%obj%eps_default = eps_default
338 150 : IF (PRESENT(atomic_halos)) THEN
339 10 : CALL fb_atomic_halo_list_release(fb_env%obj%atomic_halos)
340 10 : CALL fb_atomic_halo_list_associate(fb_env%obj%atomic_halos, atomic_halos)
341 : END IF
342 150 : IF (PRESENT(trial_fns)) THEN
343 80 : IF (fb_trial_fns_has_data(trial_fns)) &
344 80 : CALL fb_trial_fns_retain(trial_fns)
345 80 : CALL fb_trial_fns_release(fb_env%obj%trial_fns)
346 80 : CALL fb_trial_fns_associate(fb_env%obj%trial_fns, trial_fns)
347 : END IF
348 150 : IF (PRESENT(collective_com)) &
349 10 : fb_env%obj%collective_com = collective_com
350 150 : IF (PRESENT(local_atoms)) THEN
351 10 : IF (ASSOCIATED(fb_env%obj%local_atoms)) THEN
352 0 : DEALLOCATE (fb_env%obj%local_atoms)
353 : END IF
354 10 : fb_env%obj%local_atoms => local_atoms
355 : END IF
356 150 : IF (PRESENT(nlocal_atoms)) &
357 10 : fb_env%obj%nlocal_atoms = nlocal_atoms
358 150 : END SUBROUTINE fb_env_set
359 :
360 0 : END MODULE qs_fb_env_types
|