28 #include "../base/base_uses.f90"
34 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'tmc_tree_search'
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
73 CHARACTER(LEN=*),
PARAMETER :: routinen =
'most_prob_end'
76 LOGICAL :: check_accepted, check_rejected, keep_on, &
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
82 NULLIFY (st_elem, ptr_acc, ptr_nacc)
86 check_accepted = .false.
87 check_rejected = .false.
90 cpassert(
ASSOCIATED(global_tree_elem))
91 st_elem => global_tree_elem%conf(global_tree_elem%mv_conf)%elem
92 cpassert(
ASSOCIATED(st_elem))
95 CALL timeset(routinen, handle)
99 SELECT CASE (global_tree_elem%stat)
101 check_accepted = .true.
103 check_rejected = .true.
106 SELECT CASE (st_elem%stat)
109 IF (
PRESENT(search_energy_node))
THEN
114 check_accepted = .true.
115 check_rejected = .true.
122 IF (.NOT.
PRESENT(search_energy_node))
THEN
124 n_acc =
ASSOCIATED(global_tree_elem%parent%acc, global_tree_elem)
125 global_tree_elem => global_tree_elem%parent
133 check_accepted = .true.
134 check_rejected = .true.
138 IF (.NOT.
PRESENT(search_energy_node))
THEN
139 check_rejected = .true.
143 CALL cp_abort(__location__, &
144 "unknown sub tree element status "// &
145 cp_to_string(st_elem%stat))
153 IF (check_accepted)
THEN
155 IF (
ASSOCIATED(global_tree_elem%acc))
THEN
156 ptr_acc => global_tree_elem%acc
157 IF (
PRESENT(search_energy_node))
THEN
158 CALL most_prob_end(global_tree_elem=ptr_acc, prob=prob_n_acc, &
160 search_energy_node=search_energy_node)
162 CALL most_prob_end(global_tree_elem=ptr_acc, prob=prob_n_acc, &
167 prob_n_acc = prob_n_acc + log(global_tree_elem%prob_acc)
171 prob_n_acc = log(global_tree_elem%prob_acc)
172 IF (
PRESENT(search_energy_node)) prob_n_acc = -100000
173 ptr_acc => global_tree_elem
179 IF (check_rejected)
THEN
181 IF (
ASSOCIATED(global_tree_elem%nacc))
THEN
182 ptr_nacc => global_tree_elem%nacc
183 IF (
PRESENT(search_energy_node))
THEN
184 CALL most_prob_end(global_tree_elem=ptr_nacc, prob=prob_n_nacc, &
186 search_energy_node=search_energy_node)
188 CALL most_prob_end(global_tree_elem=ptr_nacc, prob=prob_n_nacc, &
193 prob_n_nacc = prob_n_nacc + log(1 - global_tree_elem%prob_acc)
197 prob_n_nacc = log(1 - global_tree_elem%prob_acc)
198 IF (
PRESENT(search_energy_node)) prob_n_nacc = -100000
199 ptr_nacc => global_tree_elem
206 IF (prob_n_acc .GE. prob_n_nacc)
THEN
208 global_tree_elem => ptr_acc
212 global_tree_elem => ptr_nacc
217 CALL timestop(handle)
229 TYPE(global_tree_type),
POINTER :: gt_head, new_gt_elem
230 INTEGER :: stat, react_count
232 CHARACTER(LEN=*),
PARAMETER :: routinen =
'search_next_energy_calc'
236 REAL(kind=
dp) :: prob
240 cpassert(
ASSOCIATED(gt_head))
243 CALL timeset(routinen, handle)
245 new_gt_elem => gt_head
247 CALL most_prob_end(global_tree_elem=new_gt_elem, prob=prob, n_acc=flag, &
248 search_energy_node=.true.)
253 IF (.NOT.
ASSOCIATED(new_gt_elem) .OR. (exp(prob) .LT. 1.0e-10))
THEN
257 IF (new_gt_elem%conf(new_gt_elem%mv_conf)%elem%stat .EQ. &
260 react_count = react_count + 1
264 IF (new_gt_elem%conf(new_gt_elem%mv_conf)%elem%stat .NE.
status_created)
THEN
269 CALL timestop(handle)
280 TYPE(tree_type),
POINTER :: current, parent
282 CHARACTER(LEN=*),
PARAMETER :: routinen =
'search_parent_element'
286 cpassert(
ASSOCIATED(current))
289 CALL timeset(routinen, handle)
291 IF (
ASSOCIATED(current%parent))
THEN
293 parent => current%parent
294 IF (
ASSOCIATED(parent%nacc, current))
THEN
302 CALL timestop(handle)
303 cpassert(
ASSOCIATED(parent))
313 TYPE(global_tree_type),
POINTER :: ptr
316 CHARACTER(LEN=*),
PARAMETER :: routinen =
'search_next_gt_element_to_check'
322 cpassert(
ASSOCIATED(ptr))
325 CALL timeset(routinen, handle)
329 SELECT CASE (ptr%stat)
331 IF (
ASSOCIATED(ptr%acc))
THEN
336 IF (
ASSOCIATED(ptr%nacc))
THEN
348 CALL cp_abort(__location__, &
349 "unexpected status "//cp_to_string(ptr%stat)// &
350 "of global tree elem "//cp_to_string(ptr%nr))
353 CALL timestop(handle)
355 cpassert(
ASSOCIATED(ptr))
367 TYPE(global_tree_type),
POINTER :: gt_act_elem
368 TYPE(tree_type),
INTENT(OUT),
POINTER :: elem1, elem2
370 CHARACTER(LEN=*),
PARAMETER :: routinen =
'get_subtree_elements_to_check'
374 cpassert(
ASSOCIATED(gt_act_elem))
377 CALL timeset(routinen, handle)
379 IF (gt_act_elem%swaped)
THEN
383 IF (gt_act_elem%conf_n_acc(gt_act_elem%conf(gt_act_elem%mv_conf)%elem%sub_tree_nr))
THEN
384 elem1 => gt_act_elem%conf(gt_act_elem%mv_conf)%elem
389 IF (gt_act_elem%conf_n_acc(gt_act_elem%conf(gt_act_elem%mv_conf + 1)%elem%sub_tree_nr))
THEN
390 elem2 => gt_act_elem%conf(gt_act_elem%mv_conf + 1)%elem
395 elem1 => gt_act_elem%conf(gt_act_elem%mv_conf)%elem
400 CALL timestop(handle)
402 cpassert(
ASSOCIATED(gt_act_elem))
403 cpassert(
ASSOCIATED(elem1))
404 cpassert(
ASSOCIATED(elem2))
416 TYPE(global_tree_type),
POINTER :: last_acc, tree_ptr
418 CHARACTER(LEN=*),
PARAMETER :: routinen =
'search_end_of_clean_g_tree'
422 cpassert(
ASSOCIATED(last_acc))
423 cpassert(
ASSOCIATED(tree_ptr))
426 CALL timeset(routinen, handle)
428 SELECT CASE (tree_ptr%stat)
430 IF (
ASSOCIATED(tree_ptr%acc) .AND. .NOT.
ASSOCIATED(tree_ptr%nacc))
THEN
432 tree_ptr => tree_ptr%acc
436 IF (
ASSOCIATED(tree_ptr%nacc) .AND. .NOT.
ASSOCIATED(tree_ptr%acc))
THEN
437 tree_ptr => tree_ptr%nacc
446 CALL cp_abort(__location__, &
447 "the global tree element "//cp_to_string(tree_ptr%nr)// &
448 " stat "//cp_to_string(tree_ptr%stat)//
" is UNknown")
451 CALL timestop(handle)
452 cpassert(
ASSOCIATED(last_acc))
453 cpassert(
ASSOCIATED(tree_ptr))
467 TYPE(tree_type),
POINTER :: tree_ptr
468 TYPE(tree_type),
INTENT(IN),
POINTER :: last_acc
470 CHARACTER(LEN=*),
PARAMETER :: routinen =
'search_end_of_clean_tree'
474 cpassert(
ASSOCIATED(tree_ptr))
475 cpassert(
ASSOCIATED(last_acc))
478 CALL timeset(routinen, handle)
480 IF (.NOT.
ASSOCIATED(last_acc, tree_ptr))
THEN
481 IF (
ASSOCIATED(tree_ptr%acc) .AND. .NOT.
ASSOCIATED(tree_ptr%nacc))
THEN
482 tree_ptr => tree_ptr%acc
484 ELSE IF (
ASSOCIATED(tree_ptr%nacc) .AND. .NOT.
ASSOCIATED(tree_ptr%acc))
THEN
485 tree_ptr => tree_ptr%nacc
490 CALL timestop(handle)
491 cpassert(
ASSOCIATED(tree_ptr))
492 cpassert(
ASSOCIATED(last_acc))
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
510 CHARACTER(LEN=*),
PARAMETER :: routinen =
'search_canceling_elements'
514 TYPE(global_tree_type),
POINTER :: act_pt_ptr, pt_elem
516 NULLIFY (pt_elem, act_pt_ptr)
517 cpassert(
ASSOCIATED(pt_elem_in))
518 cpassert(
ASSOCIATED(tmc_env))
521 CALL timeset(routinen, handle)
525 IF (
PRESENT(prob))
THEN
526 IF (prob .LT. 1.0e-10 .AND.
ASSOCIATED(pt_elem_in%acc))
THEN
527 pt_elem => pt_elem_in%acc
528 ELSE IF (prob .GT. (1.0_dp - 1.0e-10) .AND.
ASSOCIATED(pt_elem_in%nacc))
THEN
529 pt_elem => pt_elem_in%nacc
534 pt_elem => pt_elem_in
538 IF (
ASSOCIATED(pt_elem%conf(pt_elem%mv_conf)%elem))
THEN
539 SELECT CASE (pt_elem%conf(pt_elem%mv_conf)%elem%stat)
548 elem=pt_elem%conf(pt_elem%mv_conf)%elem, tmc_env=tmc_env)
551 CALL cp_abort(__location__, &
552 "unknown status of subtree element"// &
553 cp_to_string(pt_elem%conf(pt_elem%mv_conf)%elem%stat))
558 IF (
ASSOCIATED(pt_elem%acc))
THEN
559 act_pt_ptr => pt_elem%acc
562 IF (
ASSOCIATED(pt_elem%nacc))
THEN
563 act_pt_ptr => pt_elem%nacc
568 CALL timestop(handle)
569 cpassert(
ASSOCIATED(pt_elem_in))
579 TYPE(global_tree_type),
INTENT(IN),
POINTER :: global_tree_ptr
580 INTEGER,
DIMENSION(:),
POINTER :: counters
582 CHARACTER(len=*),
PARAMETER :: routinen =
'count_prepared_nodes_in_trees'
585 TYPE(tree_type),
POINTER :: begin_ptr
589 cpassert(
ASSOCIATED(global_tree_ptr))
590 cpassert(
ASSOCIATED(counters))
591 cpassert(
SIZE(counters(1:)) .EQ.
SIZE(global_tree_ptr%conf(:)))
594 CALL timeset(routinen, handle)
597 DO i = 1,
SIZE(global_tree_ptr%conf(:))
598 begin_ptr => global_tree_ptr%conf(i)%elem
599 CALL count_prepared_nodes_in_subtree(tree_ptr=begin_ptr, &
604 CALL timestop(handle)
614 RECURSIVE SUBROUTINE count_prepared_nodes_in_subtree(tree_ptr, counter)
615 TYPE(tree_type),
POINTER :: tree_ptr
618 TYPE(tree_type),
POINTER :: tmp_ptr
622 cpassert(
ASSOCIATED(tree_ptr))
624 SELECT CASE (tree_ptr%stat)
626 IF (
ASSOCIATED(tree_ptr%acc))
THEN
627 tmp_ptr => tree_ptr%acc
628 CALL count_prepared_nodes_in_subtree(tmp_ptr, counter)
631 IF (
ASSOCIATED(tree_ptr%nacc))
THEN
632 tmp_ptr => tree_ptr%nacc
633 CALL count_prepared_nodes_in_subtree(tmp_ptr, counter)
638 IF (
ASSOCIATED(tree_ptr%acc))
THEN
639 tmp_ptr => tree_ptr%acc
640 CALL count_prepared_nodes_in_subtree(tmp_ptr, counter)
642 IF (
ASSOCIATED(tree_ptr%nacc))
THEN
643 tmp_ptr => tree_ptr%nacc
644 CALL count_prepared_nodes_in_subtree(tmp_ptr, counter)
650 CALL cp_abort(__location__, &
651 "stat "//cp_to_string(tree_ptr%stat)// &
652 "of elem "//cp_to_string(tree_ptr%nr)// &
655 END SUBROUTINE count_prepared_nodes_in_subtree
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
672 CHARACTER(len=*),
PARAMETER :: routinen =
'count_nodes_in_trees'
675 TYPE(global_tree_type),
POINTER :: begin_gt_ptr
676 TYPE(tree_type),
POINTER :: begin_ptr
678 NULLIFY (begin_gt_ptr, begin_ptr)
680 cpassert(
ASSOCIATED(global_tree_ptr))
681 cpassert(
ASSOCIATED(end_of_clean_trees))
682 cpassert(
ASSOCIATED(counters))
683 cpassert(
SIZE(counters(1:)) .EQ.
SIZE(global_tree_ptr%conf(:)))
686 CALL timeset(routinen, handle)
688 begin_gt_ptr => global_tree_ptr
691 IF (.NOT.
ASSOCIATED(begin_gt_ptr%parent))
EXIT
692 begin_gt_ptr => begin_gt_ptr%parent
694 head_elements_nr(0) = begin_gt_ptr%nr
695 CALL count_nodes_in_global_tree(begin_gt_ptr, counters(0))
696 DO i = 1,
SIZE(end_of_clean_trees(:))
697 begin_ptr => end_of_clean_trees(i)%elem
699 IF (.NOT.
ASSOCIATED(begin_ptr%parent))
EXIT
700 begin_ptr => begin_ptr%parent
702 head_elements_nr(i) = begin_ptr%nr
703 CALL count_nodes_in_tree(begin_ptr, counters(i))
707 CALL timestop(handle)
716 RECURSIVE SUBROUTINE count_nodes_in_global_tree(ptr, counter)
717 TYPE(global_tree_type),
INTENT(IN),
POINTER :: ptr
718 INTEGER,
INTENT(INOUT) :: counter
720 cpassert(
ASSOCIATED(ptr))
722 counter = counter + 1
724 IF (
ASSOCIATED(ptr%acc)) &
725 CALL count_nodes_in_global_tree(ptr%acc, counter)
726 IF (
ASSOCIATED(ptr%nacc)) &
727 CALL count_nodes_in_global_tree(ptr%nacc, counter)
728 END SUBROUTINE count_nodes_in_global_tree
736 RECURSIVE SUBROUTINE count_nodes_in_tree(ptr, counter)
737 TYPE(tree_type),
POINTER :: ptr
740 cpassert(
ASSOCIATED(ptr))
742 counter = counter + 1
744 IF (
ASSOCIATED(ptr%acc)) &
745 CALL count_nodes_in_tree(ptr%acc, counter)
746 IF (
ASSOCIATED(ptr%nacc)) &
747 CALL count_nodes_in_tree(ptr%nacc, counter)
748 END SUBROUTINE count_nodes_in_tree
various routines to log and control the output. The idea is that decisions about where to log should ...
Defines the basic variable types.
integer, parameter, public dp
tree nodes creation, searching, deallocation, references etc.
integer, parameter, public tmc_status_wait_for_new_task
subroutine, public search_and_remove_reference_in_list(gt_ptr, elem, tmc_env)
removes the global tree references of this actual global tree element from all related sub tree eleme...
subroutine, public add_to_references(gt_elem)
adds global tree reference to the modified sub tree element(s)
subroutine, public search_next_energy_calc(gt_head, new_gt_elem, stat, react_count)
gt_head head of the global tree
recursive subroutine, public search_end_of_clean_g_tree(last_acc, tree_ptr)
searches last element on trajectory, until where the sides of the tree are deleted (of global tree) a...
recursive type(tree_type) function, pointer, public search_parent_element(current)
searching the parent element (last accepted configuration before)
recursive subroutine, public most_prob_end(global_tree_elem, prob, n_acc, search_energy_node)
search most probable end in global tree to create a new tree node using the acceptance probabilities ...
recursive subroutine, public search_end_of_clean_tree(tree_ptr, last_acc)
searches last element on trajectory, until where the sides of the tree are deleted (in sub tree) also...
recursive subroutine, public search_canceling_elements(pt_elem_in, prob, tmc_env)
searches in all branches down below the entered global tree element for elements to cancel,...
subroutine, public get_subtree_elements_to_check(gt_act_elem, elem1, elem2)
get the changed element of the actual global tree element and its related last accepted parent
subroutine, public count_nodes_in_trees(global_tree_ptr, end_of_clean_trees, counters, head_elements_nr)
counts the number of existing nodes in global and subtrees
subroutine, public count_prepared_nodes_in_trees(global_tree_ptr, counters)
searches for created configurations in all subtrees
recursive subroutine, public search_next_gt_element_to_check(ptr, found)
search the next global element in the Markov Chain to check
module handles definition of the tree nodes for the global and the subtrees binary tree parent elemen...
integer, parameter, public status_deleted
integer, parameter, public status_accepted
integer, parameter, public status_calculate_energy
integer, parameter, public status_calculate_md
integer, parameter, public status_canceled_ener
integer, parameter, public status_calculated
integer, parameter, public status_cancel_ener
integer, parameter, public status_cancel_nmc
integer, parameter, public status_canceled_nmc
integer, parameter, public status_calc_approx_ener
integer, parameter, public status_rejected
integer, parameter, public status_calculate_nmc_steps
integer, parameter, public status_accepted_result
integer, parameter, public status_deleted_result
integer, parameter, public status_created
integer, parameter, public status_rejected_result
module handles definition of the tree nodes for the global and the subtrees binary tree parent elemen...