LCOV - code coverage report
Current view: top level - src/tmc - tmc_dot_tree.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:9f1e18e) Lines: 130 154 84.4 %
Date: 2021-09-22 20:58:48 Functions: 10 10 100.0 %

          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

Generated by: LCOV version 1.15