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