diff --git a/source/merger_trees.build.controller.F90 b/source/merger_trees.build.controller.F90 index 67edbeac28..503ed2a725 100644 --- a/source/merger_trees.build.controller.F90 +++ b/source/merger_trees.build.controller.F90 @@ -89,8 +89,9 @@ module Merger_Tree_Build_Controllers Alert the controller when new nodes are inserted into the tree. void yes - type(treeNode), intent(inout) :: nodeCurrent , nodeProgenitor1 - type(treeNode), intent(inout), optional :: nodeProgenitor2 + type (treeNode), intent(inout) :: nodeCurrent , nodeProgenitor1 + type (treeNode), intent(inout), optional :: nodeProgenitor2 + logical , intent(in ), optional :: didBranch !!] diff --git a/source/merger_trees.build.controller.branchless.F90 b/source/merger_trees.build.controller.branchless.F90 index b16ce4b50d..077a900992 100644 --- a/source/merger_trees.build.controller.branchless.F90 +++ b/source/merger_trees.build.controller.branchless.F90 @@ -135,15 +135,16 @@ function branchlessBranchingProbabilityObject(self,node) result(mergerTreeBranch return end function branchlessBranchingProbabilityObject - subroutine branchlessNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2) + subroutine branchlessNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2,didBranch) !!{ Act on the insertion of nodes into the merger tree. !!} implicit none - class(mergerTreeBuildControllerBranchless), intent(inout) :: self - type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 - type (treeNode ), intent(inout), optional :: nodeProgenitor2 - !$GLC attributes unused :: self, nodeCurrent, nodeProgenitor1, nodeProgenitor2 + class (mergerTreeBuildControllerBranchless), intent(inout) :: self + type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 + type (treeNode ), intent(inout), optional :: nodeProgenitor2 + logical , intent(in ), optional :: didBranch + !$GLC attributes unused :: self, nodeCurrent, nodeProgenitor1, nodeProgenitor2, didBranch ! Nothing to do. return diff --git a/source/merger_trees.build.controller.constrained.F90 b/source/merger_trees.build.controller.constrained.F90 index 22f05de806..33ff319ca2 100644 --- a/source/merger_trees.build.controller.constrained.F90 +++ b/source/merger_trees.build.controller.constrained.F90 @@ -444,18 +444,20 @@ function constrainedBranchingProbabilityObject(self,node) result(mergerTreeBranc return end function constrainedBranchingProbabilityObject - subroutine constrainedNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2) + subroutine constrainedNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2,didBranch) !!{ Act on the insertion of nodes into the merger tree. !!} use :: Galacticus_Nodes, only : nodeComponentBasic implicit none - class (mergerTreeBuildControllerConstrained), intent(inout) :: self - type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 - type (treeNode ), intent(inout), optional :: nodeProgenitor2 - class (nodeComponentBasic ), pointer :: basicCurrent , basicProgenitor1, & - & basicProgenitor2 - logical :: isConstrained + class (mergerTreeBuildControllerConstrained), intent(inout) :: self + type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 + type (treeNode ), intent(inout), optional :: nodeProgenitor2 + logical , intent(in ), optional :: didBranch + class (nodeComponentBasic ), pointer :: basicCurrent , basicProgenitor1, & + & basicProgenitor2 + logical :: isConstrained + !$GLC attributes unused :: didBranch basicCurrent => nodeCurrent %basic ( ) basicProgenitor1 => nodeProgenitor1%basic ( ) diff --git a/source/merger_trees.build.controller.single_step.F90 b/source/merger_trees.build.controller.single_step.F90 index 7397527973..c3a07d4de8 100644 --- a/source/merger_trees.build.controller.single_step.F90 +++ b/source/merger_trees.build.controller.single_step.F90 @@ -41,6 +41,8 @@ class (criticalOverdensityClass ), pointer :: criticalOverdensity_ => null() double precision :: redshiftStep , criticalOverdensityStep logical :: haltAfterStep + integer :: primaryLabelID , secondaryLabelID , & + & smoothLabelID contains final :: singleStepDestructor procedure :: control => singleStepControl @@ -112,6 +114,7 @@ function singleStepConstructorInternal(criticalOverdensityStep,haltAfterStep,cos !!{ Internal constructor for the ``singleStep'' merger tree build controller class . !!} + use :: Nodes_Labels, only : nodeLabelRegister implicit none type (mergerTreeBuildControllerSingleStep) :: self double precision , intent(in ) :: criticalOverdensityStep @@ -124,13 +127,16 @@ function singleStepConstructorInternal(criticalOverdensityStep,haltAfterStep,cos !!] - self%redshiftStep=self%cosmologyFunctions_ %redshiftFromExpansionFactor( & - & self%cosmologyFunctions_ %expansionFactor ( & - & self%criticalOverdensity_%timeOfCollapse ( & - & criticalOverdensityStep & - & ) & - & ) & - & ) + self%redshiftStep =self%cosmologyFunctions_ %redshiftFromExpansionFactor( & + & self%cosmologyFunctions_ %expansionFactor ( & + & self%criticalOverdensity_%timeOfCollapse ( & + & criticalOverdensityStep & + & ) & + & ) & + & ) + self% primaryLabelID=nodeLabelRegister('progenitorFirst' ,'Identifies progenitors that were sampled first from the progenitor mass distribution.' ) + self%secondaryLabelID=nodeLabelRegister('progenitorSecond','Identifies progenitors that were sampled second from the progenitor mass distribution.') + self% smoothLabelID=nodeLabelRegister('progenitorSmooth','Identifies progenitors resulting from smooth/sub-resolution accretion.' ) return end function singleStepConstructorInternal @@ -235,6 +241,7 @@ logical function singleStepControlTimeMaximum(self,node,massBranch,criticalOverd nodeNew %sibling => null() call basic%massSet(massBranch ) call basic%timeSet(criticalOverdensityBranch) + call nodeLabelSet(self%smoothLabelID,nodeNew) ! Return false indicating that the current node is finished, so building should continue from its progenitor nodes. singleStepControlTimeMaximum=.false. return @@ -253,15 +260,27 @@ function singleStepBranchingProbabilityObject(self,node) result(mergerTreeBranch return end function singleStepBranchingProbabilityObject - subroutine singleStepNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2) + subroutine singleStepNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2,didBranch) !!{ Act on the insertion of nodes into the merger tree. !!} + use :: Nodes_Labels, only : nodeLabelSet implicit none - class(mergerTreeBuildControllerSingleStep), intent(inout) :: self - type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 - type (treeNode ), intent(inout), optional :: nodeProgenitor2 - + class (mergerTreeBuildControllerSingleStep), intent(inout) :: self + type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 + type (treeNode ), intent(inout), optional :: nodeProgenitor2 + logical , intent(in ), optional :: didBranch + !![ + + !!] + call self%mergerTreeBuildController_%nodesInserted(nodeCurrent,nodeProgenitor1,nodeProgenitor2) + if (didBranch_) then + call nodeLabelSet(self% primaryLabelID,nodeProgenitor1) + if (present(nodeProgenitor2)) & + & call nodeLabelSet(self%secondaryLabelID,nodeProgenitor2) + else + call nodeLabelSet(self% smoothLabelID,nodeProgenitor1) + end if return end subroutine singleStepNodesInserted diff --git a/source/merger_trees.build.controller.subsample.F90 b/source/merger_trees.build.controller.subsample.F90 index 0f714df9e6..527e44e850 100644 --- a/source/merger_trees.build.controller.subsample.F90 +++ b/source/merger_trees.build.controller.subsample.F90 @@ -257,15 +257,16 @@ function subsampleBranchingProbabilityObject(self,node) result(mergerTreeBranchi return end function subsampleBranchingProbabilityObject - subroutine subsampleNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2) + subroutine subsampleNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2,didBranch) !!{ Act on the insertion of nodes into the merger tree. !!} implicit none - class(mergerTreeBuildControllerSubsample), intent(inout) :: self - type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 - type (treeNode ), intent(inout), optional :: nodeProgenitor2 - !$GLC attributes unused :: self, nodeCurrent, nodeProgenitor1, nodeProgenitor2 + class (mergerTreeBuildControllerSubsample), intent(inout) :: self + type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 + type (treeNode ), intent(inout), optional :: nodeProgenitor2 + logical , intent(in ), optional :: didBranch + !$GLC attributes unused :: self, nodeCurrent, nodeProgenitor1, nodeProgenitor2, didBranch ! Nothing to do. return diff --git a/source/merger_trees.build.controller.uncontrolled.F90 b/source/merger_trees.build.controller.uncontrolled.F90 index 6a040f5133..e6aec104f0 100644 --- a/source/merger_trees.build.controller.uncontrolled.F90 +++ b/source/merger_trees.build.controller.uncontrolled.F90 @@ -126,15 +126,16 @@ function uncontrolledBranchingProbabilityObject(self,node) result(mergerTreeBran return end function uncontrolledBranchingProbabilityObject - subroutine uncontrolledNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2) + subroutine uncontrolledNodesInserted(self,nodeCurrent,nodeProgenitor1,nodeProgenitor2,didBranch) !!{ Act on the insertion of nodes into the merger tree. !!} implicit none - class(mergerTreeBuildControllerUncontrolled), intent(inout) :: self - type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 - type (treeNode ), intent(inout), optional :: nodeProgenitor2 - !$GLC attributes unused :: self, nodeCurrent, nodeProgenitor1, nodeProgenitor2 + class (mergerTreeBuildControllerUncontrolled), intent(inout) :: self + type (treeNode ), intent(inout) :: nodeCurrent , nodeProgenitor1 + type (treeNode ), intent(inout), optional :: nodeProgenitor2 + logical , intent(in ), optional :: didBranch + !$GLC attributes unused :: self, nodeCurrent, nodeProgenitor1, nodeProgenitor2, didBranch ! Nothing to do. return diff --git a/source/merger_trees.construct.builder.Cole2000.F90 b/source/merger_trees.construct.builder.Cole2000.F90 index 5804b834c4..e1d78119cf 100644 --- a/source/merger_trees.construct.builder.Cole2000.F90 +++ b/source/merger_trees.construct.builder.Cole2000.F90 @@ -570,6 +570,8 @@ recursive subroutine cole2000BuildBranch(tree,massResolution,nodeIndex,nodeTip) ! Compute the critical overdensity corresponding to this new node. deltaCritical1=self_%criticalOverdensityUpdate(branchDeltaCriticalCurrent,branchMassCurrent,nodeMass1,nodeNew1) call basicNew1%timeSet(deltaCritical1) + ! Inform the build controller of this new node. + call self_%workers(numberWorker)%mergerTreeBuildController_%nodesInserted(nodeCurrent,nodeNew1) ! Create links from old to new node and vice-versa. nodeCurrent%firstChild => nodeNew1 nodeNew1%parent => nodeCurrent @@ -613,6 +615,8 @@ recursive subroutine cole2000BuildBranch(tree,massResolution,nodeIndex,nodeTip) ! Set properties of the new node. call basicNew1%massSet(nodeMass1 ) call basicNew1%timeSet(deltaCritical1) + ! Inform the build controller of this new node. + call self_%workers(numberWorker)%mergerTreeBuildController_%nodesInserted(nodeCurrent,nodeNew1) ! Create links from old to new node and vice-versa. nodeCurrent%firstChild => nodeNew1 nodeNew1 %parent => nodeCurrent @@ -797,7 +801,7 @@ recursive subroutine cole2000BuildBranch(tree,massResolution,nodeIndex,nodeTip) call basicNew2%massSet(nodeMass2 ) call basicNew2%timeSet(deltaCritical2) ! Inform the build controller of these new nodes. - call self_%workers(numberWorker)%mergerTreeBuildController_%nodesInserted(nodeCurrent,nodeNew1,nodeNew2) + call self_%workers(numberWorker)%mergerTreeBuildController_%nodesInserted(nodeCurrent,nodeNew1,nodeNew2,didBranch=.true.) ! Create links from old to new nodes and vice-versa. (Ensure that the first child node is the more massive progenitor.) if (nodeMass2 > nodeMass1) then nodeCurrent%firstChild => nodeNew2 @@ -813,7 +817,7 @@ recursive subroutine cole2000BuildBranch(tree,massResolution,nodeIndex,nodeTip) else ! Second branch would be subresolution - do not create it. ! Inform the build controller of the new node. - call self_%workers(numberWorker)%mergerTreeBuildController_%nodesInserted(nodeCurrent,nodeNew1) + call self_%workers(numberWorker)%mergerTreeBuildController_%nodesInserted(nodeCurrent,nodeNew1 ,didBranch=.true.) ! Create links from old to new nodes and vice-versa. nodeCurrent %firstChild => nodeNew1 nodeNew1 %sibling => null()