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 8984 : 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 4492 : NULLIFY (tmp_pt_list_elem) 57 : 58 4492 : CPASSERT(ASSOCIATED(gt_elem)) 59 : 60 : ! start the timing 61 4492 : CALL timeset(routineN, handle) 62 : 63 : ! create reference and add at the beginning of the list 64 4492 : ALLOCATE (tmp_pt_list_elem) 65 4492 : tmp_pt_list_elem%gt_elem => gt_elem 66 4492 : 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 4492 : 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 4492 : 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 4492 : CALL timestop(handle) 88 4492 : 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 8984 : 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 4492 : CPASSERT(ASSOCIATED(gt_ptr)) 106 4492 : CPASSERT(ASSOCIATED(tmc_env)) 107 : 108 : ! start the timing 109 4492 : CALL timeset(routineN, handle) 110 : 111 : CALL search_and_remove_reference_in_list(gt_ptr=gt_ptr, & 112 4492 : 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 4492 : 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 4492 : CALL timestop(handle) 121 4492 : 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 19774 : 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 9887 : NULLIFY (tmp_gt_list_ptr) 139 : 140 9887 : CPASSERT(ASSOCIATED(ptr)) 141 : 142 : ! start the timing 143 9887 : CALL timeset(routineN, handle) 144 : 145 9887 : 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 9887 : DEALLOCATE (tmp_gt_list_ptr) 185 : END DO pt_node_ref_loop 186 : 187 : ! end the timing 188 9887 : CALL timestop(handle) 189 : 190 9887 : CPASSERT(.NOT. ASSOCIATED(ptr%gt_nodes_references)) 191 9887 : 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 9658 : 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 4829 : NULLIFY (tmp_gt_list_ptr, tmp_gt_list_last_ptr) 212 : 213 : ! nothing to do, when subtree element is already deleted 214 4829 : IF (.NOT. ASSOCIATED(elem)) RETURN 215 4829 : IF (.NOT. ASSOCIATED(gt_ptr)) RETURN 216 : 217 4829 : CPASSERT(ASSOCIATED(tmc_env)) 218 : 219 : ! start the timing 220 4829 : CALL timeset(routineN, handle) 221 : 222 : ! set the entry point od the list 223 4829 : tmp_gt_list_ptr => elem%gt_nodes_references 224 4829 : tmp_gt_list_last_ptr => elem%gt_nodes_references 225 : 226 : ! search related reference 227 5518 : DO WHILE (ASSOCIATED(tmp_gt_list_ptr)) 228 : ! remove reference, if it is related to the global tree element 229 5062 : IF (ASSOCIATED(tmp_gt_list_ptr%gt_elem, gt_ptr)) THEN 230 : ! first reference? 231 4660 : IF (ASSOCIATED(tmp_gt_list_ptr, elem%gt_nodes_references)) THEN 232 : ! additionally last reference (the only one)? 233 4387 : IF (.NOT. ASSOCIATED(tmp_gt_list_ptr%next)) THEN 234 : ! last element in list -> cancel calculation 235 4373 : CALL add_to_canceling_list(elem=elem, tmc_env=tmc_env) 236 4373 : 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 4660 : 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 5349 : tmp_gt_list_last_ptr => tmp_gt_list_ptr 257 : ! go to next list element, if defined 258 5518 : IF (ASSOCIATED(tmp_gt_list_ptr)) tmp_gt_list_ptr => tmp_gt_list_ptr%next 259 : END DO 260 : ! end the timing 261 4829 : CALL timestop(handle) 262 : END SUBROUTINE search_and_remove_reference_in_list 263 : 264 : END MODULE tmc_tree_references