LCOV - code coverage report
Current view: top level - src/tmc - tmc_tree_search.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:9f1e18e) Lines: 205 247 83.0 %
Date: 2021-09-22 20:58:48 Functions: 12 13 92.3 %

          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 tree nodes search etc.
      10             : !> \par History
      11             : !>      11.2012 created [Mandes Schoenherr]
      12             : !> \author Mandes
      13             : ! **************************************************************************************************
      14             : 
      15             : MODULE tmc_tree_search
      16             :    USE cp_log_handling,                 ONLY: cp_to_string
      17             :    USE kinds,                           ONLY: dp
      18             :    USE tmc_stati,                       ONLY: TMC_STATUS_WAIT_FOR_NEW_TASK
      19             :    USE tmc_tree_references,             ONLY: add_to_references,&
      20             :                                               search_and_remove_reference_in_list
      21             :    USE tmc_tree_types,                  ONLY: &
      22             :         elem_array_type, global_tree_type, status_accepted, status_accepted_result, &
      23             :         status_calc_approx_ener, status_calculate_MD, status_calculate_NMC_steps, &
      24             :         status_calculate_energy, status_calculated, status_cancel_ener, status_cancel_nmc, &
      25             :         status_canceled_ener, status_canceled_nmc, status_created, status_deleted, &
      26             :         status_deleted_result, status_rejected, status_rejected_result, tree_type
      27             :    USE tmc_types,                       ONLY: tmc_env_type
      28             : #include "../base/base_uses.f90"
      29             : 
      30             :    IMPLICIT NONE
      31             : 
      32             :    PRIVATE
      33             : 
      34             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tmc_tree_search'
      35             : 
      36             :    PUBLIC :: most_prob_end
      37             :    PUBLIC :: search_next_energy_calc
      38             :    PUBLIC :: search_canceling_elements
      39             :    PUBLIC :: search_parent_element, get_subtree_elements_to_check
      40             :    PUBLIC :: search_next_gt_element_to_check
      41             :    PUBLIC :: search_end_of_clean_g_tree, search_end_of_clean_tree
      42             :    PUBLIC :: count_prepared_nodes_in_trees, count_nodes_in_trees
      43             : CONTAINS
      44             : 
      45             :    !============================================================================
      46             :    ! search tree node
      47             :    !============================================================================
      48             : ! **************************************************************************************************
      49             : !> \brief search most probable end in global tree to create a new tree node
      50             : !>         using the acceptance probabilities for each move type
      51             : !>          of each temperature
      52             : !>        routine distinguishes the search for most probable node
      53             : !>         for energy and most probable node with open end
      54             : !>         for new configuration
      55             : !>        In case of searching open end:
      56             : !>         routine stops in branch with canceled NMC,
      57             : !>         using this a one possibility
      58             : !> \param global_tree_elem starting point for search
      59             : !> \param prob return value, the probability of reaching the tree node
      60             : !> \param n_acc drection of branch the next tree node should extend
      61             : !> \param search_energy_node ...
      62             : !> \parma search_energy_node flag if configuration for calculating exact
      63             : !>        energy should be searched
      64             : !> \author Mandes 12.2012
      65             : ! **************************************************************************************************
      66       88974 :    RECURSIVE SUBROUTINE most_prob_end(global_tree_elem, prob, n_acc, &
      67             :                                       search_energy_node)
      68             :       TYPE(global_tree_type), POINTER                    :: global_tree_elem
      69             :       REAL(KIND=dp), INTENT(OUT)                         :: prob
      70             :       LOGICAL, INTENT(INOUT)                             :: n_acc
      71             :       LOGICAL, OPTIONAL                                  :: search_energy_node
      72             : 
      73             :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'most_prob_end'
      74             : 
      75             :       INTEGER                                            :: handle
      76             :       LOGICAL                                            :: check_accepted, check_rejected, keep_on, &
      77             :                                                             tmp_acc, tmp_nacc
      78             :       REAL(KIND=dp)                                      :: prob_n_acc, prob_n_nacc
      79             :       TYPE(global_tree_type), POINTER                    :: ptr_acc, ptr_nacc
      80             :       TYPE(tree_type), POINTER                           :: st_elem
      81             : 
      82       44487 :       NULLIFY (st_elem, ptr_acc, ptr_nacc)
      83             : 
      84       44487 :       prob_n_acc = -100000
      85       44487 :       prob_n_nacc = -100000
      86       44487 :       check_accepted = .FALSE.
      87       44487 :       check_rejected = .FALSE.
      88       44487 :       keep_on = .TRUE.
      89             : 
      90       44487 :       CPASSERT(ASSOCIATED(global_tree_elem))
      91       44487 :       st_elem => global_tree_elem%conf(global_tree_elem%mv_conf)%elem
      92       44487 :       CPASSERT(ASSOCIATED(st_elem))
      93             : 
      94             :       ! start the timing
      95       44487 :       CALL timeset(routineN, handle)
      96             : 
      97             :       !-- follow trajectory until end
      98             :       !-- evaluate following elements using status, and probabilites
      99       44487 :       SELECT CASE (global_tree_elem%stat)
     100             :       CASE (status_accepted, status_accepted_result)
     101       40187 :          check_accepted = .TRUE.
     102             :       CASE (status_rejected, status_rejected_result)
     103       40187 :          check_rejected = .TRUE.
     104             :       CASE DEFAULT
     105             :          !-- set directions of searching
     106       44487 :          SELECT CASE (st_elem%stat)
     107             :          CASE (status_created, status_canceled_ener)
     108             :             ! just for searching next element to calculate energy for (found)
     109          21 :             IF (PRESENT(search_energy_node)) THEN
     110          21 :                prob = 0.0_dp ! = log(1)
     111          21 :                n_acc = .FALSE. ! not needed, but maybe for initialisation
     112          21 :                keep_on = .FALSE.
     113             :             ELSE
     114             :                check_accepted = .TRUE.
     115             :                check_rejected = .TRUE.
     116             :             END IF
     117             :          CASE (status_canceled_nmc)
     118             :             ! just for search new element to create (found)
     119             :             ! canceled elements can be reactivated
     120             :             ! the parent element is returned,
     121             :             !  the create_new_pt_tree_node check for existing of this node
     122           0 :             IF (.NOT. PRESENT(search_energy_node)) THEN
     123           0 :                prob = 0.0_dp
     124           0 :                n_acc = ASSOCIATED(global_tree_elem%parent%acc, global_tree_elem)
     125           0 :                global_tree_elem => global_tree_elem%parent
     126           0 :                keep_on = .FALSE.
     127             :             END IF
     128             :          CASE (status_calculated, status_calculate_energy, &
     129             :                status_accepted_result, status_accepted, &
     130             :                status_rejected, status_rejected_result)
     131             :             ! status accepted and rejection needed for swapped
     132             :             !  configurations in parallel tempering
     133           0 :             check_accepted = .TRUE.
     134           0 :             check_rejected = .TRUE.
     135             :          CASE (status_calculate_MD, status_calculate_NMC_steps, &
     136             :                status_calc_approx_ener)
     137             :             ! just for searching next element to create
     138           0 :             IF (.NOT. PRESENT(search_energy_node)) THEN
     139           0 :                check_rejected = .TRUE.
     140             :             END IF
     141             :          CASE (status_cancel_nmc, status_cancel_ener)
     142             :          CASE DEFAULT
     143             :             CALL cp_abort(__LOCATION__, &
     144             :                           "unknown sub tree element status "// &
     145          21 :                           cp_to_string(st_elem%stat))
     146             :          END SELECT
     147             :       END SELECT
     148             : 
     149       44487 :       IF (keep_on) THEN
     150             :          !-- recursive search, remembering lowest element (tree end),
     151             :          !     and multiply probabilities to go there
     152             :          !-- search in ACCEPTED branch
     153       44466 :          IF (check_accepted) THEN
     154             :             ! test if probable accepted child exist and is not rejected
     155        4279 :             IF (ASSOCIATED(global_tree_elem%acc)) THEN
     156        2859 :                ptr_acc => global_tree_elem%acc
     157        2859 :                IF (PRESENT(search_energy_node)) THEN
     158             :                   CALL most_prob_end(global_tree_elem=ptr_acc, prob=prob_n_acc, &
     159             :                                      n_acc=tmp_acc, &
     160        1434 :                                      search_energy_node=search_energy_node)
     161             :                ELSE
     162             :                   CALL most_prob_end(global_tree_elem=ptr_acc, prob=prob_n_acc, &
     163        1425 :                                      n_acc=tmp_acc)
     164             :                END IF
     165             :                !-- do probability multiplication
     166             :                !    (in logscale because of really small probabilities)
     167        2859 :                prob_n_acc = prob_n_acc + LOG(global_tree_elem%prob_acc)
     168             :             ELSE
     169             :                ! prob of going in acc or rej direction is
     170             :                !   calculated in parent element
     171        1420 :                prob_n_acc = LOG(global_tree_elem%prob_acc)
     172        1420 :                IF (PRESENT(search_energy_node)) prob_n_acc = -100000
     173        1420 :                ptr_acc => global_tree_elem
     174        1420 :                tmp_acc = .TRUE.
     175             :             END IF
     176             :          END IF
     177             : 
     178             :          !-- search in REJECTED branch
     179       44466 :          IF (check_rejected) THEN
     180             :             ! test if probabliy rejected child exist
     181       40187 :             IF (ASSOCIATED(global_tree_elem%nacc)) THEN
     182       37337 :                ptr_nacc => global_tree_elem%nacc
     183       37337 :                IF (PRESENT(search_energy_node)) THEN
     184             :                   CALL most_prob_end(global_tree_elem=ptr_nacc, prob=prob_n_nacc, &
     185             :                                      n_acc=tmp_nacc, &
     186       18677 :                                      search_energy_node=search_energy_node)
     187             :                ELSE
     188             :                   CALL most_prob_end(global_tree_elem=ptr_nacc, prob=prob_n_nacc, &
     189       18660 :                                      n_acc=tmp_nacc)
     190             :                END IF
     191             :                !-- do probability multiplication
     192             :                !     (in logscale because of really small probabilities)
     193       37337 :                prob_n_nacc = prob_n_nacc + LOG(1 - global_tree_elem%prob_acc)
     194             :             ELSE
     195             :                ! prob of going in acc or rej direction is
     196             :                !   calculated in parent element
     197        2850 :                prob_n_nacc = LOG(1 - global_tree_elem%prob_acc)
     198        2850 :                IF (PRESENT(search_energy_node)) prob_n_nacc = -100000
     199        2850 :                ptr_nacc => global_tree_elem
     200        2850 :                tmp_nacc = .FALSE.
     201             :             END IF
     202             :          END IF
     203             :          ! test which direction is more likely
     204             :          !   and set result pointer and probability,
     205             :          ! remembering the direction
     206       44466 :          IF (prob_n_acc .GE. prob_n_nacc) THEN
     207       24364 :             prob = prob_n_acc
     208       24364 :             global_tree_elem => ptr_acc
     209       24364 :             n_acc = tmp_acc
     210             :          ELSE
     211       20102 :             prob = prob_n_nacc
     212       20102 :             global_tree_elem => ptr_nacc
     213       20102 :             n_acc = tmp_nacc
     214             :          END IF
     215             :       END IF
     216             :       ! end the timing
     217       44487 :       CALL timestop(handle)
     218       44487 :    END SUBROUTINE most_prob_end
     219             : 
     220             : ! **************************************************************************************************
     221             : !> \brief gt_head head of the global tree
     222             : !> \param gt_head ...
     223             : !> \param new_gt_elem return value the energy should be calculated for
     224             : !> \param stat routine status return value
     225             : !> \param react_count reactivation counter
     226             : !> \author Mandes 12.2012
     227             : ! **************************************************************************************************
     228        4312 :    SUBROUTINE search_next_energy_calc(gt_head, new_gt_elem, stat, react_count)
     229             :       TYPE(global_tree_type), POINTER                    :: gt_head, new_gt_elem
     230             :       INTEGER                                            :: stat, react_count
     231             : 
     232             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'search_next_energy_calc'
     233             : 
     234             :       INTEGER                                            :: handle
     235             :       LOGICAL                                            :: flag
     236             :       REAL(KIND=dp)                                      :: prob
     237             : 
     238             :       prob = 0.0_dp
     239        2156 :       flag = .FALSE.
     240        2156 :       CPASSERT(ASSOCIATED(gt_head))
     241             : 
     242             :       ! start the timing
     243        2156 :       CALL timeset(routineN, handle)
     244             : 
     245        2156 :       new_gt_elem => gt_head
     246             : 
     247             :       CALL most_prob_end(global_tree_elem=new_gt_elem, prob=prob, n_acc=flag, &
     248        2156 :                          search_energy_node=.TRUE.)
     249             : 
     250        2156 :       stat = status_created
     251             :       ! set status for master
     252             :       !   (if TMC_STATUS_WAIT_FOR_NEW_TASK, no calculation necessary)
     253        2156 :       IF (.NOT. ASSOCIATED(new_gt_elem) .OR. (EXP(prob) .LT. 1.0E-10)) THEN
     254        2135 :          stat = TMC_STATUS_WAIT_FOR_NEW_TASK
     255             :       ELSE
     256             :          ! reactivate canceled elements
     257          21 :          IF (new_gt_elem%conf(new_gt_elem%mv_conf)%elem%stat .EQ. &
     258             :              status_canceled_ener) THEN
     259           0 :             CALL add_to_references(gt_elem=new_gt_elem)
     260           0 :             react_count = react_count + 1
     261           0 :             new_gt_elem%conf(new_gt_elem%mv_conf)%elem%stat = status_created
     262             :          END IF
     263             :          ! if elem status is not status_created
     264          21 :          IF (new_gt_elem%conf(new_gt_elem%mv_conf)%elem%stat .NE. status_created) THEN
     265           0 :             stat = TMC_STATUS_WAIT_FOR_NEW_TASK
     266             :          END IF
     267             :       END IF
     268             :       ! end the timing
     269        2156 :       CALL timestop(handle)
     270        2156 :    END SUBROUTINE search_next_energy_calc
     271             : 
     272             : ! **************************************************************************************************
     273             : !> \brief searching the parent element (last accepted configuration before)
     274             : !> \param current actual tree element
     275             : !> \return parent tree element (last accepted one)
     276             : !> \author Mandes 12.2012
     277             : !> \note routine searches last (assumed) accepted element in subtree
     278             : ! **************************************************************************************************
     279      810672 :    RECURSIVE FUNCTION search_parent_element(current) RESULT(parent)
     280             :       TYPE(tree_type), POINTER                           :: current, parent
     281             : 
     282             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'search_parent_element'
     283             : 
     284             :       INTEGER                                            :: handle
     285             : 
     286      405336 :       CPASSERT(ASSOCIATED(current))
     287             : 
     288             :       ! start the timing
     289      405336 :       CALL timeset(routineN, handle)
     290             : 
     291      405336 :       IF (ASSOCIATED(current%parent)) THEN
     292             :          ! the result value if the child (we came from) is in acc direction
     293      396797 :          parent => current%parent
     294      396797 :          IF (ASSOCIATED(parent%nacc, current)) THEN
     295      269127 :             parent => search_parent_element(parent)
     296             :          END IF
     297             :       ELSE
     298             :          ! if parent not exist, we are at the head of the tree
     299        8539 :          parent => current
     300             :       END IF
     301             :       ! end the timing
     302      405336 :       CALL timestop(handle)
     303      405336 :       CPASSERT(ASSOCIATED(parent))
     304      405336 :    END FUNCTION search_parent_element
     305             : 
     306             : ! **************************************************************************************************
     307             : !> \brief search the next global element in the Markov Chain to check
     308             : !> \param ptr start point for search, should be on the known Markov Chain
     309             : !> \param found flag if routine was successful
     310             : !> \author Mandes 12.2012
     311             : ! **************************************************************************************************
     312      930400 :    RECURSIVE SUBROUTINE search_next_gt_element_to_check(ptr, found)
     313             :       TYPE(global_tree_type), POINTER                    :: ptr
     314             :       LOGICAL                                            :: found
     315             : 
     316             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'search_next_gt_element_to_check'
     317             : 
     318             :       INTEGER                                            :: handle
     319             : 
     320      465200 :       found = .FALSE.
     321             : 
     322      465200 :       CPASSERT(ASSOCIATED(ptr))
     323             : 
     324             :       ! start the timing
     325      465200 :       CALL timeset(routineN, handle)
     326             : 
     327             :       ! -- global tree status is not updated after receiving calculations
     328             :       !    (not intrinsically), hence try to check elements with could be ready
     329      587586 :       SELECT CASE (ptr%stat)
     330             :       CASE (status_accepted_result)
     331      122386 :          IF (ASSOCIATED(ptr%acc)) THEN
     332      121663 :             ptr => ptr%acc
     333      121663 :             CALL search_next_gt_element_to_check(ptr, found)
     334             :          END IF
     335             :       CASE (status_rejected_result)
     336      212612 :          IF (ASSOCIATED(ptr%nacc)) THEN
     337      211187 :             ptr => ptr%nacc
     338      211187 :             CALL search_next_gt_element_to_check(ptr, found)
     339             :          END IF
     340             :       CASE (status_calculate_energy, status_created, &
     341             :             status_calculate_MD, status_calculated, status_calculate_NMC_steps, &
     342             :             status_calc_approx_ener, status_accepted, status_rejected)
     343      130202 :          found = .TRUE.
     344             :       CASE (status_cancel_nmc, status_cancel_ener, status_canceled_nmc, &
     345             :             status_canceled_ener)
     346             :          ! nothing to do
     347             :       CASE DEFAULT
     348             :          CALL cp_abort(__LOCATION__, &
     349             :                        "unexpected status "//cp_to_string(ptr%stat)// &
     350      465200 :                        "of global tree elem "//cp_to_string(ptr%nr))
     351             :       END SELECT
     352             :       ! end the timing
     353      465200 :       CALL timestop(handle)
     354             : 
     355      465200 :       CPASSERT(ASSOCIATED(ptr))
     356      465200 :    END SUBROUTINE search_next_gt_element_to_check
     357             : 
     358             : ! **************************************************************************************************
     359             : !> \brief get the changed element of the actual global tree element and its
     360             : !>        related last accepted parent
     361             : !> \param gt_act_elem actual global tree element
     362             : !> \param elem1 two subtree elements which should be compared
     363             : !> \param elem2 two subtree elements which should be compared
     364             : !> \author Mandes 12.2012
     365             : ! **************************************************************************************************
     366      264672 :    SUBROUTINE get_subtree_elements_to_check(gt_act_elem, elem1, elem2)
     367             :       TYPE(global_tree_type), POINTER                    :: gt_act_elem
     368             :       TYPE(tree_type), INTENT(OUT), POINTER              :: elem1, elem2
     369             : 
     370             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'get_subtree_elements_to_check'
     371             : 
     372             :       INTEGER                                            :: handle
     373             : 
     374      132336 :       CPASSERT(ASSOCIATED(gt_act_elem))
     375             : 
     376             :       ! start the timing
     377      132336 :       CALL timeset(routineN, handle)
     378             : 
     379      132336 :       IF (gt_act_elem%swaped) THEN
     380             :          !------------------------------------------------------------
     381             :          !-- take the last accepted configurations for check of both configurations, because
     382             :          !-- in case of swapping, the last accepted elements have to be compared
     383         336 :          IF (gt_act_elem%conf_n_acc(gt_act_elem%conf(gt_act_elem%mv_conf)%elem%sub_tree_nr)) THEN
     384         184 :             elem1 => gt_act_elem%conf(gt_act_elem%mv_conf)%elem
     385             :          ELSE
     386         152 :             elem1 => search_parent_element(gt_act_elem%conf(gt_act_elem%mv_conf)%elem)
     387             :          END IF
     388             :          ! second element
     389         336 :          IF (gt_act_elem%conf_n_acc(gt_act_elem%conf(gt_act_elem%mv_conf + 1)%elem%sub_tree_nr)) THEN
     390         212 :             elem2 => gt_act_elem%conf(gt_act_elem%mv_conf + 1)%elem
     391             :          ELSE
     392         124 :             elem2 => search_parent_element(gt_act_elem%conf(gt_act_elem%mv_conf + 1)%elem)
     393             :          END IF
     394             :       ELSE
     395      132000 :          elem1 => gt_act_elem%conf(gt_act_elem%mv_conf)%elem
     396      132000 :          elem2 => search_parent_element(elem1)
     397             :       END IF
     398             : 
     399             :       ! end the timing
     400      132336 :       CALL timestop(handle)
     401             : 
     402      132336 :       CPASSERT(ASSOCIATED(gt_act_elem))
     403      132336 :       CPASSERT(ASSOCIATED(elem1))
     404      132336 :       CPASSERT(ASSOCIATED(elem2))
     405      132336 :    END SUBROUTINE get_subtree_elements_to_check
     406             : 
     407             : ! **************************************************************************************************
     408             : !> \brief searches last element on trajectory,
     409             : !>        until where the sides of the tree are deleted (of global tree)
     410             : !>        also found the last accepted element before
     411             : !> \param last_acc returns last accepted element in cleaned tree part
     412             : !> \param tree_ptr end point of search
     413             : !> \author Mandes 12.2012
     414             : ! **************************************************************************************************
     415       52288 :    RECURSIVE SUBROUTINE search_end_of_clean_g_tree(last_acc, tree_ptr)
     416             :       TYPE(global_tree_type), POINTER                    :: last_acc, tree_ptr
     417             : 
     418             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'search_end_of_clean_g_tree'
     419             : 
     420             :       INTEGER                                            :: handle
     421             : 
     422       26144 :       CPASSERT(ASSOCIATED(last_acc))
     423       26144 :       CPASSERT(ASSOCIATED(tree_ptr))
     424             : 
     425             :       ! start the timing
     426       26144 :       CALL timeset(routineN, handle)
     427             : 
     428       29652 :       SELECT CASE (tree_ptr%stat)
     429             :       CASE (status_accepted_result)
     430        3508 :          IF (ASSOCIATED(tree_ptr%acc) .AND. .NOT. ASSOCIATED(tree_ptr%nacc)) THEN
     431        2812 :             last_acc => tree_ptr
     432        2812 :             tree_ptr => tree_ptr%acc
     433        2812 :             CALL search_end_of_clean_g_tree(last_acc, tree_ptr)
     434             :          END IF
     435             :       CASE (status_rejected_result)
     436       22636 :          IF (ASSOCIATED(tree_ptr%nacc) .AND. .NOT. ASSOCIATED(tree_ptr%acc)) THEN
     437       21211 :             tree_ptr => tree_ptr%nacc
     438       21211 :             CALL search_end_of_clean_g_tree(last_acc, tree_ptr)
     439             :          END IF
     440             :       CASE (status_calculated, status_calculate_energy, status_created, status_accepted, status_rejected, &
     441             :             status_calculate_MD, status_calculate_NMC_steps, status_calc_approx_ener, &
     442             :             status_canceled_ener, status_canceled_nmc, &
     443             :             status_cancel_nmc, status_cancel_ener)
     444             :          ! nothing to do
     445             :       CASE DEFAULT
     446             :          CALL cp_abort(__LOCATION__, &
     447             :                        "the global tree element "//cp_to_string(tree_ptr%nr)// &
     448       26144 :                        " stat "//cp_to_string(tree_ptr%stat)//" is UNknown")
     449             :       END SELECT
     450             :       ! end the timing
     451       26144 :       CALL timestop(handle)
     452       26144 :       CPASSERT(ASSOCIATED(last_acc))
     453       26144 :       CPASSERT(ASSOCIATED(tree_ptr))
     454       26144 :    END SUBROUTINE search_end_of_clean_g_tree
     455             : 
     456             : ! **************************************************************************************************
     457             : !> \brief searches last element on trajectory,
     458             : !>        until where the sides of the tree are deleted (in sub tree)
     459             : !>        also found the last accepted element before.
     460             : !>        searches the last element which at least have ONE (not calculated)
     461             : !>        node in the tree branch
     462             : !> \param tree_ptr  ...
     463             : !> \param last_acc ...
     464             : !> \author Mandes 12.2012
     465             : ! **************************************************************************************************
     466       11454 :    RECURSIVE SUBROUTINE search_end_of_clean_tree(tree_ptr, last_acc)
     467             :       TYPE(tree_type), POINTER                           :: tree_ptr
     468             :       TYPE(tree_type), INTENT(IN), POINTER               :: last_acc
     469             : 
     470             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'search_end_of_clean_tree'
     471             : 
     472             :       INTEGER                                            :: handle
     473             : 
     474        5727 :       CPASSERT(ASSOCIATED(tree_ptr))
     475        5727 :       CPASSERT(ASSOCIATED(last_acc))
     476             : 
     477             :       ! start the timing
     478        5727 :       CALL timeset(routineN, handle)
     479             : 
     480        5727 :       IF (.NOT. ASSOCIATED(last_acc, tree_ptr)) THEN
     481        1804 :          IF (ASSOCIATED(tree_ptr%acc) .AND. .NOT. ASSOCIATED(tree_ptr%nacc)) THEN
     482         570 :             tree_ptr => tree_ptr%acc
     483         570 :             CALL search_end_of_clean_tree(tree_ptr, last_acc)
     484        1234 :          ELSE IF (ASSOCIATED(tree_ptr%nacc) .AND. .NOT. ASSOCIATED(tree_ptr%acc)) THEN
     485        1234 :             tree_ptr => tree_ptr%nacc
     486        1234 :             CALL search_end_of_clean_tree(tree_ptr, last_acc)
     487             :          END IF
     488             :       END IF
     489             :       ! end the timing
     490        5727 :       CALL timestop(handle)
     491        5727 :       CPASSERT(ASSOCIATED(tree_ptr))
     492        5727 :       CPASSERT(ASSOCIATED(last_acc))
     493        5727 :    END SUBROUTINE search_end_of_clean_tree
     494             : 
     495             : ! **************************************************************************************************
     496             : !> \brief searches in all branches down below the entered global tree element
     497             : !>        for elements to cancel, if prob is present start searching at the
     498             : !>        related tree child node
     499             : !> \param pt_elem_in start search point
     500             : !> \param prob the acceptance probability of the tree element to define
     501             : !>        the direction to start with
     502             : !> \param tmc_env TMC environment
     503             : !> \author Mandes 12.2012
     504             : ! **************************************************************************************************
     505           0 :    RECURSIVE SUBROUTINE search_canceling_elements(pt_elem_in, prob, tmc_env)
     506             :       TYPE(global_tree_type), INTENT(IN), POINTER        :: pt_elem_in
     507             :       REAL(KIND=dp), OPTIONAL                            :: prob
     508             :       TYPE(tmc_env_type), POINTER                        :: tmc_env
     509             : 
     510             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'search_canceling_elements'
     511             : 
     512             :       INTEGER                                            :: handle
     513             :       LOGICAL                                            :: ready
     514             :       TYPE(global_tree_type), POINTER                    :: act_pt_ptr, pt_elem
     515             : 
     516           0 :       NULLIFY (pt_elem, act_pt_ptr)
     517           0 :       CPASSERT(ASSOCIATED(pt_elem_in))
     518           0 :       CPASSERT(ASSOCIATED(tmc_env))
     519             : 
     520             :       ! start the timing
     521           0 :       CALL timeset(routineN, handle)
     522             : 
     523           0 :       ready = .TRUE.
     524             :       ! if prob present select the related branch
     525           0 :       IF (PRESENT(prob)) THEN
     526           0 :          IF (prob .LT. 1.0E-10 .AND. ASSOCIATED(pt_elem_in%acc)) THEN
     527           0 :             pt_elem => pt_elem_in%acc
     528           0 :          ELSE IF (prob .GT. (1.0_dp - 1.0E-10) .AND. ASSOCIATED(pt_elem_in%nacc)) THEN
     529           0 :             pt_elem => pt_elem_in%nacc
     530             :          ELSE
     531             :             ready = .FALSE.
     532             :          END IF
     533             :       ELSE
     534           0 :          pt_elem => pt_elem_in
     535             :       END IF
     536             : 
     537             :       IF (ready) THEN
     538           0 :          IF (ASSOCIATED(pt_elem%conf(pt_elem%mv_conf)%elem)) THEN
     539           0 :             SELECT CASE (pt_elem%conf(pt_elem%mv_conf)%elem%stat)
     540             :             CASE (status_accepted_result, status_accepted, status_rejected_result, &
     541             :                   status_rejected, status_created, status_cancel_nmc, &
     542             :                   status_cancel_ener, status_canceled_nmc, status_canceled_ener, &
     543             :                   status_calculated, status_deleted, status_deleted_result, &
     544             :                   status_calc_approx_ener) ! no canceling
     545             :             CASE (status_calculate_NMC_steps, status_calculate_MD, &
     546             :                   status_calculate_energy)
     547             :                CALL search_and_remove_reference_in_list(gt_ptr=pt_elem, &
     548           0 :                                                         elem=pt_elem%conf(pt_elem%mv_conf)%elem, tmc_env=tmc_env)
     549             : 
     550             :             CASE DEFAULT
     551             :                CALL cp_abort(__LOCATION__, &
     552             :                              "unknown status of subtree element"// &
     553           0 :                              cp_to_string(pt_elem%conf(pt_elem%mv_conf)%elem%stat))
     554             :             END SELECT
     555             :          END IF
     556             :          !-- go until the ends ot he tree, to search for elements to cancel
     557             :          !-- check if child nodes exist
     558           0 :          IF (ASSOCIATED(pt_elem%acc)) THEN
     559           0 :             act_pt_ptr => pt_elem%acc
     560           0 :             CALL search_canceling_elements(pt_elem_in=act_pt_ptr, tmc_env=tmc_env)
     561             :          END IF
     562           0 :          IF (ASSOCIATED(pt_elem%nacc)) THEN
     563           0 :             act_pt_ptr => pt_elem%nacc
     564           0 :             CALL search_canceling_elements(pt_elem_in=act_pt_ptr, tmc_env=tmc_env)
     565             :          END IF
     566             :       END IF
     567             :       ! end the timing
     568           0 :       CALL timestop(handle)
     569           0 :       CPASSERT(ASSOCIATED(pt_elem_in))
     570           0 :    END SUBROUTINE search_canceling_elements
     571             : 
     572             : ! **************************************************************************************************
     573             : !> \brief searches for created configurations in all subtrees
     574             : !> \param global_tree_ptr pointer to one global tree element
     575             : !> \param counters array returning the counters for each subtree
     576             : !> \author Mandes 01.2013
     577             : ! **************************************************************************************************
     578          56 :    SUBROUTINE count_prepared_nodes_in_trees(global_tree_ptr, counters)
     579             :       TYPE(global_tree_type), INTENT(IN), POINTER        :: global_tree_ptr
     580             :       INTEGER, DIMENSION(:), POINTER                     :: counters
     581             : 
     582             :       CHARACTER(len=*), PARAMETER :: routineN = 'count_prepared_nodes_in_trees'
     583             : 
     584             :       INTEGER                                            :: handle, i
     585             :       TYPE(tree_type), POINTER                           :: begin_ptr
     586             : 
     587             :       NULLIFY (begin_ptr)
     588             : 
     589          28 :       CPASSERT(ASSOCIATED(global_tree_ptr))
     590          28 :       CPASSERT(ASSOCIATED(counters))
     591          28 :       CPASSERT(SIZE(counters(1:)) .EQ. SIZE(global_tree_ptr%conf(:)))
     592             : 
     593             :       ! start the timing
     594          28 :       CALL timeset(routineN, handle)
     595             : 
     596          86 :       counters(:) = 0
     597          58 :       DO i = 1, SIZE(global_tree_ptr%conf(:))
     598          30 :          begin_ptr => global_tree_ptr%conf(i)%elem
     599             :          CALL count_prepared_nodes_in_subtree(tree_ptr=begin_ptr, &
     600          58 :                                               counter=counters(i))
     601             :       END DO
     602             : 
     603             :       ! end the timing
     604          28 :       CALL timestop(handle)
     605          28 :    END SUBROUTINE count_prepared_nodes_in_trees
     606             : 
     607             : ! **************************************************************************************************
     608             : !> \brief counts the prepared tree nodes in subtrees
     609             : !> \param tree_ptr pointer to one subtree element
     610             : !> \param counter returning the amount of prepared
     611             : !>        (ready for energy calculation) elements ind certain sub tree
     612             : !> \author Mandes 01.2013
     613             : ! **************************************************************************************************
     614          54 :    RECURSIVE SUBROUTINE count_prepared_nodes_in_subtree(tree_ptr, counter)
     615             :       TYPE(tree_type), POINTER                           :: tree_ptr
     616             :       INTEGER                                            :: counter
     617             : 
     618             :       TYPE(tree_type), POINTER                           :: tmp_ptr
     619             : 
     620          54 :       NULLIFY (tmp_ptr)
     621             : 
     622          54 :       CPASSERT(ASSOCIATED(tree_ptr))
     623             : 
     624          77 :       SELECT CASE (tree_ptr%stat)
     625             :       CASE (status_accepted, status_accepted_result)
     626          23 :          IF (ASSOCIATED(tree_ptr%acc)) THEN
     627          23 :             tmp_ptr => tree_ptr%acc
     628          23 :             CALL count_prepared_nodes_in_subtree(tmp_ptr, counter)
     629             :          END IF
     630             :       CASE (status_rejected, status_rejected_result)
     631           1 :          IF (ASSOCIATED(tree_ptr%nacc)) THEN
     632           1 :             tmp_ptr => tree_ptr%nacc
     633           1 :             CALL count_prepared_nodes_in_subtree(tmp_ptr, counter)
     634             :          END IF
     635             :       CASE (status_created, status_calculate_MD, status_calculate_NMC_steps, &
     636             :             status_calc_approx_ener, status_calculated, status_calculate_energy)
     637          30 :          IF (tree_ptr%stat .EQ. status_created) counter = counter + 1
     638          30 :          IF (ASSOCIATED(tree_ptr%acc)) THEN
     639           0 :             tmp_ptr => tree_ptr%acc
     640           0 :             CALL count_prepared_nodes_in_subtree(tmp_ptr, counter)
     641             :          END IF
     642          30 :          IF (ASSOCIATED(tree_ptr%nacc)) THEN
     643           0 :             tmp_ptr => tree_ptr%nacc
     644           0 :             CALL count_prepared_nodes_in_subtree(tmp_ptr, counter)
     645             :          END IF
     646             :       CASE (status_cancel_nmc, status_cancel_ener, status_canceled_nmc, &
     647             :             status_canceled_ener)
     648             :          !TODO maybe also count caneled confs for debug output
     649             :       CASE DEFAULT
     650             :          CALL cp_abort(__LOCATION__, &
     651             :                        "stat "//cp_to_string(tree_ptr%stat)// &
     652             :                        "of elem "//cp_to_string(tree_ptr%nr)// &
     653          54 :                        "unknown.")
     654             :       END SELECT
     655          54 :    END SUBROUTINE count_prepared_nodes_in_subtree
     656             : 
     657             : ! **************************************************************************************************
     658             : !> \brief counts the number of existing nodes in global and subtrees
     659             : !> \param global_tree_ptr pointer to one global tree element
     660             : !> \param end_of_clean_trees points to the last elements of the clean sub trees
     661             : !> \param counters array returning the counters for each subtree
     662             : !> \param head_elements_nr node number of the existing
     663             : !>        global and sub tree heads
     664             : !> \author Mandes 01.2013
     665             : ! **************************************************************************************************
     666         314 :    SUBROUTINE count_nodes_in_trees(global_tree_ptr, end_of_clean_trees, &
     667             :                                    counters, head_elements_nr)
     668             :       TYPE(global_tree_type), POINTER                    :: global_tree_ptr
     669             :       TYPE(elem_array_type), DIMENSION(:), POINTER       :: end_of_clean_trees
     670             :       INTEGER, DIMENSION(:), POINTER                     :: counters, head_elements_nr
     671             : 
     672             :       CHARACTER(len=*), PARAMETER :: routineN = 'count_nodes_in_trees'
     673             : 
     674             :       INTEGER                                            :: handle, i
     675             :       TYPE(global_tree_type), POINTER                    :: begin_gt_ptr
     676             :       TYPE(tree_type), POINTER                           :: begin_ptr
     677             : 
     678             :       NULLIFY (begin_gt_ptr, begin_ptr)
     679             : 
     680         157 :       CPASSERT(ASSOCIATED(global_tree_ptr))
     681         157 :       CPASSERT(ASSOCIATED(end_of_clean_trees))
     682         157 :       CPASSERT(ASSOCIATED(counters))
     683         157 :       CPASSERT(SIZE(counters(1:)) .EQ. SIZE(global_tree_ptr%conf(:)))
     684             : 
     685             :       ! start the timing
     686         157 :       CALL timeset(routineN, handle)
     687             : 
     688         157 :       begin_gt_ptr => global_tree_ptr
     689         707 :       counters(:) = 0
     690         130 :       DO
     691         287 :          IF (.NOT. ASSOCIATED(begin_gt_ptr%parent)) EXIT
     692         130 :          begin_gt_ptr => begin_gt_ptr%parent
     693             :       END DO
     694         157 :       head_elements_nr(0) = begin_gt_ptr%nr
     695         157 :       CALL count_nodes_in_global_tree(begin_gt_ptr, counters(0))
     696         550 :       DO i = 1, SIZE(end_of_clean_trees(:))
     697         393 :          begin_ptr => end_of_clean_trees(i)%elem
     698          56 :          DO
     699         449 :             IF (.NOT. ASSOCIATED(begin_ptr%parent)) EXIT
     700          56 :             begin_ptr => begin_ptr%parent
     701             :          END DO
     702         393 :          head_elements_nr(i) = begin_ptr%nr
     703         550 :          CALL count_nodes_in_tree(begin_ptr, counters(i))
     704             :       END DO
     705             : 
     706             :       ! end the timing
     707         157 :       CALL timestop(handle)
     708         157 :    END SUBROUTINE count_nodes_in_trees
     709             : 
     710             : ! **************************************************************************************************
     711             : !> \brief counts existing nodes in global tree
     712             : !> \param ptr global tree head
     713             : !> \param counter return value with the amount of existing global tree elements
     714             : !> \author Mandes 01.2013
     715             : ! **************************************************************************************************
     716         655 :    RECURSIVE SUBROUTINE count_nodes_in_global_tree(ptr, counter)
     717             :       TYPE(global_tree_type), INTENT(IN), POINTER        :: ptr
     718             :       INTEGER, INTENT(INOUT)                             :: counter
     719             : 
     720         655 :       CPASSERT(ASSOCIATED(ptr))
     721             : 
     722         655 :       counter = counter + 1
     723             : 
     724         655 :       IF (ASSOCIATED(ptr%acc)) &
     725         236 :          CALL count_nodes_in_global_tree(ptr%acc, counter)
     726         655 :       IF (ASSOCIATED(ptr%nacc)) &
     727         262 :          CALL count_nodes_in_global_tree(ptr%nacc, counter)
     728         655 :    END SUBROUTINE count_nodes_in_global_tree
     729             : 
     730             : ! **************************************************************************************************
     731             : !> \brief counts existing nodes in certain sub tree
     732             : !> \param ptr subtree tree head
     733             : !> \param counter return value with the amount of existing sub tree elements
     734             : !> \author Mandes 01.2013
     735             : ! **************************************************************************************************
     736         972 :    RECURSIVE SUBROUTINE count_nodes_in_tree(ptr, counter)
     737             :       TYPE(tree_type), POINTER                           :: ptr
     738             :       INTEGER                                            :: counter
     739             : 
     740         972 :       CPASSERT(ASSOCIATED(ptr))
     741             : 
     742         972 :       counter = counter + 1
     743             : 
     744         972 :       IF (ASSOCIATED(ptr%acc)) &
     745         271 :          CALL count_nodes_in_tree(ptr%acc, counter)
     746         972 :       IF (ASSOCIATED(ptr%nacc)) &
     747         308 :          CALL count_nodes_in_tree(ptr%nacc, counter)
     748         972 :    END SUBROUTINE count_nodes_in_tree
     749             : END MODULE tmc_tree_search

Generated by: LCOV version 1.15