Scrambler
1
|
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