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 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 2307698 : 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 2307698 : INTEGER, ALLOCATABLE, DIMENSION(:) :: std_deriv_desc
72 : LOGICAL :: my_allocate_deriv
73 : REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), &
74 2307698 : POINTER :: r3d_ptr
75 : TYPE(cp_sll_xc_deriv_type), POINTER :: pos
76 : TYPE(xc_derivative_type), POINTER :: deriv_att
77 :
78 2307698 : NULLIFY (pos, deriv_att, r3d_ptr)
79 :
80 2307698 : my_allocate_deriv = .FALSE.
81 828399 : IF (PRESENT(allocate_deriv)) my_allocate_deriv = allocate_deriv
82 2307698 : NULLIFY (res)
83 2307698 : CALL standardize_desc(description, std_deriv_desc)
84 2307698 : pos => derivative_set%derivs
85 9391479 : DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
86 9391479 : IF (SIZE(deriv_att%split_desc) == SIZE(std_deriv_desc)) THEN
87 6181484 : IF (ALL(deriv_att%split_desc == std_deriv_desc)) THEN
88 916017 : res => deriv_att
89 916017 : EXIT
90 : END IF
91 : END IF
92 : END DO
93 2307698 : IF (.NOT. ASSOCIATED(res) .AND. my_allocate_deriv) THEN
94 563614 : CALL derivative_set%pw_pool%create_cr3d(r3d_ptr)
95 20137271792 : r3d_ptr = 0.0_dp
96 563614 : ALLOCATE (res)
97 : CALL xc_derivative_create(res, std_deriv_desc, &
98 563614 : r3d_ptr=r3d_ptr)
99 563614 : CALL cp_sll_xc_deriv_insert_el(derivative_set%derivs, res)
100 : END IF
101 4615396 : 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 189253 : 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 189253 : NULLIFY (pw_grid)
119 :
120 189253 : IF (PRESENT(pw_pool)) THEN
121 130187 : derivative_set%pw_pool => pw_pool
122 130187 : CALL pw_pool%retain()
123 130187 : 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 59066 : CPASSERT(PRESENT(local_bounds))
130 59066 : CALL pw_grid_create(pw_grid, local_bounds)
131 59066 : CALL pw_pool_create(derivative_set%pw_pool, pw_grid)
132 59066 : CALL pw_grid_release(pw_grid)
133 : END IF
134 :
135 189253 : END SUBROUTINE xc_dset_create
136 :
137 : ! **************************************************************************************************
138 : !> \brief releases a derivative set
139 : !> \param derivative_set the set to release
140 : ! **************************************************************************************************
141 189253 : 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 189253 : NULLIFY (deriv_att, pos)
149 :
150 189253 : pos => derivative_set%derivs
151 752867 : DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
152 563614 : CALL xc_derivative_release(deriv_att, pw_pool=derivative_set%pw_pool)
153 563614 : DEALLOCATE (deriv_att)
154 : END DO
155 189253 : CALL cp_sll_xc_deriv_dealloc(derivative_set%derivs)
156 189253 : IF (ASSOCIATED(derivative_set%pw_pool)) CALL pw_pool_release(derivative_set%pw_pool)
157 :
158 189253 : END SUBROUTINE xc_dset_release
159 :
160 : ! **************************************************************************************************
161 : !> \brief ...
162 : !> \param deriv_set ...
163 : ! **************************************************************************************************
164 71138 : 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 71138 : NULLIFY (pos, deriv_att)
172 :
173 71138 : IF (ASSOCIATED(deriv_set%derivs)) THEN
174 26948 : pos => deriv_set%derivs
175 110463 : DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att))
176 245137726 : deriv_att%deriv_data = 0.0_dp
177 : END DO
178 : END IF
179 :
180 71138 : 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 246609 : 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 246609 : deriv_att => xc_dset_get_derivative(deriv_set, description)
201 246609 : IF (ASSOCIATED(deriv_att)) THEN
202 245987 : CALL pw%create(pw_grid=pw_grid, array_ptr=deriv_att%deriv_data)
203 245987 : NULLIFY (deriv_att%deriv_data)
204 622 : ELSE IF (PRESENT(pw_pool)) THEN
205 622 : CALL pw_pool%create_pw(pw)
206 622 : CALL pw_zero(pw)
207 : END IF
208 :
209 246609 : END SUBROUTINE xc_dset_recover_pw
210 :
211 0 : END MODULE xc_derivative_set_types
|
