LCOV - code coverage report
Current view: top level - src/tmc - tmc_tree_references.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 78.9 % 71 56
Test Date: 2025-07-25 12:55:17 Functions: 100.0 % 4 4

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief global tree references
      10              : !>        - BECAUSE acceptance check use global tree randon numbers and
      11              : !>            (in case of parallel tempering) several global tree node refer to a
      12              : !>            single sub tree node (which is the changed one in the global tree)
      13              : !>        - the references are used to update the global tree acceptance probability
      14              : !>            for every global tree element separately
      15              : !>        Hence a list of all global tree nodes, using the related subtree node,
      16              : !>            is created.
      17              : !> \par History
      18              : !>      11.2012 created [Mandes Schoenherr]
      19              : !> \author Mandes
      20              : ! **************************************************************************************************
      21              : 
      22              : MODULE tmc_tree_references
      23              :    USE cp_log_handling,                 ONLY: cp_to_string
      24              :    USE tmc_cancelation,                 ONLY: add_to_canceling_list
      25              :    USE tmc_tree_types,                  ONLY: global_tree_type,&
      26              :                                               gt_elem_list_type,&
      27              :                                               tree_type
      28              :    USE tmc_types,                       ONLY: tmc_env_type
      29              : #include "../base/base_uses.f90"
      30              : 
      31              :    IMPLICIT NONE
      32              : 
      33              :    PRIVATE
      34              : 
      35              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tmc_tree_references'
      36              : 
      37              :    PUBLIC :: add_to_references
      38              :    PUBLIC :: search_and_remove_reference_in_list
      39              :    PUBLIC :: remove_subtree_element_of_all_references
      40              :    PUBLIC :: remove_gt_references
      41              : CONTAINS
      42              : 
      43              : ! **************************************************************************************************
      44              : !> \brief adds global tree reference to the modified sub tree element(s)
      45              : !> \param gt_elem actual global tree element
      46              : !> \author Mandes 12.2012
      47              : ! **************************************************************************************************
      48         9488 :    SUBROUTINE add_to_references(gt_elem)
      49              :       TYPE(global_tree_type), POINTER                    :: gt_elem
      50              : 
      51              :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'add_to_references'
      52              : 
      53              :       INTEGER                                            :: handle
      54              :       TYPE(gt_elem_list_type), POINTER                   :: tmp_pt_list_elem
      55              : 
      56         4744 :       NULLIFY (tmp_pt_list_elem)
      57              : 
      58         4744 :       CPASSERT(ASSOCIATED(gt_elem))
      59              : 
      60              :       ! start the timing
      61         4744 :       CALL timeset(routineN, handle)
      62              : 
      63              :       ! create reference and add at the beginning of the list
      64         4744 :       ALLOCATE (tmp_pt_list_elem)
      65         4744 :       tmp_pt_list_elem%gt_elem => gt_elem
      66         4744 :       IF (ASSOCIATED(gt_elem%conf(gt_elem%mv_conf)%elem%gt_nodes_references)) THEN
      67          142 :          tmp_pt_list_elem%next => gt_elem%conf(gt_elem%mv_conf)%elem%gt_nodes_references
      68              :       ELSE
      69              :          tmp_pt_list_elem%next => NULL()
      70              :       END IF
      71         4744 :       gt_elem%conf(gt_elem%mv_conf)%elem%gt_nodes_references => tmp_pt_list_elem
      72              : 
      73              :       ! in case of swapped configurations both are necessary to do acceptance probability update
      74              :       !   also when second configuration returns a value
      75         4744 :       IF (gt_elem%swaped) THEN
      76              :          ! add reference to swapped elem
      77          168 :          ALLOCATE (tmp_pt_list_elem)
      78          168 :          tmp_pt_list_elem%gt_elem => gt_elem
      79          168 :          IF (ASSOCIATED(gt_elem%conf(gt_elem%mv_conf + 1)%elem%gt_nodes_references)) THEN
      80          145 :             tmp_pt_list_elem%next => gt_elem%conf(gt_elem%mv_conf + 1)%elem%gt_nodes_references
      81              :          ELSE
      82              :             tmp_pt_list_elem%next => NULL()
      83              :          END IF
      84          168 :          gt_elem%conf(gt_elem%mv_conf + 1)%elem%gt_nodes_references => tmp_pt_list_elem
      85              :       END IF
      86              :       ! end the timing
      87         4744 :       CALL timestop(handle)
      88         4744 :    END SUBROUTINE add_to_references
      89              : 
      90              : ! **************************************************************************************************
      91              : !> \brief removes the global tree references of this actual global tree element
      92              : !>        from all related sub tree elements
      93              : !> \param gt_ptr actual global tree element
      94              : !> \param tmc_env ...
      95              : !> \author Mandes 12.2012
      96              : ! **************************************************************************************************
      97         9488 :    SUBROUTINE remove_gt_references(gt_ptr, tmc_env)
      98              :       TYPE(global_tree_type), POINTER                    :: gt_ptr
      99              :       TYPE(tmc_env_type), POINTER                        :: tmc_env
     100              : 
     101              :       CHARACTER(LEN=*), PARAMETER :: routineN = 'remove_gt_references'
     102              : 
     103              :       INTEGER                                            :: handle
     104              : 
     105         4744 :       CPASSERT(ASSOCIATED(gt_ptr))
     106         4744 :       CPASSERT(ASSOCIATED(tmc_env))
     107              : 
     108              :       ! start the timing
     109         4744 :       CALL timeset(routineN, handle)
     110              : 
     111              :       CALL search_and_remove_reference_in_list(gt_ptr=gt_ptr, &
     112         4744 :                                                elem=gt_ptr%conf(gt_ptr%mv_conf)%elem, tmc_env=tmc_env)
     113              : 
     114              :       ! in case of parallel tempering also the reference in the second swaped configuration has to be removed
     115         4744 :       IF (gt_ptr%swaped) THEN
     116              :          CALL search_and_remove_reference_in_list(gt_ptr=gt_ptr, &
     117          168 :                                                   elem=gt_ptr%conf(gt_ptr%mv_conf + 1)%elem, tmc_env=tmc_env)
     118              :       END IF
     119              :       ! end the timing
     120         4744 :       CALL timestop(handle)
     121         4744 :    END SUBROUTINE remove_gt_references
     122              : 
     123              : ! **************************************************************************************************
     124              : !> \brief removes the pointers to a certain subtree element from every related
     125              : !>        global tree element
     126              : !> \param ptr sub tree element
     127              : !> \author Mandes 12.2012
     128              : ! **************************************************************************************************
     129        20782 :    SUBROUTINE remove_subtree_element_of_all_references(ptr)
     130              :       TYPE(tree_type), POINTER                           :: ptr
     131              : 
     132              :       CHARACTER(LEN=*), PARAMETER :: routineN = 'remove_subtree_element_of_all_references'
     133              : 
     134              :       CHARACTER(len=2000)                                :: list_of_nr
     135              :       INTEGER                                            :: handle, i
     136              :       TYPE(gt_elem_list_type), POINTER                   :: tmp_gt_list_ptr
     137              : 
     138        10391 :       NULLIFY (tmp_gt_list_ptr)
     139              : 
     140        10391 :       CPASSERT(ASSOCIATED(ptr))
     141              : 
     142              :       ! start the timing
     143        10391 :       CALL timeset(routineN, handle)
     144              : 
     145        10391 :       pt_node_ref_loop: DO WHILE (ASSOCIATED(ptr%gt_nodes_references))
     146            0 :          tmp_gt_list_ptr => ptr%gt_nodes_references
     147            0 :          CPASSERT(ASSOCIATED(tmp_gt_list_ptr%gt_elem))
     148              :          CALL cp_abort(__LOCATION__, &
     149              :                        "found reference of global tree node "// &
     150              :                        cp_to_string(tmp_gt_list_ptr%gt_elem%nr)// &
     151              :                        ", while removing sub tree node "// &
     152            0 :                        cp_to_string(ptr%sub_tree_nr)//cp_to_string(ptr%nr))
     153              :          ! check if configurations exist
     154            0 :          IF (ASSOCIATED(tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf)%elem)) THEN
     155            0 :             IF (ASSOCIATED(ptr, tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf)%elem)) THEN
     156            0 :                tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf)%elem => NULL()
     157              :                ! in case of swapping the second configuration could be the related one
     158            0 :             ELSE IF (ASSOCIATED(ptr, tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf + 1)%elem)) THEN
     159            0 :                tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf + 1)%elem => NULL()
     160              :             ELSE
     161            0 :                list_of_nr = ""
     162            0 :                DO i = 1, SIZE(tmp_gt_list_ptr%gt_elem%conf)
     163            0 :                   WRITE (list_of_nr, *) TRIM(ADJUSTL(list_of_nr)), tmp_gt_list_ptr%gt_elem%conf(i)%elem%sub_tree_nr, &
     164            0 :                      tmp_gt_list_ptr%gt_elem%conf(i)%elem%nr, " | "
     165              :                END DO
     166              :                CALL cp_warn(__LOCATION__, &
     167              :                             "for subtree "// &
     168              :                             cp_to_string(ptr%sub_tree_nr)// &
     169              :                             "element "//cp_to_string(ptr%nr)// &
     170              :                             "global tree element"//cp_to_string(tmp_gt_list_ptr%gt_elem%nr)// &
     171              :                             "swaped"//cp_to_string(tmp_gt_list_ptr%gt_elem%swaped)// &
     172              :                             "moved elem"//cp_to_string(tmp_gt_list_ptr%gt_elem%mv_conf)// &
     173              :                             "with the related subtree, elements: "// &
     174            0 :                             TRIM(ADJUSTL(list_of_nr)))
     175              :             END IF
     176              :          ELSE
     177              :             CALL cp_warn(__LOCATION__, &
     178              :                          "for subtree "//cp_to_string(ptr%sub_tree_nr)// &
     179              :                          "element "//cp_to_string(ptr%nr)// &
     180              :                          " is not related to global tree node "//cp_to_string(tmp_gt_list_ptr%gt_elem%nr)// &
     181            0 :                          "(anymore).")
     182              :          END IF
     183            0 :          ptr%gt_nodes_references => ptr%gt_nodes_references%next
     184        10391 :          DEALLOCATE (tmp_gt_list_ptr)
     185              :       END DO pt_node_ref_loop
     186              : 
     187              :       ! end the timing
     188        10391 :       CALL timestop(handle)
     189              : 
     190        10391 :       CPASSERT(.NOT. ASSOCIATED(ptr%gt_nodes_references))
     191        10391 :    END SUBROUTINE remove_subtree_element_of_all_references
     192              : 
     193              : ! **************************************************************************************************
     194              : !> \brief removes the global tree references of this actual global tree element
     195              : !>        from all related sub tree elements
     196              : !> \param gt_ptr actual global tree element
     197              : !> \param elem ...
     198              : !> \param tmc_env TMC environment
     199              : !> \author Mandes 12.2012
     200              : ! **************************************************************************************************
     201        10178 :    SUBROUTINE search_and_remove_reference_in_list(gt_ptr, elem, tmc_env)
     202              :       TYPE(global_tree_type), POINTER                    :: gt_ptr
     203              :       TYPE(tree_type), POINTER                           :: elem
     204              :       TYPE(tmc_env_type), POINTER                        :: tmc_env
     205              : 
     206              :       CHARACTER(LEN=*), PARAMETER :: routineN = 'search_and_remove_reference_in_list'
     207              : 
     208              :       INTEGER                                            :: handle
     209              :       TYPE(gt_elem_list_type), POINTER                   :: tmp_gt_list_last_ptr, tmp_gt_list_ptr
     210              : 
     211         5089 :       NULLIFY (tmp_gt_list_ptr, tmp_gt_list_last_ptr)
     212              : 
     213              :       ! nothing to do, when subtree element is already deleted
     214         5089 :       IF (.NOT. ASSOCIATED(elem)) RETURN
     215         5089 :       IF (.NOT. ASSOCIATED(gt_ptr)) RETURN
     216              : 
     217         5089 :       CPASSERT(ASSOCIATED(tmc_env))
     218              : 
     219              :       ! start the timing
     220         5089 :       CALL timeset(routineN, handle)
     221              : 
     222              :       ! set the entry point od the list
     223         5089 :       tmp_gt_list_ptr => elem%gt_nodes_references
     224         5089 :       tmp_gt_list_last_ptr => elem%gt_nodes_references
     225              : 
     226              :       ! search related reference
     227         5778 :       DO WHILE (ASSOCIATED(tmp_gt_list_ptr))
     228              :          ! remove reference, if it is related to the global tree element
     229         5314 :          IF (ASSOCIATED(tmp_gt_list_ptr%gt_elem, gt_ptr)) THEN
     230              :             ! first reference?
     231         4912 :             IF (ASSOCIATED(tmp_gt_list_ptr, elem%gt_nodes_references)) THEN
     232              :                ! additionally last reference (the only one)?
     233         4639 :                IF (.NOT. ASSOCIATED(tmp_gt_list_ptr%next)) THEN
     234              :                   ! last element in list -> cancel calculation
     235         4625 :                   CALL add_to_canceling_list(elem=elem, tmc_env=tmc_env)
     236         4625 :                   elem%gt_nodes_references => NULL()
     237              :                   tmp_gt_list_last_ptr => NULL()
     238              :                ELSE
     239              :                   ! if first list element and NOT last one:
     240              :                   ! set list pointer to second element
     241           14 :                   elem%gt_nodes_references => tmp_gt_list_ptr%next
     242           14 :                   tmp_gt_list_last_ptr => elem%gt_nodes_references
     243              :                END IF
     244              :             ELSE
     245              :                ! if NOT first one
     246              :                ! skip that element in list
     247          273 :                tmp_gt_list_last_ptr%next => tmp_gt_list_ptr%next
     248              :             END IF
     249              : 
     250              :             ! deallocate list element
     251         4912 :             DEALLOCATE (tmp_gt_list_ptr)
     252              :             ! going back to last list element
     253              :             tmp_gt_list_ptr => tmp_gt_list_last_ptr
     254              :          END IF
     255              :          ! setting to next list element
     256         5601 :          tmp_gt_list_last_ptr => tmp_gt_list_ptr
     257              :          ! go to next list element, if defined
     258         5778 :          IF (ASSOCIATED(tmp_gt_list_ptr)) tmp_gt_list_ptr => tmp_gt_list_ptr%next
     259              :       END DO
     260              :       ! end the timing
     261         5089 :       CALL timestop(handle)
     262              :    END SUBROUTINE search_and_remove_reference_in_list
     263              : 
     264              : END MODULE tmc_tree_references
        

Generated by: LCOV version 2.0-1