Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2021 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 : !----------------------------------------------------------------------!
19 : MODULE tmc_dot_tree
20 : USE cp_files, ONLY: close_file,&
21 : open_file
22 : USE cp_log_handling, ONLY: cp_to_string
23 : USE tmc_file_io, ONLY: expand_file_name_char,&
24 : expand_file_name_temp
25 : USE tmc_move_types, ONLY: mv_type_swap_conf
26 : USE tmc_tree_types, ONLY: &
27 : global_tree_type, gt_elem_list_type, status_accepted, status_accepted_result, &
28 : status_calc_approx_ener, status_calculate_MD, status_calculate_NMC_steps, &
29 : status_calculate_energy, status_calculated, status_cancel_ener, status_cancel_nmc, &
30 : status_canceled_ener, status_canceled_nmc, status_created, status_deleted, &
31 : status_deleted_result, status_rejected, status_rejected_result, tree_type
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 :
41 : PUBLIC :: init_draw_trees, finalize_draw_tree
42 : PUBLIC :: create_dot_color, create_global_tree_dot_color
43 : PUBLIC :: create_dot, create_global_tree_dot
44 :
45 : INTEGER :: DEBUG = 0
46 : ! CHARACTER(LEN=30) :: filename ="tree.dot"
47 :
48 : CONTAINS
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 602 : 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 602 : filename = ""
62 :
63 602 : CPASSERT(ASSOCIATED(tmc_params))
64 602 : CPASSERT(ind .GE. 0)
65 602 : CPASSERT(ASSOCIATED(tmc_params%Temp))
66 602 : CPASSERT(ind .LE. SIZE(tmc_params%Temp))
67 :
68 602 : IF (ind .EQ. 0) THEN
69 337 : 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 265 : rvalue=tmc_params%Temp(ind)))
73 : END IF
74 :
75 602 : CPASSERT(filename .NE. "")
76 602 : 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 1 : SUBROUTINE init_draw_trees(tmc_params)
83 : TYPE(tmc_param_type), POINTER :: tmc_params
84 :
85 : INTEGER :: file_ptr, i
86 :
87 1 : 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 1 : file_action="WRITE", unit_number=file_ptr)
92 1 : WRITE (file_ptr, *) "digraph G {"
93 1 : WRITE (file_ptr, *) ' size="8.27,11.69"'
94 1 : CALL write_legend(file_ptr)
95 1 : CALL close_file(unit_number=file_ptr, keep_preconnection=.TRUE.)
96 :
97 : ! subtrees
98 4 : DO i = 1, SIZE(tmc_params%Temp)
99 : CALL open_file(file_name=get_dot_file_name(tmc_params, i), file_status="REPLACE", &
100 3 : file_action="WRITE", unit_number=file_ptr)
101 3 : WRITE (file_ptr, *) "digraph G {"
102 3 : WRITE (file_ptr, *) ' size="8.27,11.69"'
103 3 : CALL write_legend(file_ptr)
104 4 : CALL close_file(unit_number=file_ptr, keep_preconnection=.TRUE.)
105 : END DO
106 1 : 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 1 : SUBROUTINE finalize_draw_tree(tmc_params)
114 : TYPE(tmc_param_type), POINTER :: tmc_params
115 :
116 : INTEGER :: file_ptr, i
117 :
118 1 : 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 1 : file_position="APPEND", unit_number=file_ptr)
124 1 : WRITE (file_ptr, *) "}"
125 1 : CALL close_file(unit_number=file_ptr)
126 :
127 4 : DO i = 1, SIZE(tmc_params%Temp)
128 : CALL open_file(file_name=get_dot_file_name(tmc_params, i), file_status="OLD", &
129 3 : file_action="WRITE", file_position="APPEND", unit_number=file_ptr)
130 3 : WRITE (file_ptr, *) "}"
131 4 : CALL close_file(unit_number=file_ptr)
132 : END DO
133 1 : 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 4 : SUBROUTINE write_legend(file_ptr)
141 : INTEGER, INTENT(IN) :: file_ptr
142 :
143 4 : CPASSERT(file_ptr .GT. 0)
144 :
145 4 : WRITE (file_ptr, *) '//LEGEND'
146 4 : WRITE (file_ptr, *) 'subgraph clusterLegend {'
147 4 : WRITE (file_ptr, *) ' label="Legend:" labelloc=t fontsize=30'
148 4 : WRITE (file_ptr, *) ' centered=false'
149 4 : 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 4 : 'leg8_1 -> leg8 -> leg9 -> leg10 [style=invis]'
153 4 : WRITE (file_ptr, *) ' {rank=same leg1 [fontsize=30, label="node created" , color=black]}'
154 4 : WRITE (file_ptr, *) ' {rank=same leg2 [fontsize=30, label="configuration created" , style=filled, color=gray]}'
155 4 : WRITE (file_ptr, *) ' {rank=same leg2_2 [fontsize=30, label="calc energy" , style=filled, color=brown]}'
156 4 : WRITE (file_ptr, *) ' {rank=same leg2_2 [fontsize=30, label="calc energy" , style=filled, color=wheat]}'
157 4 : WRITE (file_ptr, *) ' {rank=same leg2_3 [fontsize=30, label="calc HMC" , style=filled, color=goldenrod]}'
158 4 : WRITE (file_ptr, *) ' {rank=same leg2_4 [fontsize=30, label="calc NMC" , style=filled, color=peru]}'
159 4 : WRITE (file_ptr, *) ' {rank=same leg3 [fontsize=30, label="accepted" , color=greenyellow]}'
160 4 : WRITE (file_ptr, *) ' {rank=same leg4 [fontsize=30, label="rejected" , color=red]}'
161 : WRITE (file_ptr, *) ' {rank=same leg5 [fontsize=30, label="trajec" , '// &
162 4 : 'style=filled, color=gold, shape=polygon, sides=4]}'
163 : WRITE (file_ptr, *) ' {rank=same leg6 [fontsize=30, label="energy calculated" , '// &
164 4 : 'style=filled, color=blue, fontcolor=white]}'
165 : WRITE (file_ptr, *) ' {rank=same leg7_1 [fontsize=30, label="cancel NMC send" , '// &
166 4 : 'style=filled, color=deeppink, fontcolor=white]}'
167 : WRITE (file_ptr, *) ' {rank=same leg7 [fontsize=30, label="canceled NMC" , '// &
168 4 : 'style=filled, color=darkorchid1, fontcolor=white]}'
169 : WRITE (file_ptr, *) ' {rank=same leg8_1 [fontsize=30, label="cancel ENERGY send" , '// &
170 4 : 'style=filled, color=cornflowerblue]}'
171 : WRITE (file_ptr, *) ' {rank=same leg8 [fontsize=30, label="canceled ENERGY" , '// &
172 4 : 'style=filled, color=cyan]}'
173 : WRITE (file_ptr, *) ' {rank=same leg9 [fontsize=30, label="deleted" , '// &
174 4 : 'style=filled, shape=polygon, sides=3, color=black,fontcolor=white]}'
175 : WRITE (file_ptr, *) ' {rank=same leg10 [fontsize=30, label="deleted trajectory" , '// &
176 4 : 'style=filled, shape=polygon, sides=5, color=gold]}'
177 4 : WRITE (file_ptr, *) ' }'
178 4 : 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 409 : 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 409 : CPASSERT(filename .NE. "")
195 409 : CPASSERT(node_nr .GE. 0)
196 :
197 : CALL open_file(file_name=filename, file_status="OLD", &
198 409 : file_action="WRITE", file_position="APPEND", unit_number=file_ptr)
199 409 : WRITE (label, FMT='(I10,A)') node_nr, "["
200 445 : SELECT CASE (stat)
201 : CASE (status_created)
202 36 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=gray]'
203 : CASE (status_accepted)
204 59 : WRITE (file_ptr, *) TRIM(label), 'color=green]'
205 : CASE (status_rejected)
206 59 : WRITE (file_ptr, *) TRIM(label), 'color=red]'
207 : CASE (status_accepted_result)
208 45 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=green, shape=polygon, sides=4]'
209 : CASE (status_rejected_result)
210 30 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=red, shape=polygon, sides=4]'
211 : CASE (status_calculated)
212 36 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=blue]'
213 : CASE (status_cancel_nmc)
214 0 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=deeppink]'
215 : CASE (status_cancel_ener)
216 0 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=cornflowerblue]'
217 : CASE (status_canceled_nmc)
218 0 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=darkorchid1]'
219 : CASE (status_canceled_ener)
220 0 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=cyan]'
221 : CASE (status_deleted)
222 33 : WRITE (file_ptr, *) TRIM(label), 'shape=polygon, sides=3]'
223 : CASE (status_deleted_result)
224 75 : WRITE (file_ptr, *) TRIM(label), 'style=filled, shape=polygon, sides=5]'
225 : CASE (status_calc_approx_ener)
226 0 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=brown]'
227 : CASE (status_calculate_energy)
228 36 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=wheat]'
229 : CASE (status_calculate_MD)
230 0 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=goldenrod]'
231 : CASE (status_calculate_NMC_steps)
232 0 : WRITE (file_ptr, *) TRIM(label), 'style=filled, color=peru]'
233 : CASE DEFAULT
234 409 : CPABORT("element status"//cp_to_string(stat))
235 : END SELECT
236 409 : CALL close_file(unit_number=file_ptr, keep_preconnection=.TRUE.)
237 409 : 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 110 : 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 110 : 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 110 : file_position="APPEND", unit_number=file_ptr)
261 110 : IF (acc) THEN
262 65 : WRITE (file_ptr, *) parent_nr, " -> ", child_nr, ":nw [color=darkolivegreen1]"
263 : ELSE
264 45 : WRITE (file_ptr, *) parent_nr, " -> ", child_nr, ":ne [color=coral]"
265 : END IF
266 110 : CALL close_file(unit_number=file_ptr, keep_preconnection=.TRUE.)
267 110 : 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 36 : 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 36 : CPASSERT(ASSOCIATED(new_element))
282 36 : CPASSERT(conf .GT. 0)
283 36 : 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 36 : tmc_params=tmc_params, tree=conf)
289 36 : 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 75 : 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 75 : NULLIFY (tmp_pt_list_elem)
307 :
308 75 : CPASSERT(ASSOCIATED(new_element))
309 75 : CPASSERT(ASSOCIATED(tmc_params))
310 :
311 : ! creating list with configuration numbers (of subtrees)
312 75 : list_of_nr = ""
313 : ! the order of subtrees
314 300 : DO i = 1, SIZE(new_element%conf(:))
315 300 : 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 75 : WRITE (list_of_nr, *) TRIM(ADJUSTL(list_of_nr)), '\n '
319 300 : DO i = 1, SIZE(new_element%conf(:))
320 300 : 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 75 : IF (DEBUG .GT. 8) THEN
324 0 : WRITE (list_of_nr, *) TRIM(ADJUSTL(list_of_nr)), '\n ref'
325 0 : DO i = 1, SIZE(new_element%conf(:))
326 0 : ref_count = 0
327 0 : tmp_pt_list_elem => new_element%conf(i)%elem%gt_nodes_references
328 0 : DO WHILE (ASSOCIATED(tmp_pt_list_elem))
329 0 : 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 0 : 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 0 : IF (.TRUE.) WRITE (list_of_nr, *) TRIM(ADJUSTL(list_of_nr)), ref_count, ' | '
338 : END DO
339 : END IF
340 :
341 75 : IF (.NOT. ASSOCIATED(new_element%parent)) THEN
342 1 : IF (new_element%nr .GT. 1) &
343 : CALL cp_warn(__LOCATION__, &
344 : "try to create dot, but no parent on node "// &
345 1 : 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 74 : 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 75 : file_position="APPEND", unit_number=file_ptr)
356 75 : IF (new_element%swaped) THEN
357 38 : WRITE (file_ptr, *) new_element%nr, '[label="', new_element%nr, ' |', new_element%mv_conf, ' |', &
358 38 : mv_type_swap_conf, '\n ', &
359 76 : TRIM(ADJUSTL(list_of_nr)), '", shape=polygon, peripheries=3, sides=5]'
360 : ELSE
361 37 : WRITE (file_ptr, *) new_element%nr, '[label="', new_element%nr, ' |', new_element%mv_conf, ' |', &
362 37 : new_element%conf(new_element%mv_conf)%elem%move_type, '\n ', &
363 74 : TRIM(ADJUSTL(list_of_nr)), '"]'
364 : END IF
365 75 : CALL close_file(file_ptr, keep_preconnection=.TRUE.)
366 75 : 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 223 : 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 223 : CPASSERT(ASSOCIATED(tree_element))
384 223 : CPASSERT(ASSOCIATED(tmc_params))
385 :
386 223 : IF (DEBUG .GT. 8) THEN
387 0 : list_of_nr = ""
388 0 : tmp_pt_list_elem => tree_element%gt_nodes_references
389 0 : ref_count = 0
390 0 : DO WHILE (ASSOCIATED(tmp_pt_list_elem))
391 0 : 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 0 : IF (.TRUE.) WRITE (list_of_nr, *) ref_count, ' | '
399 0 : tmp_pt_list_elem => tmp_pt_list_elem%next
400 : END DO
401 0 : WRITE (*, *) "mark subtree", tree_element%sub_tree_nr, " node", tree_element%nr, " with status ", &
402 0 : 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 223 : filename=get_dot_file_name(tmc_params, tree_element%sub_tree_nr))
407 223 : 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 186 : 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 186 : CPASSERT(ASSOCIATED(gt_tree_element))
421 186 : CPASSERT(ASSOCIATED(tmc_params))
422 :
423 186 : 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 186 : filename=get_dot_file_name(tmc_params, 0))
426 186 : 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
459 : END MODULE tmc_dot_tree
|
