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 global tree references
10 : !> - BECAUSE acceptance check use global tree randon numbers and
11 : !> (in case of parallel tempering) several global tree node refer to a
12 : !> single sub tree node (which is the changed one in the global tree)
13 : !> - the references are used to update the global tree acceptance probability
14 : !> for every global tree element separately
15 : !> Hence a list of all global tree nodes, using the related subtree node,
16 : !> is created.
17 : !> \par History
18 : !> 11.2012 created [Mandes Schoenherr]
19 : !> \author Mandes
20 : ! **************************************************************************************************
21 :
22 : MODULE tmc_tree_references
23 : USE cp_log_handling, ONLY: cp_to_string
24 : USE tmc_cancelation, ONLY: add_to_canceling_list
25 : USE tmc_tree_types, ONLY: global_tree_type,&
26 : gt_elem_list_type,&
27 : tree_type
28 : USE tmc_types, ONLY: tmc_env_type
29 : #include "../base/base_uses.f90"
30 :
31 : IMPLICIT NONE
32 :
33 : PRIVATE
34 :
35 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tmc_tree_references'
36 :
37 : PUBLIC :: add_to_references
38 : PUBLIC :: search_and_remove_reference_in_list
39 : PUBLIC :: remove_subtree_element_of_all_references
40 : PUBLIC :: remove_gt_references
41 : CONTAINS
42 :
43 : ! **************************************************************************************************
44 : !> \brief adds global tree reference to the modified sub tree element(s)
45 : !> \param gt_elem actual global tree element
46 : !> \author Mandes 12.2012
47 : ! **************************************************************************************************
48 9488 : SUBROUTINE add_to_references(gt_elem)
49 : TYPE(global_tree_type), POINTER :: gt_elem
50 :
51 : CHARACTER(LEN=*), PARAMETER :: routineN = 'add_to_references'
52 :
53 : INTEGER :: handle
54 : TYPE(gt_elem_list_type), POINTER :: tmp_pt_list_elem
55 :
56 4744 : NULLIFY (tmp_pt_list_elem)
57 :
58 4744 : CPASSERT(ASSOCIATED(gt_elem))
59 :
60 : ! start the timing
61 4744 : CALL timeset(routineN, handle)
62 :
63 : ! create reference and add at the beginning of the list
64 4744 : ALLOCATE (tmp_pt_list_elem)
65 4744 : tmp_pt_list_elem%gt_elem => gt_elem
66 4744 : IF (ASSOCIATED(gt_elem%conf(gt_elem%mv_conf)%elem%gt_nodes_references)) THEN
67 142 : tmp_pt_list_elem%next => gt_elem%conf(gt_elem%mv_conf)%elem%gt_nodes_references
68 : ELSE
69 : tmp_pt_list_elem%next => NULL()
70 : END IF
71 4744 : gt_elem%conf(gt_elem%mv_conf)%elem%gt_nodes_references => tmp_pt_list_elem
72 :
73 : ! in case of swapped configurations both are necessary to do acceptance probability update
74 : ! also when second configuration returns a value
75 4744 : IF (gt_elem%swaped) THEN
76 : ! add reference to swapped elem
77 168 : ALLOCATE (tmp_pt_list_elem)
78 168 : tmp_pt_list_elem%gt_elem => gt_elem
79 168 : IF (ASSOCIATED(gt_elem%conf(gt_elem%mv_conf + 1)%elem%gt_nodes_references)) THEN
80 145 : tmp_pt_list_elem%next => gt_elem%conf(gt_elem%mv_conf + 1)%elem%gt_nodes_references
81 : ELSE
82 : tmp_pt_list_elem%next => NULL()
83 : END IF
84 168 : gt_elem%conf(gt_elem%mv_conf + 1)%elem%gt_nodes_references => tmp_pt_list_elem
85 : END IF
86 : ! end the timing
87 4744 : CALL timestop(handle)
88 4744 : END SUBROUTINE add_to_references
89 :
90 : ! **************************************************************************************************
91 : !> \brief removes the global tree references of this actual global tree element
92 : !> from all related sub tree elements
93 : !> \param gt_ptr actual global tree element
94 : !> \param tmc_env ...
95 : !> \author Mandes 12.2012
96 : ! **************************************************************************************************
97 9488 : SUBROUTINE remove_gt_references(gt_ptr, tmc_env)
98 : TYPE(global_tree_type), POINTER :: gt_ptr
99 : TYPE(tmc_env_type), POINTER :: tmc_env
100 :
101 : CHARACTER(LEN=*), PARAMETER :: routineN = 'remove_gt_references'
102 :
103 : INTEGER :: handle
104 :
105 4744 : CPASSERT(ASSOCIATED(gt_ptr))
106 4744 : CPASSERT(ASSOCIATED(tmc_env))
107 :
108 : ! start the timing
109 4744 : CALL timeset(routineN, handle)
110 :
111 : CALL search_and_remove_reference_in_list(gt_ptr=gt_ptr, &
112 4744 : elem=gt_ptr%conf(gt_ptr%mv_conf)%elem, tmc_env=tmc_env)
113 :
114 : ! in case of parallel tempering also the reference in the second swaped configuration has to be removed
115 4744 : IF (gt_ptr%swaped) THEN
116 : CALL search_and_remove_reference_in_list(gt_ptr=gt_ptr, &
117 168 : elem=gt_ptr%conf(gt_ptr%mv_conf + 1)%elem, tmc_env=tmc_env)
118 : END IF
119 : ! end the timing
120 4744 : CALL timestop(handle)
121 4744 : END SUBROUTINE remove_gt_references
122 :
123 : ! **************************************************************************************************
124 : !> \brief removes the pointers to a certain subtree element from every related
125 : !> global tree element
126 : !> \param ptr sub tree element
127 : !> \author Mandes 12.2012
128 : ! **************************************************************************************************
129 20782 : SUBROUTINE remove_subtree_element_of_all_references(ptr)
130 : TYPE(tree_type), POINTER :: ptr
131 :
132 : CHARACTER(LEN=*), PARAMETER :: routineN = 'remove_subtree_element_of_all_references'
133 :
134 : CHARACTER(len=2000) :: list_of_nr
135 : INTEGER :: handle, i
136 : TYPE(gt_elem_list_type), POINTER :: tmp_gt_list_ptr
137 :
138 10391 : NULLIFY (tmp_gt_list_ptr)
139 :
140 10391 : CPASSERT(ASSOCIATED(ptr))
141 :
142 : ! start the timing
143 10391 : CALL timeset(routineN, handle)
144 :
145 10391 : pt_node_ref_loop: DO WHILE (ASSOCIATED(ptr%gt_nodes_references))
146 0 : tmp_gt_list_ptr => ptr%gt_nodes_references
147 0 : CPASSERT(ASSOCIATED(tmp_gt_list_ptr%gt_elem))
148 : CALL cp_abort(__LOCATION__, &
149 : "found reference of global tree node "// &
150 : cp_to_string(tmp_gt_list_ptr%gt_elem%nr)// &
151 : ", while removing sub tree node "// &
152 0 : cp_to_string(ptr%sub_tree_nr)//cp_to_string(ptr%nr))
153 : ! check if configurations exist
154 0 : IF (ASSOCIATED(tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf)%elem)) THEN
155 0 : IF (ASSOCIATED(ptr, tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf)%elem)) THEN
156 0 : tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf)%elem => NULL()
157 : ! in case of swapping the second configuration could be the related one
158 0 : ELSE IF (ASSOCIATED(ptr, tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf + 1)%elem)) THEN
159 0 : tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf + 1)%elem => NULL()
160 : ELSE
161 0 : list_of_nr = ""
162 0 : DO i = 1, SIZE(tmp_gt_list_ptr%gt_elem%conf)
163 0 : WRITE (list_of_nr, *) TRIM(ADJUSTL(list_of_nr)), tmp_gt_list_ptr%gt_elem%conf(i)%elem%sub_tree_nr, &
164 0 : tmp_gt_list_ptr%gt_elem%conf(i)%elem%nr, " | "
165 : END DO
166 : CALL cp_warn(__LOCATION__, &
167 : "for subtree "// &
168 : cp_to_string(ptr%sub_tree_nr)// &
169 : "element "//cp_to_string(ptr%nr)// &
170 : "global tree element"//cp_to_string(tmp_gt_list_ptr%gt_elem%nr)// &
171 : "swaped"//cp_to_string(tmp_gt_list_ptr%gt_elem%swaped)// &
172 : "moved elem"//cp_to_string(tmp_gt_list_ptr%gt_elem%mv_conf)// &
173 : "with the related subtree, elements: "// &
174 0 : TRIM(ADJUSTL(list_of_nr)))
175 : END IF
176 : ELSE
177 : CALL cp_warn(__LOCATION__, &
178 : "for subtree "//cp_to_string(ptr%sub_tree_nr)// &
179 : "element "//cp_to_string(ptr%nr)// &
180 : " is not related to global tree node "//cp_to_string(tmp_gt_list_ptr%gt_elem%nr)// &
181 0 : "(anymore).")
182 : END IF
183 0 : ptr%gt_nodes_references => ptr%gt_nodes_references%next
184 10391 : DEALLOCATE (tmp_gt_list_ptr)
185 : END DO pt_node_ref_loop
186 :
187 : ! end the timing
188 10391 : CALL timestop(handle)
189 :
190 10391 : CPASSERT(.NOT. ASSOCIATED(ptr%gt_nodes_references))
191 10391 : END SUBROUTINE remove_subtree_element_of_all_references
192 :
193 : ! **************************************************************************************************
194 : !> \brief removes the global tree references of this actual global tree element
195 : !> from all related sub tree elements
196 : !> \param gt_ptr actual global tree element
197 : !> \param elem ...
198 : !> \param tmc_env TMC environment
199 : !> \author Mandes 12.2012
200 : ! **************************************************************************************************
201 10178 : SUBROUTINE search_and_remove_reference_in_list(gt_ptr, elem, tmc_env)
202 : TYPE(global_tree_type), POINTER :: gt_ptr
203 : TYPE(tree_type), POINTER :: elem
204 : TYPE(tmc_env_type), POINTER :: tmc_env
205 :
206 : CHARACTER(LEN=*), PARAMETER :: routineN = 'search_and_remove_reference_in_list'
207 :
208 : INTEGER :: handle
209 : TYPE(gt_elem_list_type), POINTER :: tmp_gt_list_last_ptr, tmp_gt_list_ptr
210 :
211 5089 : NULLIFY (tmp_gt_list_ptr, tmp_gt_list_last_ptr)
212 :
213 : ! nothing to do, when subtree element is already deleted
214 5089 : IF (.NOT. ASSOCIATED(elem)) RETURN
215 5089 : IF (.NOT. ASSOCIATED(gt_ptr)) RETURN
216 :
217 5089 : CPASSERT(ASSOCIATED(tmc_env))
218 :
219 : ! start the timing
220 5089 : CALL timeset(routineN, handle)
221 :
222 : ! set the entry point od the list
223 5089 : tmp_gt_list_ptr => elem%gt_nodes_references
224 5089 : tmp_gt_list_last_ptr => elem%gt_nodes_references
225 :
226 : ! search related reference
227 5778 : DO WHILE (ASSOCIATED(tmp_gt_list_ptr))
228 : ! remove reference, if it is related to the global tree element
229 5314 : IF (ASSOCIATED(tmp_gt_list_ptr%gt_elem, gt_ptr)) THEN
230 : ! first reference?
231 4912 : IF (ASSOCIATED(tmp_gt_list_ptr, elem%gt_nodes_references)) THEN
232 : ! additionally last reference (the only one)?
233 4639 : IF (.NOT. ASSOCIATED(tmp_gt_list_ptr%next)) THEN
234 : ! last element in list -> cancel calculation
235 4625 : CALL add_to_canceling_list(elem=elem, tmc_env=tmc_env)
236 4625 : elem%gt_nodes_references => NULL()
237 : tmp_gt_list_last_ptr => NULL()
238 : ELSE
239 : ! if first list element and NOT last one:
240 : ! set list pointer to second element
241 14 : elem%gt_nodes_references => tmp_gt_list_ptr%next
242 14 : tmp_gt_list_last_ptr => elem%gt_nodes_references
243 : END IF
244 : ELSE
245 : ! if NOT first one
246 : ! skip that element in list
247 273 : tmp_gt_list_last_ptr%next => tmp_gt_list_ptr%next
248 : END IF
249 :
250 : ! deallocate list element
251 4912 : DEALLOCATE (tmp_gt_list_ptr)
252 : ! going back to last list element
253 : tmp_gt_list_ptr => tmp_gt_list_last_ptr
254 : END IF
255 : ! setting to next list element
256 5601 : tmp_gt_list_last_ptr => tmp_gt_list_ptr
257 : ! go to next list element, if defined
258 5778 : IF (ASSOCIATED(tmp_gt_list_ptr)) tmp_gt_list_ptr => tmp_gt_list_ptr%next
259 : END DO
260 : ! end the timing
261 5089 : CALL timestop(handle)
262 : END SUBROUTINE search_and_remove_reference_in_list
263 :
264 : END MODULE tmc_tree_references
|
