Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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 2453823 : 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 2453823 : INTEGER, ALLOCATABLE, DIMENSION(:) :: std_deriv_desc
72 : LOGICAL :: my_allocate_deriv
73 : REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), &
74 2453823 : POINTER :: r3d_ptr
75 : TYPE(cp_sll_xc_deriv_type), POINTER :: pos
76 : TYPE(xc_derivative_type), POINTER :: deriv_att
77 :
78 2453823 : NULLIFY (pos, deriv_att, r3d_ptr)
79 :
80 2453823 : my_allocate_deriv = .FALSE.
81 874010 : IF (PRESENT(allocate_deriv)) my_allocate_deriv = allocate_deriv
82 2453823 : NULLIFY (res)
83 2453823 : CALL standardize_desc(description, std_deriv_desc)
84 2453823 : pos => derivative_set%derivs
85 10422288 : DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
86 10422288 : IF (SIZE(deriv_att%split_desc) == SIZE(std_deriv_desc)) THEN
87 6948810 : IF (ALL(deriv_att%split_desc == std_deriv_desc)) THEN
88 994651 : res => deriv_att
89 994651 : EXIT
90 : END IF
91 : END IF
92 : END DO
93 2453823 : IF (.NOT. ASSOCIATED(res) .AND. my_allocate_deriv) THEN
94 591518 : CALL derivative_set%pw_pool%create_cr3d(r3d_ptr)
95 22155481484 : r3d_ptr = 0.0_dp
96 591518 : ALLOCATE (res)
97 : CALL xc_derivative_create(res, std_deriv_desc, &
98 591518 : r3d_ptr=r3d_ptr)
99 591518 : CALL cp_sll_xc_deriv_insert_el(derivative_set%derivs, res)
100 : END IF
101 4907646 : 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 199175 : 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 199175 : NULLIFY (pw_grid)
119 :
120 199175 : IF (PRESENT(pw_pool)) THEN
121 136511 : derivative_set%pw_pool => pw_pool
122 136511 : CALL pw_pool%retain()
123 136511 : IF (PRESENT(local_bounds)) THEN
124 0 : IF (ANY(pw_pool%pw_grid%bounds_local /= local_bounds)) &
125 0 : CPABORT("incompatible local_bounds and pw_pool")
126 : END IF
127 : ELSE
128 : !FM ugly hack, should be replaced by a pool only for 3d arrays
129 62664 : CPASSERT(PRESENT(local_bounds))
130 62664 : CALL pw_grid_create(pw_grid, local_bounds)
131 62664 : CALL pw_pool_create(derivative_set%pw_pool, pw_grid)
132 62664 : CALL pw_grid_release(pw_grid)
133 : END IF
134 :
135 199175 : END SUBROUTINE xc_dset_create
136 :
137 : ! **************************************************************************************************
138 : !> \brief releases a derivative set
139 : !> \param derivative_set the set to release
140 : ! **************************************************************************************************
141 199175 : SUBROUTINE xc_dset_release(derivative_set)
142 :
143 : TYPE(xc_derivative_set_type) :: derivative_set
144 :
145 : TYPE(cp_sll_xc_deriv_type), POINTER :: pos
146 : TYPE(xc_derivative_type), POINTER :: deriv_att
147 :
148 199175 : NULLIFY (deriv_att, pos)
149 :
150 199175 : pos => derivative_set%derivs
151 790693 : DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
152 591518 : CALL xc_derivative_release(deriv_att, pw_pool=derivative_set%pw_pool)
153 591518 : DEALLOCATE (deriv_att)
154 : END DO
155 199175 : CALL cp_sll_xc_deriv_dealloc(derivative_set%derivs)
156 199175 : IF (ASSOCIATED(derivative_set%pw_pool)) CALL pw_pool_release(derivative_set%pw_pool)
157 :
158 199175 : END SUBROUTINE xc_dset_release
159 :
160 : ! **************************************************************************************************
161 : !> \brief ...
162 : !> \param deriv_set ...
163 : ! **************************************************************************************************
164 76634 : SUBROUTINE xc_dset_zero_all(deriv_set)
165 :
166 : TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
167 :
168 : TYPE(cp_sll_xc_deriv_type), POINTER :: pos
169 : TYPE(xc_derivative_type), POINTER :: deriv_att
170 :
171 76634 : NULLIFY (pos, deriv_att)
172 :
173 76634 : IF (ASSOCIATED(deriv_set%derivs)) THEN
174 30059 : pos => deriv_set%derivs
175 123852 : DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
176 271676293 : deriv_att%deriv_data = 0.0_dp
177 : END DO
178 : END IF
179 :
180 76634 : END SUBROUTINE xc_dset_zero_all
181 :
182 : ! **************************************************************************************************
183 : !> \brief Recovers a derivative on a pw_r3d_rs_type, the caller is responsible to release the grid later
184 : !> If the derivative is not found, either creates a blank pw_r3d_rs_type from pw_pool or leaves it unassociated
185 : !> \param deriv_set ...
186 : !> \param description ...
187 : !> \param pw ...
188 : !> \param pw_grid ...
189 : !> \param pw_pool create pw from this pool if derivative not found
190 : ! **************************************************************************************************
191 253273 : SUBROUTINE xc_dset_recover_pw(deriv_set, description, pw, pw_grid, pw_pool)
192 : TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
193 : INTEGER, DIMENSION(:), INTENT(IN) :: description
194 : TYPE(pw_r3d_rs_type), INTENT(OUT) :: pw
195 : TYPE(pw_grid_type), INTENT(IN), POINTER :: pw_grid
196 : TYPE(pw_pool_type), INTENT(IN), OPTIONAL, POINTER :: pw_pool
197 :
198 : TYPE(xc_derivative_type), POINTER :: deriv_att
199 :
200 253273 : deriv_att => xc_dset_get_derivative(deriv_set, description)
201 253273 : IF (ASSOCIATED(deriv_att)) THEN
202 252653 : CALL pw%create(pw_grid=pw_grid, array_ptr=deriv_att%deriv_data)
203 252653 : NULLIFY (deriv_att%deriv_data)
204 620 : ELSE IF (PRESENT(pw_pool)) THEN
205 620 : CALL pw_pool%create_pw(pw)
206 620 : CALL pw_zero(pw)
207 : END IF
208 :
209 253273 : END SUBROUTINE xc_dset_recover_pw
210 :
211 0 : END MODULE xc_derivative_set_types
|
