Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief 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        9424 :    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        4712 :       NULLIFY (tmp_pt_list_elem)
      57             : 
      58        4712 :       CPASSERT(ASSOCIATED(gt_elem))
      59             : 
      60             :       ! start the timing
      61        4712 :       CALL timeset(routineN, handle)
      62             : 
      63             :       ! create reference and add at the beginning of the list
      64        4712 :       ALLOCATE (tmp_pt_list_elem)
      65        4712 :       tmp_pt_list_elem%gt_elem => gt_elem
      66        4712 :       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        4712 :       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        4712 :       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        4712 :       CALL timestop(handle)
      88        4712 :    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        9424 :    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        4712 :       CPASSERT(ASSOCIATED(gt_ptr))
     106        4712 :       CPASSERT(ASSOCIATED(tmc_env))
     107             : 
     108             :       ! start the timing
     109        4712 :       CALL timeset(routineN, handle)
     110             : 
     111             :       CALL search_and_remove_reference_in_list(gt_ptr=gt_ptr, &
     112        4712 :                                                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        4712 :       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        4712 :       CALL timestop(handle)
     121        4712 :    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       20654 :    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       10327 :       NULLIFY (tmp_gt_list_ptr)
     139             : 
     140       10327 :       CPASSERT(ASSOCIATED(ptr))
     141             : 
     142             :       ! start the timing
     143       10327 :       CALL timeset(routineN, handle)
     144             : 
     145       10327 :       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       10327 :          DEALLOCATE (tmp_gt_list_ptr)
     185             :       END DO pt_node_ref_loop
     186             : 
     187             :       ! end the timing
     188       10327 :       CALL timestop(handle)
     189             : 
     190       10327 :       CPASSERT(.NOT. ASSOCIATED(ptr%gt_nodes_references))
     191       10327 :    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       10080 :    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        5040 :       NULLIFY (tmp_gt_list_ptr, tmp_gt_list_last_ptr)
     212             : 
     213             :       ! nothing to do, when subtree element is already deleted
     214        5040 :       IF (.NOT. ASSOCIATED(elem)) RETURN
     215        5040 :       IF (.NOT. ASSOCIATED(gt_ptr)) RETURN
     216             : 
     217        5040 :       CPASSERT(ASSOCIATED(tmc_env))
     218             : 
     219             :       ! start the timing
     220        5040 :       CALL timeset(routineN, handle)
     221             : 
     222             :       ! set the entry point od the list
     223        5040 :       tmp_gt_list_ptr => elem%gt_nodes_references
     224        5040 :       tmp_gt_list_last_ptr => elem%gt_nodes_references
     225             : 
     226             :       ! search related reference
     227        5729 :       DO WHILE (ASSOCIATED(tmp_gt_list_ptr))
     228             :          ! remove reference, if it is related to the global tree element
     229        5282 :          IF (ASSOCIATED(tmp_gt_list_ptr%gt_elem, gt_ptr)) THEN
     230             :             ! first reference?
     231        4880 :             IF (ASSOCIATED(tmp_gt_list_ptr, elem%gt_nodes_references)) THEN
     232             :                ! additionally last reference (the only one)?
     233        4607 :                IF (.NOT. ASSOCIATED(tmp_gt_list_ptr%next)) THEN
     234             :                   ! last element in list -> cancel calculation
     235        4593 :                   CALL add_to_canceling_list(elem=elem, tmc_env=tmc_env)
     236        4593 :                   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        4880 :             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        5569 :          tmp_gt_list_last_ptr => tmp_gt_list_ptr
     257             :          ! go to next list element, if defined
     258        5729 :          IF (ASSOCIATED(tmp_gt_list_ptr)) tmp_gt_list_ptr => tmp_gt_list_ptr%next
     259             :       END DO
     260             :       ! end the timing
     261        5040 :       CALL timestop(handle)
     262             :    END SUBROUTINE search_and_remove_reference_in_list
     263             : 
     264             : END MODULE tmc_tree_references