(git:374b731)
Loading...
Searching...
No Matches
tmc_dot_tree.F
Go to the documentation of this file.
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 module for printing tree structures in GraphViz dot files
10!> for visualizing the trees
11!> \par History
12!> 12.2012 created [Mandes Schoenherr]
13!> \author Mandes
14! **************************************************************************************************
15!----------------------------------------------------------------------!
16! Tree Monte Carlo (TMC) a program for parallel Monte Carlo simulation
17! \author Mandes Schoenherr
18!----------------------------------------------------------------------!
20 USE cp_files, ONLY: close_file,&
26 USE tmc_tree_types, ONLY: &
32 USE tmc_types, ONLY: tmc_param_type
33#include "../base/base_uses.f90"
34
35 IMPLICIT NONE
36
37 PRIVATE
38
39 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tmc_dot_tree'
40
44
45 INTEGER :: DEBUG = 0
46! CHARACTER(LEN=30) :: filename ="tree.dot"
47
48CONTAINS
49! **************************************************************************************************
50!> \brief returns extended filename for global and sub trees
51!> \param tmc_params param environment for creating the file name
52!> \param ind index of the subtree (0 = global tree)
53!> \return ...
54!> \author Mandes 12.2012
55! **************************************************************************************************
56 FUNCTION get_dot_file_name(tmc_params, ind) RESULT(filename)
57 TYPE(tmc_param_type), POINTER :: tmc_params
58 INTEGER :: ind
59 CHARACTER(LEN=50) :: filename
60
61 filename = ""
62
63 cpassert(ASSOCIATED(tmc_params))
64 cpassert(ind .GE. 0)
65 cpassert(ASSOCIATED(tmc_params%Temp))
66 cpassert(ind .LE. SIZE(tmc_params%Temp))
67
68 IF (ind .EQ. 0) THEN
69 filename = trim(expand_file_name_char(tmc_params%dot_file_name, "global"))
70 ELSE
71 filename = trim(expand_file_name_temp(file_name=tmc_params%dot_file_name, &
72 rvalue=tmc_params%Temp(ind)))
73 END IF
74
75 cpassert(filename .NE. "")
76 END FUNCTION get_dot_file_name
77! **************************************************************************************************
78!> \brief initializes the dot files (open and write headers)
79!> \param tmc_params param environment for creating the file name
80!> \author Mandes 12.2012
81! **************************************************************************************************
82 SUBROUTINE init_draw_trees(tmc_params)
83 TYPE(tmc_param_type), POINTER :: tmc_params
84
85 INTEGER :: file_ptr, i
86
87 cpassert(ASSOCIATED(tmc_params))
88
89 ! global tree
90 CALL open_file(file_name=get_dot_file_name(tmc_params, 0), file_status="REPLACE", &
91 file_action="WRITE", unit_number=file_ptr)
92 WRITE (file_ptr, *) "digraph G {"
93 WRITE (file_ptr, *) ' size="8.27,11.69"'
94 CALL write_legend(file_ptr)
95 CALL close_file(unit_number=file_ptr, keep_preconnection=.true.)
96
97 ! subtrees
98 DO i = 1, SIZE(tmc_params%Temp)
99 CALL open_file(file_name=get_dot_file_name(tmc_params, i), file_status="REPLACE", &
100 file_action="WRITE", unit_number=file_ptr)
101 WRITE (file_ptr, *) "digraph G {"
102 WRITE (file_ptr, *) ' size="8.27,11.69"'
103 CALL write_legend(file_ptr)
104 CALL close_file(unit_number=file_ptr, keep_preconnection=.true.)
105 END DO
106 END SUBROUTINE init_draw_trees
107
108! **************************************************************************************************
109!> \brief close the dot files (write tails)
110!> \param tmc_params param environment for creating the file name
111!> \author Mandes 12.2012
112! **************************************************************************************************
113 SUBROUTINE finalize_draw_tree(tmc_params)
114 TYPE(tmc_param_type), POINTER :: tmc_params
115
116 INTEGER :: file_ptr, i
117
118 cpassert(ASSOCIATED(tmc_params))
119
120 ! global tree
121 CALL open_file(file_name=get_dot_file_name(tmc_params, 0), &
122 file_status="OLD", file_action="WRITE", &
123 file_position="APPEND", unit_number=file_ptr)
124 WRITE (file_ptr, *) "}"
125 CALL close_file(unit_number=file_ptr)
126
127 DO i = 1, SIZE(tmc_params%Temp)
128 CALL open_file(file_name=get_dot_file_name(tmc_params, i), file_status="OLD", &
129 file_action="WRITE", file_position="APPEND", unit_number=file_ptr)
130 WRITE (file_ptr, *) "}"
131 CALL close_file(unit_number=file_ptr)
132 END DO
133 END SUBROUTINE finalize_draw_tree
134
135! **************************************************************************************************
136!> \brief writes the legend in the file
137!> \param file_ptr file pointer
138!> \author Mandes 12.2012
139! **************************************************************************************************
140 SUBROUTINE write_legend(file_ptr)
141 INTEGER, INTENT(IN) :: file_ptr
142
143 cpassert(file_ptr .GT. 0)
144
145 WRITE (file_ptr, *) '//LEGEND'
146 WRITE (file_ptr, *) 'subgraph clusterLegend {'
147 WRITE (file_ptr, *) ' label="Legend:" labelloc=t fontsize=30'
148 WRITE (file_ptr, *) ' centered=false'
149 WRITE (file_ptr, *) ' color=black'
150 WRITE (file_ptr, *) ' leg1 -> leg2 -> leg2_2 -> leg2_3 -> leg2_4 -> leg3 -> '// &
151 'leg4 -> leg5 -> leg6 -> leg7_1 -> leg7 -> '// &
152 'leg8_1 -> leg8 -> leg9 -> leg10 [style=invis]'
153 WRITE (file_ptr, *) ' {rank=same leg1 [fontsize=30, label="node created" , color=black]}'
154 WRITE (file_ptr, *) ' {rank=same leg2 [fontsize=30, label="configuration created" , style=filled, color=gray]}'
155 WRITE (file_ptr, *) ' {rank=same leg2_2 [fontsize=30, label="calc energy" , style=filled, color=brown]}'
156 WRITE (file_ptr, *) ' {rank=same leg2_2 [fontsize=30, label="calc energy" , style=filled, color=wheat]}'
157 WRITE (file_ptr, *) ' {rank=same leg2_3 [fontsize=30, label="calc HMC" , style=filled, color=goldenrod]}'
158 WRITE (file_ptr, *) ' {rank=same leg2_4 [fontsize=30, label="calc NMC" , style=filled, color=peru]}'
159 WRITE (file_ptr, *) ' {rank=same leg3 [fontsize=30, label="accepted" , color=greenyellow]}'
160 WRITE (file_ptr, *) ' {rank=same leg4 [fontsize=30, label="rejected" , color=red]}'
161 WRITE (file_ptr, *) ' {rank=same leg5 [fontsize=30, label="trajec" , '// &
162 'style=filled, color=gold, shape=polygon, sides=4]}'
163 WRITE (file_ptr, *) ' {rank=same leg6 [fontsize=30, label="energy calculated" , '// &
164 'style=filled, color=blue, fontcolor=white]}'
165 WRITE (file_ptr, *) ' {rank=same leg7_1 [fontsize=30, label="cancel NMC send" , '// &
166 'style=filled, color=deeppink, fontcolor=white]}'
167 WRITE (file_ptr, *) ' {rank=same leg7 [fontsize=30, label="canceled NMC" , '// &
168 'style=filled, color=darkorchid1, fontcolor=white]}'
169 WRITE (file_ptr, *) ' {rank=same leg8_1 [fontsize=30, label="cancel ENERGY send" , '// &
170 'style=filled, color=cornflowerblue]}'
171 WRITE (file_ptr, *) ' {rank=same leg8 [fontsize=30, label="canceled ENERGY" , '// &
172 'style=filled, color=cyan]}'
173 WRITE (file_ptr, *) ' {rank=same leg9 [fontsize=30, label="deleted" , '// &
174 'style=filled, shape=polygon, sides=3, color=black,fontcolor=white]}'
175 WRITE (file_ptr, *) ' {rank=same leg10 [fontsize=30, label="deleted trajectory" , '// &
176 'style=filled, shape=polygon, sides=5, color=gold]}'
177 WRITE (file_ptr, *) ' }'
178 END SUBROUTINE write_legend
179
180! **************************************************************************************************
181!> \brief write/change color related to certain tree element status
182!> \param node_nr the index of the tree node
183!> \param stat tree element status
184!> \param filename the filename for the grapgviz dot files
185!> \author Mandes 12.2012
186! **************************************************************************************************
187 SUBROUTINE write_color(node_nr, stat, filename)
188 INTEGER :: node_nr, stat
189 CHARACTER(LEN=50) :: filename
190
191 CHARACTER(len=11) :: label
192 INTEGER :: file_ptr
193
194 cpassert(filename .NE. "")
195 cpassert(node_nr .GE. 0)
196
197 CALL open_file(file_name=filename, file_status="OLD", &
198 file_action="WRITE", file_position="APPEND", unit_number=file_ptr)
199 WRITE (label, fmt='(I10,A)') node_nr, "["
200 SELECT CASE (stat)
201 CASE (status_created)
202 WRITE (file_ptr, *) trim(label), 'style=filled, color=gray]'
203 CASE (status_accepted)
204 WRITE (file_ptr, *) trim(label), 'color=green]'
205 CASE (status_rejected)
206 WRITE (file_ptr, *) trim(label), 'color=red]'
208 WRITE (file_ptr, *) trim(label), 'style=filled, color=green, shape=polygon, sides=4]'
210 WRITE (file_ptr, *) trim(label), 'style=filled, color=red, shape=polygon, sides=4]'
211 CASE (status_calculated)
212 WRITE (file_ptr, *) trim(label), 'style=filled, color=blue]'
213 CASE (status_cancel_nmc)
214 WRITE (file_ptr, *) trim(label), 'style=filled, color=deeppink]'
215 CASE (status_cancel_ener)
216 WRITE (file_ptr, *) trim(label), 'style=filled, color=cornflowerblue]'
218 WRITE (file_ptr, *) trim(label), 'style=filled, color=darkorchid1]'
220 WRITE (file_ptr, *) trim(label), 'style=filled, color=cyan]'
221 CASE (status_deleted)
222 WRITE (file_ptr, *) trim(label), 'shape=polygon, sides=3]'
224 WRITE (file_ptr, *) trim(label), 'style=filled, shape=polygon, sides=5]'
226 WRITE (file_ptr, *) trim(label), 'style=filled, color=brown]'
228 WRITE (file_ptr, *) trim(label), 'style=filled, color=wheat]'
230 WRITE (file_ptr, *) trim(label), 'style=filled, color=goldenrod]'
232 WRITE (file_ptr, *) trim(label), 'style=filled, color=peru]'
233 CASE DEFAULT
234 cpabort("element status"//cp_to_string(stat))
235 END SELECT
236 CALL close_file(unit_number=file_ptr, keep_preconnection=.true.)
237 END SUBROUTINE write_color
238
239! **************************************************************************************************
240!> \brief creates an new branch (hence a new element is created)
241!> \param parent_nr tree element number of element one level up
242!> \param child_nr tree element number of actual element
243!> \param acc flag for accepted or not accepted branch (left,right)
244!> \param tmc_params param environment for creating the file name
245!> \param tree index of the tree (0=global tree)
246!> \author Mandes 12.2012
247! **************************************************************************************************
248 SUBROUTINE create_dot_branch(parent_nr, child_nr, acc, tmc_params, tree)
249 INTEGER :: parent_nr, child_nr
250 LOGICAL :: acc
251 TYPE(tmc_param_type), POINTER :: tmc_params
252 INTEGER :: tree
253
254 INTEGER :: file_ptr
255
256 cpassert(ASSOCIATED(tmc_params))
257
258 CALL open_file(file_name=get_dot_file_name(tmc_params, tree), &
259 file_status="OLD", file_action="WRITE", &
260 file_position="APPEND", unit_number=file_ptr)
261 IF (acc) THEN
262 WRITE (file_ptr, *) parent_nr, " -> ", child_nr, ":nw [color=darkolivegreen1]"
263 ELSE
264 WRITE (file_ptr, *) parent_nr, " -> ", child_nr, ":ne [color=coral]"
265 END IF
266 CALL close_file(unit_number=file_ptr, keep_preconnection=.true.)
267 END SUBROUTINE create_dot_branch
268
269! **************************************************************************************************
270!> \brief interfaces the creating of a branch for subtree elements
271!> \param new_element the actual subtree element
272!> \param conf the subtree index and hence the index for filename
273!> \param tmc_params ...
274!> \author Mandes 12.2012
275! **************************************************************************************************
276 SUBROUTINE create_dot(new_element, conf, tmc_params)
277 TYPE(tree_type), POINTER :: new_element
278 INTEGER :: conf
279 TYPE(tmc_param_type), POINTER :: tmc_params
280
281 cpassert(ASSOCIATED(new_element))
282 cpassert(conf .GT. 0)
283 cpassert(ASSOCIATED(tmc_params))
284
285 CALL create_dot_branch(parent_nr=new_element%parent%nr, &
286 child_nr=new_element%nr, &
287 acc=ASSOCIATED(new_element%parent%acc, new_element), &
288 tmc_params=tmc_params, tree=conf)
289 END SUBROUTINE create_dot
290
291! **************************************************************************************************
292!> \brief creates new dot and arrow from element one level up (for subtree)
293!> additional handling of nodes with swaped elements
294!> \param new_element the actual global element
295!> \param tmc_params ...
296!> \author Mandes 12.2012
297! **************************************************************************************************
298 SUBROUTINE create_global_tree_dot(new_element, tmc_params)
299 TYPE(global_tree_type), POINTER :: new_element
300 TYPE(tmc_param_type), POINTER :: tmc_params
301
302 CHARACTER(len=1000) :: list_of_nr
303 INTEGER :: file_ptr, i, ref_count
304 TYPE(gt_elem_list_type), POINTER :: tmp_pt_list_elem
305
306 NULLIFY (tmp_pt_list_elem)
307
308 cpassert(ASSOCIATED(new_element))
309 cpassert(ASSOCIATED(tmc_params))
310
311 ! creating list with configuration numbers (of subtrees)
312 list_of_nr = ""
313 ! the order of subtrees
314 DO i = 1, SIZE(new_element%conf(:))
315 WRITE (list_of_nr, *) trim(adjustl(list_of_nr)), new_element%conf(i)%elem%sub_tree_nr
316 END DO
317 ! the used subtree elements
318 WRITE (list_of_nr, *) trim(adjustl(list_of_nr)), '\n '
319 DO i = 1, SIZE(new_element%conf(:))
320 WRITE (list_of_nr, *) trim(adjustl(list_of_nr)), " ", new_element%conf(i)%elem%nr
321 END DO
322 ! print out the references of each subtree element
323 IF (debug .GT. 8) THEN
324 WRITE (list_of_nr, *) trim(adjustl(list_of_nr)), '\n ref'
325 DO i = 1, SIZE(new_element%conf(:))
326 ref_count = 0
327 tmp_pt_list_elem => new_element%conf(i)%elem%gt_nodes_references
328 DO WHILE (ASSOCIATED(tmp_pt_list_elem))
329 ref_count = ref_count + 1
330 ! create a list with all references
331 IF (.false.) WRITE (list_of_nr, *) trim(adjustl(list_of_nr)), " ", tmp_pt_list_elem%gt_elem%nr
332 tmp_pt_list_elem => tmp_pt_list_elem%next
333 END DO
334 ! print a list with all references
335 IF (.false.) WRITE (list_of_nr, *) trim(adjustl(list_of_nr)), ' | '
336 ! print only the amount of references
337 IF (.true.) WRITE (list_of_nr, *) trim(adjustl(list_of_nr)), ref_count, ' | '
338 END DO
339 END IF
340
341 IF (.NOT. ASSOCIATED(new_element%parent)) THEN
342 IF (new_element%nr .GT. 1) &
343 CALL cp_warn(__location__, &
344 "try to create dot, but no parent on node "// &
345 cp_to_string(new_element%nr)//"exists")
346 ELSE
347 CALL create_dot_branch(parent_nr=new_element%parent%nr, &
348 child_nr=new_element%nr, &
349 acc=ASSOCIATED(new_element%parent%acc, new_element), &
350 tmc_params=tmc_params, tree=0)
351 END IF
352 ! write in dot file
353 CALL open_file(file_name=get_dot_file_name(tmc_params, 0), &
354 file_status="OLD", file_action="WRITE", &
355 file_position="APPEND", unit_number=file_ptr)
356 IF (new_element%swaped) THEN
357 WRITE (file_ptr, *) new_element%nr, '[label="', new_element%nr, ' |', new_element%mv_conf, ' |', &
358 mv_type_swap_conf, '\n ', &
359 trim(adjustl(list_of_nr)), '", shape=polygon, peripheries=3, sides=5]'
360 ELSE
361 WRITE (file_ptr, *) new_element%nr, '[label="', new_element%nr, ' |', new_element%mv_conf, ' |', &
362 new_element%conf(new_element%mv_conf)%elem%move_type, '\n ', &
363 trim(adjustl(list_of_nr)), '"]'
364 END IF
365 CALL close_file(file_ptr, keep_preconnection=.true.)
366 END SUBROUTINE create_global_tree_dot
367
368! **************************************************************************************************
369!> \brief interfaces the change of color for subtree elements
370!> on the basis of the element status
371!> \param tree_element the actual global element
372!> \param tmc_params ...
373!> \author Mandes 12.2012
374! **************************************************************************************************
375 SUBROUTINE create_dot_color(tree_element, tmc_params)
376 TYPE(tree_type), POINTER :: tree_element
377 TYPE(tmc_param_type), POINTER :: tmc_params
378
379 CHARACTER(len=1000) :: list_of_nr
380 INTEGER :: ref_count
381 TYPE(gt_elem_list_type), POINTER :: tmp_pt_list_elem
382
383 cpassert(ASSOCIATED(tree_element))
384 cpassert(ASSOCIATED(tmc_params))
385
386 IF (debug .GT. 8) THEN
387 list_of_nr = ""
388 tmp_pt_list_elem => tree_element%gt_nodes_references
389 ref_count = 0
390 DO WHILE (ASSOCIATED(tmp_pt_list_elem))
391 ref_count = ref_count + 1
392 ! print a list with all references
393 IF (.false.) THEN
394 WRITE (list_of_nr, *) trim(adjustl(list_of_nr)), " ", tmp_pt_list_elem%gt_elem%nr
395 WRITE (list_of_nr, *) trim(adjustl(list_of_nr)), ' | '
396 END IF
397 ! print only the amount of references
398 IF (.true.) WRITE (list_of_nr, *) ref_count, ' | '
399 tmp_pt_list_elem => tmp_pt_list_elem%next
400 END DO
401 WRITE (*, *) "mark subtree", tree_element%sub_tree_nr, " node", tree_element%nr, " with status ", &
402 tree_element%stat, "ref ", trim(adjustl(list_of_nr))
403 END IF
404
405 CALL write_color(node_nr=tree_element%nr, stat=tree_element%stat, &
406 filename=get_dot_file_name(tmc_params, tree_element%sub_tree_nr))
407 END SUBROUTINE create_dot_color
408
409! **************************************************************************************************
410!> \brief interfaces the change of color for global tree node
411!> on the basis of the element status
412!> \param gt_tree_element the actual global element
413!> \param tmc_params ...
414!> \author Mandes 12.2012
415! **************************************************************************************************
416 SUBROUTINE create_global_tree_dot_color(gt_tree_element, tmc_params)
417 TYPE(global_tree_type), POINTER :: gt_tree_element
418 TYPE(tmc_param_type), POINTER :: tmc_params
419
420 cpassert(ASSOCIATED(gt_tree_element))
421 cpassert(ASSOCIATED(tmc_params))
422
423 IF (debug .GT. 8) WRITE (*, *) "mark global tree node color", gt_tree_element%nr, gt_tree_element%stat
424 CALL write_color(node_nr=gt_tree_element%nr, stat=gt_tree_element%stat, &
425 filename=get_dot_file_name(tmc_params, 0))
426 END SUBROUTINE create_global_tree_dot_color
427
428!! **************************************************************************************************
429!!> \brief prints out dot file for a whole subtree below the entered element
430!!> \param current the actual subtree element
431!!> \param conf index of the subtree
432!!> \param error variable to control error logging, stopping,...
433!!> see module cp_error_handling
434!!> \author Mandes 12.2012
435!! **************************************************************************************************
436! RECURSIVE SUBROUTINE create_tree(current, conf, filename)
437! TYPE (tree_type), POINTER :: current
438! INTEGER :: conf
439! CHARACTER(LEN=*) :: filename
440!
441! CHARACTER(LEN=*), PARAMETER :: routineN = 'create_tree', &
442! routineP = moduleN//':'//routineN
443!
444! CALL create_dot_color(current, tmc_params)
445! IF(ASSOCIATED(current%acc))THEN
446! CALL create_dot_branch(parent_nr=current%nr, child_nr=current%acc%nr, &
447! acc=.TRUE.,tmc_params=tmc_params, file_single_tree_ptr)
448! WRITE(file_single_tree_ptr,*)current%nr,'[label="', current%nr,"\n ",&
449! current%pos(1),"\n ", current%potential,'"]'
450! CALL create_tree(current%acc, conf)
451! END IF
452! IF(ASSOCIATED(current%nacc))THEN
453! CALL create_dot_branch(current%nr,current%acc%nr,.FALSE.,file_single_tree_ptr)
454! WRITE(file_single_tree_ptr,*)current%nr,'[label="', current%nr,"\n ",&
455! current%pos(1),"\n ", current%potential,'"]'
456! CALL create_tree(current%nacc, conf)
457! END IF
458! END SUBROUTINE create_tree
459END MODULE tmc_dot_tree
Utility routines to open and close files. Tracking of preconnections.
Definition cp_files.F:16
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
Definition cp_files.F:308
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Definition cp_files.F:119
various routines to log and control the output. The idea is that decisions about where to log should ...
module for printing tree structures in GraphViz dot files for visualizing the trees
subroutine, public finalize_draw_tree(tmc_params)
close the dot files (write tails)
subroutine, public init_draw_trees(tmc_params)
initializes the dot files (open and write headers)
subroutine, public create_dot(new_element, conf, tmc_params)
interfaces the creating of a branch for subtree elements
subroutine, public create_global_tree_dot_color(gt_tree_element, tmc_params)
interfaces the change of color for global tree node on the basis of the element status
subroutine, public create_global_tree_dot(new_element, tmc_params)
creates new dot and arrow from element one level up (for subtree) additional handling of nodes with s...
subroutine, public create_dot_color(tree_element, tmc_params)
interfaces the change of color for subtree elements on the basis of the element status
writing and printing the files, trajectory (pos, cell, dipoles) as well as restart files
Definition tmc_file_io.F:20
character(len=default_path_length) function, public expand_file_name_char(file_name, extra)
placing a character string at the end of a file name (before the file extension)
character(len=default_path_length) function, public expand_file_name_temp(file_name, rvalue)
placing the temperature at the end of a file name (before the file extension)
tree nodes creation, searching, deallocation, references etc.
integer, parameter, public mv_type_swap_conf
module handles definition of the tree nodes for the global and the subtrees binary tree parent elemen...
integer, parameter, public status_deleted
integer, parameter, public status_accepted
integer, parameter, public status_calculate_energy
integer, parameter, public status_calculate_md
integer, parameter, public status_canceled_ener
integer, parameter, public status_calculated
integer, parameter, public status_cancel_ener
integer, parameter, public status_cancel_nmc
integer, parameter, public status_canceled_nmc
integer, parameter, public status_calc_approx_ener
integer, parameter, public status_rejected
integer, parameter, public status_calculate_nmc_steps
integer, parameter, public status_accepted_result
integer, parameter, public status_deleted_result
integer, parameter, public status_created
integer, parameter, public status_rejected_result
module handles definition of the tree nodes for the global and the subtrees binary tree parent elemen...
Definition tmc_types.F:32