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 : ! **************************************************************************************************
9 : !> \brief represent a group ofunctional derivatives
10 : !> \par History
11 : !> 11.2003 created [fawzi]
12 : !> \author fawzi & thomas
13 : ! **************************************************************************************************
14 : MODULE xc_derivative_set_types
15 : USE cp_linked_list_xc_deriv, ONLY: cp_sll_xc_deriv_dealloc,&
16 : cp_sll_xc_deriv_insert_el,&
17 : cp_sll_xc_deriv_next,&
18 : cp_sll_xc_deriv_type
19 : USE kinds, ONLY: dp
20 : USE message_passing, ONLY: mp_comm_self
21 : USE pw_grid_types, ONLY: pw_grid_type
22 : USE pw_grids, ONLY: pw_grid_create,&
23 : pw_grid_release
24 : USE pw_methods, ONLY: pw_zero
25 : USE pw_pool_types, ONLY: pw_pool_create,&
26 : pw_pool_release,&
27 : pw_pool_type
28 : USE pw_types, ONLY: pw_r3d_rs_type
29 : USE xc_derivative_desc, ONLY: standardize_desc
30 : USE xc_derivative_types, ONLY: xc_derivative_create,&
31 : xc_derivative_release,&
32 : xc_derivative_type
33 : #include "../base/base_uses.f90"
34 :
35 : IMPLICIT NONE
36 : PRIVATE
37 :
38 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
39 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_derivative_set_types'
40 :
41 : PUBLIC :: xc_derivative_set_type
42 : PUBLIC :: xc_dset_create, xc_dset_release, &
43 : xc_dset_get_derivative, xc_dset_zero_all, xc_dset_recover_pw
44 :
45 : ! **************************************************************************************************
46 : !> \brief A derivative set contains the different derivatives of a xc-functional
47 : !> in form of a linked list
48 : ! **************************************************************************************************
49 : TYPE xc_derivative_set_type
50 : TYPE(pw_pool_type), POINTER, PRIVATE :: pw_pool => NULL()
51 : TYPE(cp_sll_xc_deriv_type), POINTER :: derivs => NULL()
52 : END TYPE xc_derivative_set_type
53 :
54 : CONTAINS
55 :
56 : ! **************************************************************************************************
57 : !> \brief returns the requested xc_derivative
58 : !> \param derivative_set the set where to search for the derivative
59 : !> \param description the description of the derivative you want to have
60 : !> \param allocate_deriv if the derivative should be allocated when not present
61 : !> Defaults to false.
62 : !> \return ...
63 : ! **************************************************************************************************
64 2267690 : FUNCTION xc_dset_get_derivative(derivative_set, description, allocate_deriv) &
65 : RESULT(res)
66 :
67 : TYPE(xc_derivative_set_type), INTENT(IN) :: derivative_set
68 : INTEGER, DIMENSION(:), INTENT(in) :: description
69 : LOGICAL, INTENT(in), OPTIONAL :: allocate_deriv
70 : TYPE(xc_derivative_type), POINTER :: res
71 :
72 2267690 : INTEGER, ALLOCATABLE, DIMENSION(:) :: std_deriv_desc
73 : LOGICAL :: my_allocate_deriv
74 : REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), &
75 2267690 : POINTER :: r3d_ptr
76 : TYPE(cp_sll_xc_deriv_type), POINTER :: pos
77 : TYPE(xc_derivative_type), POINTER :: deriv_att
78 :
79 2267690 : NULLIFY (pos, deriv_att, r3d_ptr)
80 :
81 2267690 : my_allocate_deriv = .FALSE.
82 806851 : IF (PRESENT(allocate_deriv)) my_allocate_deriv = allocate_deriv
83 2267690 : NULLIFY (res)
84 2267690 : CALL standardize_desc(description, std_deriv_desc)
85 2267690 : pos => derivative_set%derivs
86 9243157 : DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
87 9243157 : IF (SIZE(deriv_att%split_desc) == SIZE(std_deriv_desc)) THEN
88 6088691 : IF (ALL(deriv_att%split_desc == std_deriv_desc)) THEN
89 901670 : res => deriv_att
90 901670 : EXIT
91 : END IF
92 : END IF
93 : END DO
94 2267690 : IF (.NOT. ASSOCIATED(res) .AND. my_allocate_deriv) THEN
95 549841 : CALL derivative_set%pw_pool%create_cr3d(r3d_ptr)
96 19743772765 : r3d_ptr = 0.0_dp
97 549841 : ALLOCATE (res)
98 : CALL xc_derivative_create(res, std_deriv_desc, &
99 549841 : r3d_ptr=r3d_ptr)
100 549841 : CALL cp_sll_xc_deriv_insert_el(derivative_set%derivs, res)
101 : END IF
102 4535380 : END FUNCTION xc_dset_get_derivative
103 :
104 : ! **************************************************************************************************
105 : !> \brief creates a derivative set object
106 : !> \param derivative_set the set where to search for the derivative
107 : !> \param pw_pool pool where to get the cr3d arrays needed to store the
108 : !> derivatives
109 : !> \param local_bounds ...
110 : ! **************************************************************************************************
111 184793 : SUBROUTINE xc_dset_create(derivative_set, pw_pool, local_bounds)
112 :
113 : TYPE(xc_derivative_set_type), INTENT(OUT) :: derivative_set
114 : TYPE(pw_pool_type), OPTIONAL, POINTER :: pw_pool
115 : INTEGER, DIMENSION(2, 3), INTENT(IN), OPTIONAL :: local_bounds
116 :
117 : TYPE(pw_grid_type), POINTER :: pw_grid
118 :
119 184793 : NULLIFY (pw_grid)
120 :
121 184793 : IF (PRESENT(pw_pool)) THEN
122 128317 : derivative_set%pw_pool => pw_pool
123 128317 : CALL pw_pool%retain()
124 128317 : IF (PRESENT(local_bounds)) THEN
125 0 : IF (ANY(pw_pool%pw_grid%bounds_local /= local_bounds)) &
126 0 : CPABORT("incompatible local_bounds and pw_pool")
127 : END IF
128 : ELSE
129 : !FM ugly hack, should be replaced by a pool only for 3d arrays
130 56476 : CPASSERT(PRESENT(local_bounds))
131 56476 : CALL pw_grid_create(pw_grid, mp_comm_self)
132 564760 : pw_grid%bounds_local = local_bounds
133 56476 : CALL pw_pool_create(derivative_set%pw_pool, pw_grid)
134 56476 : CALL pw_grid_release(pw_grid)
135 : END IF
136 :
137 184793 : END SUBROUTINE xc_dset_create
138 :
139 : ! **************************************************************************************************
140 : !> \brief releases a derivative set
141 : !> \param derivative_set the set to release
142 : ! **************************************************************************************************
143 184793 : SUBROUTINE xc_dset_release(derivative_set)
144 :
145 : TYPE(xc_derivative_set_type) :: derivative_set
146 :
147 : TYPE(cp_sll_xc_deriv_type), POINTER :: pos
148 : TYPE(xc_derivative_type), POINTER :: deriv_att
149 :
150 184793 : NULLIFY (deriv_att, pos)
151 :
152 184793 : pos => derivative_set%derivs
153 734634 : DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
154 549841 : CALL xc_derivative_release(deriv_att, pw_pool=derivative_set%pw_pool)
155 549841 : DEALLOCATE (deriv_att)
156 : END DO
157 184793 : CALL cp_sll_xc_deriv_dealloc(derivative_set%derivs)
158 184793 : IF (ASSOCIATED(derivative_set%pw_pool)) CALL pw_pool_release(derivative_set%pw_pool)
159 :
160 184793 : END SUBROUTINE xc_dset_release
161 :
162 : ! **************************************************************************************************
163 : !> \brief ...
164 : !> \param deriv_set ...
165 : ! **************************************************************************************************
166 68482 : SUBROUTINE xc_dset_zero_all(deriv_set)
167 :
168 : TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
169 :
170 : TYPE(cp_sll_xc_deriv_type), POINTER :: pos
171 : TYPE(xc_derivative_type), POINTER :: deriv_att
172 :
173 68482 : NULLIFY (pos, deriv_att)
174 :
175 68482 : IF (ASSOCIATED(deriv_set%derivs)) THEN
176 26907 : pos => deriv_set%derivs
177 110247 : DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
178 244660485 : deriv_att%deriv_data = 0.0_dp
179 : END DO
180 : END IF
181 :
182 68482 : END SUBROUTINE xc_dset_zero_all
183 :
184 : ! **************************************************************************************************
185 : !> \brief Recovers a derivative on a pw_r3d_rs_type, the caller is responsible to release the grid later
186 : !> If the derivative is not found, either creates a blank pw_r3d_rs_type from pw_pool or leaves it unassociated
187 : !> \param deriv_set ...
188 : !> \param description ...
189 : !> \param pw ...
190 : !> \param pw_grid ...
191 : !> \param pw_pool create pw from this pool if derivative not found
192 : ! **************************************************************************************************
193 243603 : SUBROUTINE xc_dset_recover_pw(deriv_set, description, pw, pw_grid, pw_pool)
194 : TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
195 : INTEGER, DIMENSION(:), INTENT(IN) :: description
196 : TYPE(pw_r3d_rs_type), INTENT(OUT) :: pw
197 : TYPE(pw_grid_type), INTENT(IN), POINTER :: pw_grid
198 : TYPE(pw_pool_type), INTENT(IN), OPTIONAL, POINTER :: pw_pool
199 :
200 : TYPE(xc_derivative_type), POINTER :: deriv_att
201 :
202 243603 : deriv_att => xc_dset_get_derivative(deriv_set, description)
203 243603 : IF (ASSOCIATED(deriv_att)) THEN
204 242981 : CALL pw%create(pw_grid=pw_grid, array_ptr=deriv_att%deriv_data)
205 242981 : NULLIFY (deriv_att%deriv_data)
206 622 : ELSE IF (PRESENT(pw_pool)) THEN
207 622 : CALL pw_pool%create_pw(pw)
208 622 : CALL pw_zero(pw)
209 : END IF
210 :
211 243603 : END SUBROUTINE xc_dset_recover_pw
212 :
213 0 : END MODULE xc_derivative_set_types
|
