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