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 module handles definition of the tree nodes for the global and
10 : !> the subtrees binary tree
11 : !> parent element
12 : !> / \
13 : !> accepted (acc) / \ not accepted (nacc)
14 : !> / \
15 : !> child child
16 : !> / \ / \
17 : !>
18 : !> tree creation assuming acceptance (acc) AND rejectance (nacc)
19 : !> of configuration
20 : !> if configuration is accepted: new configuration (child on acc) on basis
21 : !> of last configuration (one level up)
22 : !> if configuration is rejected: child on nacc on basis of last accepted
23 : !> element (last element which is on acc brach of its parent element)
24 : !> The global tree handles all configurations of different subtrees.
25 : !> The structure element "conf" is an array related to the temperature
26 : !> (sorted) and points to the subtree elements.
27 : !> \par History
28 : !> 11.2012 created [Mandes Schoenherr]
29 : !> \author Mandes
30 : ! **************************************************************************************************
31 :
32 : MODULE tmc_tree_types
33 : USE kinds, ONLY: dp
34 : #include "../base/base_uses.f90"
35 :
36 : IMPLICIT NONE
37 :
38 : PRIVATE
39 :
40 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tmc_tree_types'
41 :
42 : PUBLIC :: tree_type, global_tree_type
43 : PUBLIC :: elem_list_type, elem_array_type, gt_elem_list_type
44 : PUBLIC :: add_to_list, clean_list
45 : PUBLIC :: read_subtree_elem_unformated, write_subtree_elem_unformated
46 :
47 : !-- tree element status
48 : INTEGER, PARAMETER, PUBLIC :: status_created = 100
49 : INTEGER, PARAMETER, PUBLIC :: status_calculate_energy = 101
50 : INTEGER, PARAMETER, PUBLIC :: status_calc_approx_ener = 102
51 :
52 : INTEGER, PARAMETER, PUBLIC :: status_calculate_NMC_steps = 111
53 : INTEGER, PARAMETER, PUBLIC :: status_calculate_MD = 112
54 : INTEGER, PARAMETER, PUBLIC :: status_calculated = 113
55 :
56 : INTEGER, PARAMETER, PUBLIC :: status_accepted_result = 123
57 : INTEGER, PARAMETER, PUBLIC :: status_accepted = 122
58 : INTEGER, PARAMETER, PUBLIC :: status_rejected = 121
59 : INTEGER, PARAMETER, PUBLIC :: status_rejected_result = 120
60 :
61 : INTEGER, PARAMETER, PUBLIC :: status_cancel_nmc = 133
62 : INTEGER, PARAMETER, PUBLIC :: status_cancel_ener = 132
63 : INTEGER, PARAMETER, PUBLIC :: status_canceled_nmc = 131
64 : INTEGER, PARAMETER, PUBLIC :: status_canceled_ener = 130
65 :
66 : INTEGER, PARAMETER, PUBLIC :: status_deleted = 140
67 : INTEGER, PARAMETER, PUBLIC :: status_deleted_result = 141
68 :
69 : !-- dimension status (for e.g. dividing atoms in sub box)
70 : INTEGER, PARAMETER, PUBLIC :: status_ok = 42
71 : INTEGER, PARAMETER, PUBLIC :: status_frozen = -1
72 : INTEGER, PARAMETER, PUBLIC :: status_proton_disorder = 1
73 :
74 : !-- subtree element
75 : TYPE tree_type
76 : TYPE(tree_type), POINTER :: parent => NULL() ! points to element one level up
77 : !-- acc..accepted goes to next level (next step),
78 : ! nacc..not accepted takes an alternative configutation
79 : TYPE(tree_type), POINTER :: acc => NULL(), nacc => NULL()
80 : !-- type of MC move (swap is handled only in global tree)
81 : INTEGER :: move_type = -1
82 : !-- status (e.g. calculated, MD calculation, accepted...)
83 : INTEGER :: stat = status_created
84 : REAL(KIND=dp), DIMENSION(:), POINTER :: subbox_center => NULL()
85 : REAL(KIND=dp), DIMENSION(:), POINTER :: pos => NULL() ! position array
86 : INTEGER, DIMENSION(:), POINTER :: mol => NULL() ! specifies the molecules the atoms participate
87 : REAL(KIND=dp), DIMENSION(:), POINTER :: vel => NULL() ! velocity array
88 : REAL(KIND=dp), DIMENSION(:), POINTER :: frc => NULL() ! force array
89 : REAL(KIND=dp), DIMENSION(:), POINTER :: dipole => NULL() ! dipole moments array
90 : INTEGER, DIMENSION(:), POINTER :: elem_stat => NULL() ! status for every dimension
91 : INTEGER :: nr = -1 ! tree node number
92 : REAL(KIND=dp), DIMENSION(3, 2, 3) :: rng_seed = 0 ! random seed for childs
93 : !-- remembers which subtree number element is from
94 : INTEGER :: sub_tree_nr = -1
95 : !-- remembers the temperature the configurational change (NMC) is done with
96 : INTEGER :: temp_created = 0
97 : !-- pointer to counter of next subtree element number
98 : INTEGER, POINTER :: next_elem_nr => NULL()
99 : !-- for calculating the NPT ensamble, variable box sizes are necessary.
100 : REAL(KIND=dp), DIMENSION(:), POINTER :: box_scale => NULL()
101 : REAL(KIND=dp) :: potential = 0.0_dp ! potential energy
102 : !-- potential energy calculated using (MD potential) cp2k input file
103 : REAL(KIND=dp) :: e_pot_approx = 0.0_dp
104 : !-- kinetic energy (espacially for HMC, where the velocities are respected)
105 : REAL(KIND=dp) :: ekin = 0.0_dp
106 : !-- kinetic energy before md steps (after gaussian velocity change)
107 : REAL(KIND=dp) :: ekin_before_md = 0.0_dp
108 : !-- estimated energies are stored in loop order in this array
109 : REAL(KIND=dp), DIMENSION(4) :: scf_energies = 0.0_dp
110 : !-- counter to get last position in the array loop
111 : INTEGER :: scf_energies_count = 0
112 : !-- list of global tree elements referint to that node (reference back to global tree)
113 : ! if no reference exist anymore, global tree element can be deleted
114 : TYPE(gt_elem_list_type), POINTER :: gt_nodes_references => NULL()
115 : END TYPE tree_type
116 :
117 : ! type for global tree element list in tree elements
118 : TYPE gt_elem_list_type
119 : TYPE(global_tree_type), POINTER :: gt_elem => NULL()
120 : TYPE(gt_elem_list_type), POINTER :: next => NULL()
121 : END TYPE gt_elem_list_type
122 :
123 : TYPE elem_list_type
124 : TYPE(tree_type), POINTER :: elem => NULL()
125 : TYPE(elem_list_type), POINTER :: next => NULL()
126 : INTEGER :: temp_ind = 0
127 : INTEGER :: nr = -1
128 : END TYPE elem_list_type
129 :
130 : !-- array with subtree elements
131 : TYPE elem_array_type
132 : TYPE(tree_type), POINTER :: elem => NULL()
133 : LOGICAL :: busy = .FALSE.
134 : LOGICAL :: canceled = .FALSE.
135 : REAL(KIND=dp) :: start_time = 0.0_dp
136 : END TYPE elem_array_type
137 :
138 : !-- global tree element
139 : TYPE global_tree_type
140 : TYPE(global_tree_type), POINTER :: parent => NULL() ! points to element one level up
141 : !-- acc..accepted goes to next level (next step),
142 : ! nacc..not accepted takes an alternative configutation
143 : TYPE(global_tree_type), POINTER :: acc => NULL(), nacc => NULL()
144 : !-- status (e.g. calculated, MD calculation, accepted...)
145 : INTEGER :: stat = -99
146 : !-- remember if configuration in node are swaped
147 : LOGICAL :: swaped = .FALSE.
148 : !-- stores the index of the configuration (temperature)
149 : ! which is changed
150 : INTEGER :: mv_conf = -54321
151 : !-- stores the index of the configuration (temp.) which should change next
152 : INTEGER :: mv_next_conf = -2345
153 : !-- list of pointes to subtree elements (Temp sorting)
154 : TYPE(elem_array_type), DIMENSION(:), ALLOCATABLE :: conf
155 : !-- remembers if last configuration is assumed to be accepted or rejected (next branc in tree);
156 : ! In case of swaping, it shows if the configuration of a certain temperature is assumed
157 : ! to be acc/rej (which branch is followed at the last modification of the conf of this temp.
158 : !TODO store conf_n_acc in a bitshifted array to decrease the size (1Logical = 1Byte)
159 : LOGICAL, DIMENSION(:), ALLOCATABLE :: conf_n_acc
160 : INTEGER :: nr = 0 ! tree node number
161 : REAL(KIND=dp), DIMENSION(3, 2, 3) :: rng_seed = 0.0_dp ! random seed for childs
162 : !-- random number for acceptance check
163 : REAL(KIND=dp) :: rnd_nr = 0.0_dp
164 : !-- approximate probability of acceptance will be adapted while calculating the exact energy
165 : REAL(KIND=dp) :: prob_acc = 0.0_dp ! estimated acceptance probability
166 : REAL(KIND=dp) :: Temp = 0.0_dp ! temperature for simulated annealing
167 : END TYPE global_tree_type
168 :
169 : CONTAINS
170 :
171 : ! **************************************************************************************************
172 : !> \brief add a certain element to the specified element list at the beginning
173 : !> \param elem the sub tree element, to be added
174 : !> \param list ...
175 : !> \param temp_ind ...
176 : !> \param nr ...
177 : !> \author Mandes 11.2012
178 : ! **************************************************************************************************
179 1 : SUBROUTINE add_to_list(elem, list, temp_ind, nr)
180 : TYPE(tree_type), POINTER :: elem
181 : TYPE(elem_list_type), POINTER :: list
182 : INTEGER, OPTIONAL :: temp_ind, nr
183 :
184 : TYPE(elem_list_type), POINTER :: last, list_elem_tmp
185 :
186 1 : NULLIFY (list_elem_tmp, last)
187 :
188 1 : CPASSERT(ASSOCIATED(elem))
189 :
190 1 : ALLOCATE (list_elem_tmp)
191 1 : list_elem_tmp%elem => elem
192 : list_elem_tmp%next => NULL()
193 1 : IF (PRESENT(temp_ind)) THEN
194 0 : list_elem_tmp%temp_ind = temp_ind
195 : ELSE
196 1 : list_elem_tmp%temp_ind = -1
197 : END IF
198 :
199 1 : IF (PRESENT(nr)) THEN
200 0 : list_elem_tmp%nr = nr
201 : ELSE
202 : list_elem_tmp%nr = -1
203 : END IF
204 :
205 1 : IF (ASSOCIATED(list) .EQV. .FALSE.) THEN
206 1 : list => list_elem_tmp
207 : ELSE
208 : last => list
209 0 : DO WHILE (ASSOCIATED(last%next))
210 0 : last => last%next
211 : END DO
212 0 : last%next => list_elem_tmp
213 : END IF
214 :
215 1 : END SUBROUTINE add_to_list
216 :
217 : ! **************************************************************************************************
218 : !> \brief clean a certain element element list
219 : !> \param list ...
220 : !> \author Mandes 11.2012
221 : ! **************************************************************************************************
222 28 : SUBROUTINE clean_list(list)
223 : TYPE(elem_list_type), POINTER :: list
224 :
225 : TYPE(elem_list_type), POINTER :: list_elem_tmp
226 :
227 28 : NULLIFY (list_elem_tmp)
228 :
229 28 : DO WHILE (ASSOCIATED(list))
230 0 : list_elem_tmp => list%next
231 0 : DEALLOCATE (list)
232 0 : list => list_elem_tmp
233 : END DO
234 28 : END SUBROUTINE clean_list
235 :
236 : ! **************************************************************************************************
237 : !> \brief prints out the TMC sub tree structure element unformated in file
238 : !> \param elem ...
239 : !> \param io_unit ...
240 : !> \param
241 : !> \author Mandes 11.2012
242 : ! **************************************************************************************************
243 6 : SUBROUTINE write_subtree_elem_unformated(elem, io_unit)
244 : TYPE(tree_type), POINTER :: elem
245 : INTEGER :: io_unit
246 :
247 6 : CPASSERT(ASSOCIATED(elem))
248 6 : CPASSERT(io_unit > 0)
249 6 : WRITE (io_unit) elem%nr, &
250 6 : elem%sub_tree_nr, &
251 6 : elem%stat, &
252 6 : elem%rng_seed, &
253 6 : elem%move_type, &
254 6 : elem%temp_created, &
255 6 : elem%potential, &
256 6 : elem%e_pot_approx, &
257 6 : elem%ekin, &
258 12 : elem%ekin_before_md
259 6 : CALL write_subtree_elem_darray(elem%pos, io_unit)
260 6 : CALL write_subtree_elem_darray(elem%vel, io_unit)
261 6 : CALL write_subtree_elem_darray(elem%frc, io_unit)
262 6 : CALL write_subtree_elem_darray(elem%box_scale, io_unit)
263 6 : CALL write_subtree_elem_darray(elem%dipole, io_unit)
264 6 : END SUBROUTINE write_subtree_elem_unformated
265 :
266 : ! **************************************************************************************************
267 : !> \brief reads the TMC sub tree structure element unformated in file
268 : !> \param elem ...
269 : !> \param io_unit ...
270 : !> \param
271 : !> \author Mandes 11.2012
272 : ! **************************************************************************************************
273 3 : SUBROUTINE read_subtree_elem_unformated(elem, io_unit)
274 : TYPE(tree_type), POINTER :: elem
275 : INTEGER :: io_unit
276 :
277 3 : CPASSERT(ASSOCIATED(elem))
278 3 : CPASSERT(io_unit > 0)
279 :
280 3 : READ (io_unit) elem%nr, &
281 3 : elem%sub_tree_nr, &
282 3 : elem%stat, &
283 3 : elem%rng_seed, &
284 3 : elem%move_type, &
285 3 : elem%temp_created, &
286 3 : elem%potential, &
287 3 : elem%e_pot_approx, &
288 3 : elem%ekin, &
289 6 : elem%ekin_before_md
290 3 : CALL read_subtree_elem_darray(elem%pos, io_unit)
291 3 : CALL read_subtree_elem_darray(elem%vel, io_unit)
292 3 : CALL read_subtree_elem_darray(elem%frc, io_unit)
293 3 : CALL read_subtree_elem_darray(elem%box_scale, io_unit)
294 3 : CALL read_subtree_elem_darray(elem%dipole, io_unit)
295 3 : END SUBROUTINE read_subtree_elem_unformated
296 :
297 : ! **************************************************************************************************
298 : !> \brief ...
299 : !> \param array ...
300 : !> \param io_unit ...
301 : ! **************************************************************************************************
302 30 : SUBROUTINE write_subtree_elem_darray(array, io_unit)
303 : REAL(KIND=dp), DIMENSION(:), POINTER :: array
304 : INTEGER :: io_unit
305 :
306 30 : WRITE (io_unit) ASSOCIATED(array)
307 30 : IF (ASSOCIATED(array)) THEN
308 18 : WRITE (io_unit) SIZE(array)
309 792 : WRITE (io_unit) array
310 : END IF
311 30 : END SUBROUTINE write_subtree_elem_darray
312 :
313 : ! **************************************************************************************************
314 : !> \brief ...
315 : !> \param array ...
316 : !> \param io_unit ...
317 : ! **************************************************************************************************
318 15 : SUBROUTINE read_subtree_elem_darray(array, io_unit)
319 : REAL(KIND=dp), DIMENSION(:), POINTER :: array
320 : INTEGER :: io_unit
321 :
322 : INTEGER :: i_tmp
323 : LOGICAL :: l_tmp
324 :
325 15 : READ (io_unit) l_tmp
326 15 : IF (l_tmp) THEN
327 9 : READ (io_unit) i_tmp
328 9 : IF (ASSOCIATED(array)) THEN
329 9 : CPASSERT(SIZE(array) == i_tmp)
330 : ELSE
331 0 : ALLOCATE (array(i_tmp))
332 : END IF
333 396 : READ (io_unit) array
334 : END IF
335 15 : END SUBROUTINE read_subtree_elem_darray
336 :
337 0 : END MODULE tmc_tree_types
|
