Scrambler  1
tree_level_ops.f90
Go to the documentation of this file.
00001 !#########################################################################
00002 !               
00003 !    Copyright (C) 2003-2012 Department of Physics and Astronomy,
00004 !                            University of Rochester,
00005 !                            Rochester, NY
00006 !
00007 !    tree_level_ops.f90 is part of AstroBEAR.
00008 !
00009 !    AstroBEAR is free software: you can redistribute it and/or modify    
00010 !    it under the terms of the GNU General Public License as published by 
00011 !    the Free Software Foundation, either version 3 of the License, or    
00012 !    (at your option) any later version.
00013 !
00014 !    AstroBEAR is distributed in the hope that it will be useful, 
00015 !    but WITHOUT ANY WARRANTY; without even the implied warranty of
00016 !    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00017 !    GNU General Public License for more details.
00018 !
00019 !    You should have received a copy of the GNU General Public License
00020 !    along with AstroBEAR.  If not, see <http://www.gnu.org/licenses/>.
00021 !
00022 !#########################################################################
00025 
00028 
00031 
00035 
00038 
00039 
00040 MODULE TreeLevelOps
00041   USE TreeNodeOps
00042   USE Timing
00043   IMPLICIT NONE
00044   PRIVATE
00045 
00046 
00047   !Pair-wise tree operations   
00048   PUBLIC :: InheritNeighborsChildren, InheritOldNodeOverlapsChildren, InheritNewNodeOverlapsChildren, &
00049        InheritOverlapsOldChildren, InheritOverlapsNewChildren
00050 
00051   !Single node tree operations
00052   PUBLIC :: CreateChildrens, UpdateOverlaps, NullifyNeighbors, &
00053        AgeNodesChildren, AgeNodes, DestroyNodes, DestroyOldNodes
00054 
00055 CONTAINS 
00056 
00057 
00060 
00063   SUBROUTINE InheritNeighborsChildren(n)
00064     INTEGER :: n
00065     TYPE(NodeDef), POINTER :: node, neighbor
00066     TYPE(NodeDefList), POINTER :: nodelist, neighborlist
00067     CALL StartTimer(iInheritNeighborsChildren, n)
00068     nodelist=>Nodes(n)%p 
00069     DO WHILE (associated(nodelist))
00070        node=>nodelist%self       
00071        neighborlist=>node%neighbors 
00072        DO WHILE (associated(neighborlist))
00073           neighbor=>neighborlist%self
00074           IF (neighbor%box%MPI_ID == MPI_ID) CALL InheritNeighborChildren(node,neighbor,n) !Have child grids locally
00075           neighborlist=>neighborlist%next
00076        END DO
00077        CALL InheritSelfNeighborChildren(node,n)
00078        nodelist=>nodelist%next 
00079     END DO
00080     CALL StopTimer(iInheritNeighborsChildren, n)
00081   END SUBROUTINE InheritNeighborsChildren
00082 
00083 
00084   !Overlaps are funny because they alternate between being old grids - and being neighbor grids
00085   !Inheritance of overlaps gets even trickier because on the second step when neighbors become overlaps
00086   !a node already has the overlaps' children.
00087 
00088   !(First step)
00089   !AddOverlap(Nodes%children,Nodes%Overlaps%Children) !InheritOverlapsChildren
00090   !AddOverlap(OldNodes%children, OldNodes%Overlaps%Children) !InheritOverlapsChildren
00091 
00092   !(Second Step)
00093   !AddOverlap(Nodes%children,Nodes%Overlaps%OldChildren) !InheritOverlapsOldChildren *No communication required!
00094   !AddOverlap(Nodes%OldChildren,Nodes%Overlaps%Children) !InheritOverlapsNewChildren
00095 
00096 
00099   SUBROUTINE InheritOldNodeOverlapsChildren(n)
00100     INTEGER :: n
00101     TYPE(NodeDef), POINTER :: node, overlap
00102     TYPE(NodeDefList), POINTER :: nodelist, overlaplist
00103     CALL StartTimer(iInheritOldNodeOverlapsChildren, n)
00104     nodelist=>Nodes(n)%p 
00105     DO WHILE (associated(nodelist))
00106 
00107        node=>nodelist%self 
00108        overlaplist=>node%overlaps 
00109 
00110        DO WHILE (associated(overlaplist))
00111           overlap=>overlaplist%self 
00112           IF (overlap%box%MPI_ID == MPI_ID) CALL InheritOverlapChildren(node,overlap,n)
00113           overlaplist=>overlaplist%next
00114        END DO
00115 
00116        nodelist=>nodelist%next 
00117 
00118     END DO
00119     CALL StopTimer(iInheritOldNodeOverlapsChildren, n)
00120   END SUBROUTINE InheritOldNodeOverlapsChildren
00121 
00122   SUBROUTINE InheritNewNodeOverlapsChildren(n)
00123     INTEGER :: n
00124     TYPE(NodeDef), POINTER :: node, overlap
00125     TYPE(NodeDefList), POINTER :: nodelist, overlaplist
00126 
00127     CALL StartTimer(iInheritNewNodeOverlapsChildren, n)
00128 
00129     nodelist=>OldNodes(n)%p 
00130 
00131     DO WHILE (associated(nodelist))
00132 
00133        node=>nodelist%self 
00134        overlaplist=>node%overlaps 
00135 
00136        DO WHILE (associated(overlaplist))
00137 
00138           overlap=>overlaplist%self 
00139           IF (overlap%box%MPI_ID == MPI_ID) CALL InheritOverlapChildren(node,overlap,n)
00140           overlaplist=>overlaplist%next
00141 
00142        END DO
00143 
00144        nodelist=>nodelist%next 
00145 
00146     END DO
00147 
00148     CALL StopTimer(iInheritNewNodeOverlapsChildren, n)
00149   END SUBROUTINE InheritNewNodeOverlapsChildren
00150 
00153   SUBROUTINE InheritOverlapsOldChildren(n)
00154     INTEGER :: n
00155     TYPE(NodeDef), POINTER :: node, overlap
00156     TYPE(NodeDefList), POINTER :: nodelist, overlaplist, externallist
00157     CALL StartTimer(iInheritOverlapsOldChildren, n)
00158     nodelist=>Nodes(n)%p
00159     DO WHILE (associated(nodelist))
00160 
00161        node=>nodelist%self
00162        overlaplist=>node%overlaps 
00163 
00164        DO WHILE (associated(overlaplist))
00165 
00166           overlap=>overlaplist%self 
00167 
00168 !!! If we are here it is because we are on the second of two steps 
00169 !!! in which case overlaps are our previous neighbors and
00170 !!! and overlaps@oldchildren are the previous neighbors%children which we
00171 !!! already were informed about. (Assuming we age the children of external nodes)
00172           CALL InheritOverlapOldChildren(node,overlap,n)
00173           overlaplist=>overlaplist%next
00174        END DO
00175 
00176        CALL InheritSelfOverlapOldChildren(node,n)
00177        nodelist=>nodelist%next 
00178 
00179     END DO
00180 
00181     CALL StopTimer(iInheritOverlapsOldChildren, n)
00182 
00183   END SUBROUTINE InheritOverlapsOldChildren
00184 
00187   SUBROUTINE InheritOverlapsNewChildren(n)
00188     INTEGER :: n
00189     TYPE(NodeDef), POINTER :: node, overlap
00190     TYPE(NodeDefList), POINTER :: nodelist, overlaplist
00191     CALL StartTimer(iInheritOverlapsNewChildren, n)
00192 
00193     nodelist=>Nodes(n)%p
00194 
00195     DO WHILE (associated(nodelist))
00196 
00197        node=>nodelist%self
00198        overlaplist=>node%overlaps 
00199 
00200        DO WHILE (associated(overlaplist))
00201 
00202           overlap=>overlaplist%self 
00203 
00204 !!! If we are here it is because we are on the second of two steps 
00205 !!! in which case overlaps are our previous neighbors and
00206 !!! and overlaps@oldchildren are the previous neighbors%children which we
00207 !!! already were informed about. (Assuming we age the children of external nodes)
00208 !!! We should only call this after receiving all of our neighbors children
00209           CALL InheritOverlapNewChildren(node,overlap,n)            
00210 
00211           overlaplist=>overlaplist%next
00212        END DO
00213 
00214        CALL InheritSelfOverlapNewChildren(node,n)
00215        nodelist=>nodelist%next 
00216 
00217     END DO
00218 
00219     CALL StopTimer(iInheritOverlapsNewChildren, n)
00220   END SUBROUTINE InheritOverlapsNewChildren
00222 
00223 
00226 
00229   SUBROUTINE CreateChildrens(n)
00230     INTEGER :: n
00231     TYPE(NodeDefList), POINTER :: nodelist
00232     TYPE(NodeDef), POINTER :: node
00233     CALL StartTimer(iCreateChildrens, n)
00234     nodelist=>Nodes(n)%p      
00235     DO WHILE (associated(nodelist))
00236        node=>nodelist%self
00237        CALL CreateChildren(node,n)
00238        nodelist=>nodelist%next
00239     END DO
00240     CALL StopTimer(iCreateChildrens, n)
00241   END SUBROUTINE CreateChildrens
00242 
00243 
00246   SUBROUTINE UpdateOverlaps(n)
00247     INTEGER :: n
00248     TYPE(NodeDef), POINTER :: node
00249     TYPE(NodeDefList), POINTER :: nodelist
00250     CALL StartTimer(iUpdateOverlaps, n)
00251 
00252     nodelist=>Nodes(n)%p 
00253 
00254     DO WHILE (associated(nodelist))             
00255        node=>nodelist%self 
00256        IF (.NOT. ASSOCIATED(node%overlaps, target=node%neighbors)) THEN
00257           CALL ClearNodeList(node%overlaps) 
00258           NULLIFY(node%lastoverlap)
00259           node%overlaps=>node%neighbors
00260           node%lastoverlap=>node%lastneighbor
00261        END IF
00262        nodelist=>nodelist%next
00263     END DO
00264 
00265     CALL StopTimer(iUpdateOverlaps, n)
00266   END SUBROUTINE UpdateOverlaps
00267 
00270   SUBROUTINE NullifyNeighbors(n)
00271     INTEGER :: n
00272     TYPE(NodeDef), POINTER :: node
00273     TYPE(NodeDefList), POINTER :: nodelist
00274     CALL StartTimer(iNullifyNeighbors, n)
00275     nodelist=>Nodes(n)%p 
00276     DO WHILE (associated(nodelist))
00277        node=>nodelist%self 
00278        NULLIFY(node%neighbors)
00279        NULLIFY(node%lastneighbor)
00280        nodelist=>nodelist%next
00281     END DO
00282     CALL StopTimer(iNullifyNeighbors, n)
00283 
00284   END SUBROUTINE NullifyNeighbors
00285 
00286 
00289   SUBROUTINE AgeNodesChildren(n)
00290     INTEGER :: n
00291     TYPE(NodeDef), POINTER :: node
00292     TYPE(NodeDefList), POINTER :: nodelist
00293     CALL StartTimer(iAgeNodesChildren, n)
00294     nodelist=>Nodes(n)%p
00295     DO WHILE (associated(nodelist))
00296        IF (.NOT. ASSOCIATED(nodelist%self)) THEN
00297           PRINT*, 'Error : no node associated in AgeNodesChildren'
00298           STOP
00299        END IF
00300        node=>nodelist%self 
00301        CALL AgeNodeChildren(node) 
00302        IF (n > -1 .AND. n < MaxLevel) CALL DeAllocChildFixups(node%info)
00303        nodelist=>nodelist%next
00304     END DO
00305 
00306 !!!  We want to age children of external neighbor nodes so we can use them for overlaps!!!
00307     nodelist=>ExternalNodes(n)%p
00308     DO WHILE (associated(nodelist))
00309        node=>nodelist%self 
00310        CALL AgeNodeChildren(node) 
00311        nodelist=>nodelist%next
00312     END DO
00313 
00314     CALL StopTimer(iAgeNodesChildren, n)
00315   END SUBROUTINE AgeNodesChildren
00316 
00319   SUBROUTINE AgeNodes(n)
00320     INTEGER :: n
00321     TYPE(NodeDefList), POINTER :: nodelist
00322     TYPE(NodeDef), POINTER :: node
00323     CALL StartTimer(iBackUpNodes, n)
00324 
00325     CALL DestroyOldNodes(n)
00326     OldNodes(n)%p=>Nodes(n)%p
00327     OldExternalNodes(n)%p=>ExternalNodes(n)%p
00328     LastOldLocalNode(n)%p=>LastLocalNode(n)%p
00329     LastOldExternalNode(n)%p=>LastExternalNode(n)%p
00330 
00331     NULLIFY(Nodes(n)%p) 
00332     NULLIFY(ExternalNodes(n)%p)
00333     NULLIFY(LastLocalNode(n)%p)
00334     NULLIFY(LastExternalNode(n)%p)
00335 
00336     nodelist=>OldNodes(n)%p
00337 
00338     DO WHILE (ASSOCIATED(nodelist))
00339        node=>nodelist%self
00340 
00341        IF (.NOT. ASSOCIATED(node)) THEN
00342           PRINT* ,"clearing an unassociated node!"
00343           STOP
00344        END IF
00345        IF (.NOT. ASSOCIATED(node%overlaps, target = node%neighbors)) THEN
00346           CALL ClearNodeList(node%neighbors)
00347        ELSE
00348           NULLIFY(node%neighbors)
00349        END IF
00350        CALL ClearNodeList(node%overlaps)
00351        NULLIFY(node%lastoverlap, node%lastneighbor) !,node%lastneighbor, node%neighbors) !done in nullify neighbors
00352        nodelist=>nodelist%next
00353     END DO
00354     !Because our external children have overlaps and neighbors stored locally
00355     nodelist=>OldExternalNodes(n)%p
00356     DO WHILE (ASSOCIATED(nodelist))
00357        node=>nodelist%self
00358        IF (.NOT. ASSOCIATED(node)) THEN
00359           PRINT* ,"clearing an unassociated node!"
00360           STOP
00361        END IF
00362        !Don't need neighbors (and/or overlaps anymore
00363        IF (.NOT. ASSOCIATED(node%overlaps, target = node%neighbors)) THEN
00364           CALL ClearNodeList(node%neighbors)
00365        ELSE
00366           NULLIFY(node%neighbors)
00367        END IF
00368        CALL ClearNodeList(node%overlaps)
00369        NULLIFY(node%lastoverlap, node%lastneighbor) !,node%lastneighbor,node%neighbors)
00370        nodelist=>nodelist%next
00371     END DO
00372 
00373     CALL StopTimer(iBackUpNodes, n  )
00374  END SUBROUTINE AgeNodes
00375 
00378   SUBROUTINE DestroyOldNodes(n)
00379     INTEGER :: n
00380     TYPE(NodeDef), POINTER :: node
00381     TYPE(NodeDefList), POINTER :: nodelist, temp
00382     CALL DestroyNodeList(OldNodes(n)%p)
00383     CALL DestroyNodeList(OldExternalNodes(n)%p)
00384     NULLIFY(LastOldLocalNode(n)%p, LastOldExternalNode(n)%p)
00385   END SUBROUTINE DestroyOldNodes
00386 
00389   SUBROUTINE DestroyNodes(n)
00390     INTEGER :: n
00391     TYPE(NodeDef), POINTER :: node
00392     TYPE(NodeDefList), POINTER :: nodelist, temp
00393     CALL DestroyNodeList(Nodes(n)%p)
00394     CALL DestroyNodeList(ExternalNodes(n)%p)
00395     CALL DestroyNodeList(BackupNodes(n)%p)
00396     CALL DestroyNodeList(BackupExternalNodes(n)%p)
00397     NULLIFY(LastLocalNode(n)%p, LastExternalNode(n)%p)
00398   END SUBROUTINE DestroyNodes
00399 
00400 
00402 END MODULE TreeLevelOps
00403 
 All Classes Files Functions Variables