Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! data_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 MODULE DataLevelOps 00039 USE DataInfoOps 00040 USE HyperbolicControl 00041 USE ModuleControl 00042 USE HyperbolicDeclarations 00043 USE TreeDeclarations 00044 USE Scheduling 00045 USE Timing 00046 USE DataLevelComms 00047 IMPLICIT NONE 00048 PRIVATE 00049 00050 !Pair-wise data operations 00051 PUBLIC ProlongateParentsData, ApplyOverlaps, ApplyChildrenData, ApplyInitialChildrenData, SyncFluxes 00052 00053 !Single node data operations 00054 PUBLIC InitInfos, InitialInitInfos, AfterOverlaps, UpdateChildMasks, SetErrFlags, RestrictionFixups, & 00055 AccumulateFluxes, CoarsenDataForParents, CoarsenInitialDataForParents, InitGrids, AdvanceGrids, & 00056 ApplyPhysicalBCs, AfterFixups, ChildMaskOverlaps, ScheduledAdvanceGrids, CompleteAdvanceGrids, WaitingAdvances, UpdateTimeDerivs, ClearFixupFluxes, ClearParentFixups, ClearChildFixups 00057 00058 PUBLIC InitRestartGrids, UpdateMeanDensity 00059 00060 PUBLIC GenericTransfer, TransferTimeDerivs 00061 00062 CONTAINS 00063 00068 SUBROUTINE GenericTransfer(n,fields,nghost, lPeriodic, lNeighbors_opt) 00069 INTEGER :: n 00070 INTEGER, DIMENSION(:) :: fields 00071 INTEGER :: nghost 00072 LOGICAL, DIMENSION(3) :: lPeriodic 00073 LOGICAL :: lNeighbors !ghosting with neighbors or overlaps? 00074 LOGICAL, OPTIONAL :: lNeighbors_opt 00075 IF (PRESENT(lNeighbors_opt)) THEN 00076 lNeighbors=lNeighbors_opt 00077 ELSE 00078 lNeighbors=.true. 00079 END IF 00080 CALL PostRecvGenericData(n, fields, nghost, lPeriodic, lNeighbors) 00081 CALL PostSendGenericData(n,fields,nghost, lPeriodic, lNeighbors) 00082 CALL ApplyGenericOverlaps(n,fields,nghost, lPeriodic, lNeighbors) 00083 CALL CompRecvGenericData(n,fields) 00084 CALL CompSendGenericData(n) 00085 END SUBROUTINE GenericTransfer 00086 00087 SUBROUTINE TransferTimeDerivs(n) 00088 INTEGER :: n 00089 IF (TDVars > 0) THEN 00090 CALL GenericTransfer(n, TimeDerivFields, levels(0)%egmbc(1), (/.true.,.true.,.true./), lNeighbors_opt=.false.) 00091 END IF 00092 END SUBROUTINE TransferTimeDerivs 00093 00098 SUBROUTINE ApplyGenericOverlaps(n,fields,nghost, lPeriodic, lNeighbors) 00099 INTEGER :: n,step 00100 TYPE(NodeDef), POINTER :: node, neighbor 00101 TYPE(NodeDefList), POINTER :: nodelist, neighborlist 00102 INTEGER, DIMENSION(:) :: fields 00103 INTEGER :: nghost 00104 LOGICAL, DIMENSION(3) :: lPeriodic 00105 LOGICAL :: lNeighbors 00106 nodelist=>Nodes(n)%p 00107 DO WHILE (associated(nodelist)) 00108 node=>nodelist%self 00109 IF (lNeighbors) THEN 00110 neighborlist=>node%neighbors 00111 ELSE 00112 neighborlist=>node%overlaps 00113 END IF 00114 DO WHILE (associated(neighborlist)) 00115 neighbor=>neighborlist%self 00116 IF (neighbor%box%MPI_ID == MPI_ID) CALL ApplyGenericOverlap(node%info,neighbor%info,n,fields,nghost, lPeriodic) 00117 neighborlist=>neighborlist%next 00118 END DO 00119 CALL ApplyGenericOverlap(node%info,node%info,n,fields,nghost, lPeriodic) 00120 nodelist=>nodelist%next 00121 END DO 00122 END SUBROUTINE ApplyGenericOverlaps 00123 00124 00125 00126 00129 00132 SUBROUTINE ProlongateParentsData(n) 00133 INTEGER :: n 00134 TYPE(NodeDef), POINTER :: node, parent 00135 TYPE(NodeDefList), POINTER :: nodelist 00136 CALL StartTimer(iProlongateParentsData, n) 00137 00138 nodelist=>Nodes(n)%p 00139 DO WHILE (associated(nodelist)) 00140 node=>nodelist%self 00141 parent => node%parent 00142 IF (.NOT. ASSOCIATED(parent)) THEN 00143 write(*,*) "Error - no parent associated in ProlongateParentsData" 00144 STOP 00145 END IF 00146 00147 IF (parent%box%MPI_id == MPI_id) CALL ProlongateParentData(parent%info, node%info) 00148 00149 nodelist=>nodelist%next 00150 END DO 00151 CALL StopTimer(iProlongateParentsData, n) 00152 00153 END SUBROUTINE ProlongateParentsData 00154 00155 00159 SUBROUTINE ApplyOverlaps(n,step) 00160 INTEGER :: n,step 00161 TYPE(NodeDef), POINTER :: node, overlap 00162 TYPE(NodeDefList), POINTER :: nodelist, overlaplist 00163 CALL StartTimer(iApplyOverlaps,n) 00164 nodelist=>Nodes(n)%p 00165 DO WHILE (associated(nodelist)) 00166 node=>nodelist%self 00167 overlaplist=>node%overlaps 00168 DO WHILE (associated(overlaplist)) 00169 overlap=>overlaplist%self 00170 IF (overlap%box%MPI_ID == MPI_ID) CALL ApplyOverlap(node%info,overlap%info,n) 00171 overlaplist=>overlaplist%next 00172 END DO 00173 IF (step == 2 .OR. .NOT. lRegridLevel(n)) CALL ApplyOverlap(node%info,node%info,n) 00174 nodelist=>nodelist%next 00175 END DO 00176 CALL StopTimer(iApplyOverlaps,n) 00177 END SUBROUTINE ApplyOverlaps 00178 00181 SUBROUTINE ApplyChildrenData(n) 00182 INTEGER :: n 00183 TYPE(NodeDef), POINTER :: node, child 00184 TYPE(NodeDefList), POINTER :: nodelist, childlist 00185 CALL StartTimer(iApplyChildrenData, n) 00186 nodelist=>Nodes(n)%p 00187 DO WHILE (associated(nodelist)) 00188 node=>nodelist%self 00189 childlist => node%children 00190 DO WHILE (ASSOCIATED(childlist)) 00191 child => childlist%self 00192 IF (child%box%MPI_ID == MPI_ID) CALL ApplyChildData(node%info, child%info, GetChildID(node,child),n) 00193 childlist => childlist%next 00194 END DO 00195 nodelist=>nodelist%next 00196 END DO 00197 CALL StopTimer(iApplyChildrenData, n) 00198 00199 END SUBROUTINE ApplyChildrenData 00200 00203 SUBROUTINE ApplyInitialChildrenData(n) 00204 INTEGER :: n 00205 TYPE(NodeDef), POINTER :: node, child 00206 TYPE(NodeDefList), POINTER :: nodelist, childlist 00207 00208 nodelist=>Nodes(n)%p 00209 DO WHILE (associated(nodelist)) 00210 node=>nodelist%self 00211 childlist => node%children 00212 DO WHILE (ASSOCIATED(childlist)) 00213 child => childlist%self 00214 IF (child%box%MPI_ID == MPI_ID) CALL ApplyInitialChildData(node%info, child%info, n) 00215 childlist => childlist%next 00216 END DO 00217 nodelist=>nodelist%next 00218 END DO 00219 END SUBROUTINE ApplyInitialChildrenData 00220 00221 00224 SUBROUTINE SyncFluxes(n) 00225 INTEGER :: n 00226 TYPE(NodeDef), POINTER :: node, neighbor 00227 TYPE(NodeDefList), POINTER :: nodelist, neighborlist 00228 CALL StartTimer(iSyncFluxes, n) 00229 00230 nodelist=>Nodes(n)%p 00231 DO WHILE (associated(nodelist)) 00232 node=>nodelist%self 00233 neighborlist=>node%neighbors 00234 DO WHILE (associated(neighborlist)) 00235 neighbor=>neighborlist%self 00236 IF (neighbor%box%MPI_ID == MPI_ID) CALL SyncFlux(node%info,neighbor%info) 00237 neighborlist=>neighborlist%next 00238 END DO 00239 00240 CALL SyncFlux(node%info,node%info) 00241 nodelist=>nodelist%next 00242 00243 END DO 00244 CALL StopTimer(iSyncFluxes, n) 00245 END SUBROUTINE SyncFluxes 00246 00248 00251 00254 SUBROUTINE AfterOverlaps(n) 00255 INTEGER :: n 00256 TYPE(NodeDef), POINTER :: node 00257 TYPE(NodeDefList), POINTER :: nodelist 00258 CALL StartTimer(iAfterOverlaps, n) 00259 IF (MaintainAuxArrays) THEN 00260 nodelist=>Nodes(n)%p 00261 DO WHILE (associated(nodelist)) 00262 node=>nodelist%self 00263 IF (MaintainAuxArrays) CALL ProlongationFixup(node%info) 00264 nodelist=>nodelist%next 00265 END DO 00266 END IF 00267 CALL StopTimer(iAfterOverlaps, n) 00268 END SUBROUTINE AfterOverlaps 00269 00272 SUBROUTINE ApplyPhysicalBCs(n) 00273 INTEGER :: n 00274 TYPE(NodeDef), POINTER :: node 00275 TYPE(NodeDefList), POINTER :: nodelist 00276 CALL StartTimer(iApplyPhysicalBCs, n) 00277 nodelist=>Nodes(n)%p 00278 DO WHILE (associated(nodelist)) 00279 node=>nodelist%self 00280 IF (.NOT. ASSOCIATED(node%info)) THEN 00281 print*, 'woops',MPI_ID, n,node%box, node%iD 00282 STOp 00283 END IF 00284 00285 CALL ApplyPhysicalBC(node%info) 00286 nodelist=>nodelist%next 00287 END DO 00288 CALL StopTimer(iApplyPhysicalBCs, n) 00289 00290 END SUBROUTINE ApplyPhysicalBCs 00291 00292 00295 SUBROUTINE RestrictionFixups(n) 00296 INTEGER :: n 00297 TYPE(NodeDef), POINTER :: node 00298 TYPE(NodeDefList), POINTER :: nodelist 00299 CALL StartTimer(iRestrictionFixups, n) 00300 00301 IF (MaintainAuxArrays) THEN 00302 nodelist=>Nodes(n)%p 00303 DO WHILE (associated(nodelist)) 00304 node=>nodelist%self 00305 00306 CALL RestrictionFixup(node%info) 00307 nodelist=>nodelist%next 00308 END DO 00309 END IF 00310 CALL StopTimer(iRestrictionFixups, n) 00311 00312 END SUBROUTINE RestrictionFixups 00313 00314 00317 SUBROUTINE UpdateTimeDerivs(n) 00318 INTEGER :: n 00319 TYPE(NodeDef), POINTER :: node 00320 TYPE(NodeDefList), POINTER :: nodelist 00321 nodelist=>Nodes(n)%p 00322 DO WHILE (associated(nodelist)) 00323 node=>nodelist%self 00324 CALL UpdateTimeDeriv(node%info) 00325 nodelist=>nodelist%next 00326 END DO 00327 END SUBROUTINE UpdateTimeDerivs 00328 00331 SUBROUTINE ClearFixupFluxes(n) 00332 INTEGER :: n 00333 TYPE(NodeDef), POINTER :: node 00334 TYPE(NodeDefList), POINTER :: nodelist 00335 nodelist=>Nodes(n)%p 00336 DO WHILE (associated(nodelist)) 00337 node=>nodelist%self 00338 CALL ClearFixupFlux(node%info) 00339 nodelist=>nodelist%next 00340 END DO 00341 END SUBROUTINE ClearFixupFluxes 00342 00345 SUBROUTINE ClearParentFixups(n) 00346 INTEGER :: n 00347 TYPE(NodeDef), POINTER :: node 00348 TYPE(NodeDefList), POINTER :: nodelist 00349 nodelist=>Nodes(n)%p 00350 DO WHILE (associated(nodelist)) 00351 node=>nodelist%self 00352 CALL ClearParentFixup(node%info) 00353 nodelist=>nodelist%next 00354 END DO 00355 END SUBROUTINE ClearParentFixups 00356 00359 SUBROUTINE ClearChildFixups(n) 00360 INTEGER :: n 00361 TYPE(NodeDef), POINTER :: node 00362 TYPE(NodeDefList), POINTER :: nodelist 00363 nodelist=>Nodes(n)%p 00364 DO WHILE (associated(nodelist)) 00365 node=>nodelist%self 00366 CALL ClearChildFixup(node%info) 00367 nodelist=>nodelist%next 00368 END DO 00369 END SUBROUTINE ClearChildFixups 00370 00373 SUBROUTINE AfterFixups(n) 00374 INTEGER :: n 00375 TYPE(NodeDef), POINTER :: node 00376 TYPE(NodeDefList), POINTER :: nodelist 00377 CALL StartTimer(iAfterFixups, n) 00378 nodelist=>Nodes(n)%p 00379 DO WHILE (associated(nodelist)) 00380 node=>nodelist%self 00381 CALL AfterFixup(node%info) 00382 nodelist=>nodelist%next 00383 END DO 00384 CALL StopTimer(iAfterFixups, n) 00385 END SUBROUTINE AfterFixups 00386 00387 00390 SUBROUTINE UpdateChildMasks(n) 00391 INTEGER :: n 00392 TYPE(NodeDef), POINTER :: node, neighbor,neighborchild, child 00393 TYPE(NodeDefList), POINTER :: nodelist 00394 TYPE(NodeDefList), POINTER :: neighborlist 00395 TYPE(NodeDefList), POINTER :: neighborchildlist 00396 TYPE(NodeDefList), POINTER :: childlist 00397 CALL StartTimer(iUpdateChildMasks, n) 00398 00399 nodelist=>Nodes(n)%p 00400 DO WHILE (associated(nodelist)) 00401 node=>nodelist%self 00402 neighborlist=>node%neighbors 00403 DO WHILE (associated(neighborlist)) 00404 neighbor=>neighborlist%self 00405 neighborchildlist=>neighbor%children 00406 DO WHILE (associated(neighborchildlist)) 00407 neighborchild=>neighborchildlist%self 00408 CALL UpdateChildMask(node%info, neighborchild%box%mGlobal) 00409 neighborchildlist=>neighborchildlist%next 00410 END DO 00411 00412 neighborlist=>neighborlist%next 00413 END DO 00414 childlist=>node%children 00415 DO WHILE (ASSOCIATED(childlist)) 00416 child=>childlist%self 00417 CALL UpdateSelfChildMask(node%info,child%box%mglobal) 00418 childlist=>childlist%next 00419 END DO 00420 nodelist=>nodelist%next 00421 END DO 00422 CALL StopTimer(iUpdateChildMasks, n) 00423 END SUBROUTINE UpdateChildMasks 00424 00425 00428 SUBROUTINE SetErrFlags(n) 00429 INTEGER :: n 00430 TYPE(NodeDef), POINTER :: node 00431 TYPE(NodeDefList), POINTER :: nodelist 00432 CALL StartTimer(iSetErrFlags, n) 00433 nodelist=>Nodes(n)%p 00434 DO WHILE (associated(nodelist)) 00435 node=>nodelist%self 00436 CALL SetErrFlag(node%info) 00437 nodelist=>nodelist%next 00438 END DO 00439 CALL StopTimer(iSetErrFlags, n) 00440 END SUBROUTINE SetErrFlags 00441 00444 SUBROUTINE CoarsenDataForParents(n) 00445 INTEGER :: n 00446 TYPE(NodeDef), POINTER :: node 00447 TYPE(NodeDefList), POINTER :: nodelist 00448 CALL StartTimer(iCoarsenDataForParents,n) 00449 nodelist=>Nodes(n)%p 00450 DO WHILE (associated(nodelist)) 00451 node=>nodelist%self 00452 CALL CoarsenDataForParent(node%info, n) 00453 nodelist=>nodelist%next 00454 00455 CALL StopTimer(iCoarsenDataForParents,n) 00456 END DO 00457 END SUBROUTINE CoarsenDataForParents 00458 00459 00462 SUBROUTINE CoarsenInitialDataForParents(n) 00463 INTEGER :: n 00464 TYPE(NodeDef), POINTER :: node 00465 TYPE(NodeDefList), POINTER :: nodelist 00466 00467 nodelist=>Nodes(n)%p 00468 DO WHILE (associated(nodelist)) 00469 node=>nodelist%self 00470 CALL CoarsenInitialDataForParent(node%info, n) 00471 nodelist=>nodelist%next 00472 END DO 00473 END SUBROUTINE CoarsenInitialDataForParents 00474 00477 SUBROUTINE AccumulateFluxes(n) 00478 INTEGER :: n 00479 TYPE(NodeDef), POINTER :: node 00480 TYPE(NodeDefList), POINTER :: nodelist 00481 CALL StartTimer(iAccumulateFluxes, n) 00482 nodelist=>Nodes(n)%p 00483 DO WHILE (associated(nodelist)) 00484 node=>nodelist%self 00485 CALL AccumulateFlux(node%info) 00486 nodelist=>nodelist%next 00487 END DO 00488 CALL StopTimer(iAccumulateFluxes, n) 00489 END SUBROUTINE AccumulateFluxes 00490 00493 SUBROUTINE InitInfos(n) 00494 INTEGER :: n 00495 TYPE(NodeDef), POINTER :: node, neighbor 00496 TYPE(NodeDefList), POINTER :: nodelist 00497 TYPE(NodeDefList), POINTER :: neighborlist 00498 CALL StartTimer(iInitInfos, n) 00499 NumCellsByLevel(n)=0 00500 nodelist=>Nodes(n)%p 00501 DO WHILE (associated(nodelist)) 00502 node=>nodelist%self 00503 CALL InitInfo(node%info, n,node%box%mGlobal, node%parent%box%mGlobal) 00504 NumCellsByLevel(n)=NumCellsByLevel(n)+product(node%info%mx) 00505 nodelist=>nodelist%next 00506 END DO 00507 CALL StopTimer(iInitInfos, n) 00508 00509 END SUBROUTINE InitInfos 00510 00513 SUBROUTINE ChildMaskOverlaps(n) 00514 INTEGER :: n 00515 TYPE(NodeDef), POINTER :: node, neighbor 00516 TYPE(NodeDefList), POINTER :: nodelist 00517 TYPE(NodeDefList), POINTER :: neighborlist 00518 CALL StartTimer(iChildMaskOverlaps,n) 00519 00520 nodelist=>Nodes(n)%p 00521 DO WHILE (associated(nodelist)) 00522 node=>nodelist%self 00523 neighborlist=>node%neighbors 00524 DO WHILE (associated(neighborlist)) 00525 neighbor=>neighborlist%self 00526 CALL ChildMaskOverlap(node%info, neighbor%box%mGlobal) 00527 neighborlist=>neighborlist%next 00528 END DO 00529 CALL ChildMaskOverlap(node%info, node%box%mGlobal) 00530 nodelist=>nodelist%next 00531 END DO 00532 CALL StopTimer(iChildMaskOverlaps,n) 00533 END SUBROUTINE ChildMaskOverlaps 00534 00537 SUBROUTINE InitialInitInfos(n) 00538 INTEGER :: n 00539 TYPE(NodeDef), POINTER :: node, neighbor 00540 TYPE(NodeDefList), POINTER :: nodelist 00541 TYPE(NodeDefList), POINTER :: neighborlist 00542 NumCellsByLevel(n)=0 00543 nodelist=>Nodes(n)%p 00544 DO WHILE (associated(nodelist)) 00545 node=>nodelist%self 00546 CALL InitialInitInfo(node%info, n,node%box%mGlobal, node%parent%box%mGlobal) 00547 NumCellsByLevel(n)=NumCellsByLevel(n)+product(node%info%mx) 00548 nodelist=>nodelist%next 00549 END DO 00550 END SUBROUTINE InitialInitInfos 00551 00552 00555 SUBROUTINE InitGrids(n) 00556 INTEGER :: n 00557 TYPE(NodeDef), POINTER :: node 00558 TYPE(NodeDefList), POINTER :: nodelist 00559 00560 nodelist=>Nodes(n)%p 00561 DO WHILE (associated(nodelist)) 00562 node=>nodelist%self 00563 CALL GridInit(node%info) 00564 nodelist=>nodelist%next 00565 END DO 00566 END SUBROUTINE InitGrids 00567 00568 !! @brief An adaptation of InitGrids geared toward restarts. 00569 !! @param level The level of the grids being initialized. 00570 SUBROUTINE InitRestartGrids(level) 00571 INTEGER :: level 00572 00573 TYPE(NodeDef), POINTER :: node 00574 TYPE(NodeDefList), POINTER :: nodelist 00575 00576 nodelist=>Nodes(level)%p 00577 DO WHILE (associated(nodelist)) 00578 node=>nodelist%self 00579 CALL GridInit(node%info) 00580 nodelist=>nodelist%next 00581 END DO 00582 00583 END SUBROUTINE InitRestartGrids 00584 00587 SUBROUTINE AdvanceGrids(n) 00588 INTEGER :: n,i 00589 TYPE(NodeDef), POINTER :: node 00590 TYPE(NodeDefList), POINTER :: nodelist 00591 if (levels(n)%dt == 0) RETURN 00592 CALL StartTimer(iAdvanceGrids, n) 00593 nodelist=>Nodes(n)%p 00594 DO WHILE (associated(nodelist)) 00595 node=>nodelist%self 00596 CALL Advance(node%info) 00597 nodelist=>nodelist%next 00598 END DO 00599 levels(n)%tnow=levels(n)%tnow+levels(n)%dt 00600 CALL StopTimer(iAdvanceGrids, n) 00601 END SUBROUTINE AdvanceGrids 00602 00603 00606 SUBROUTINE ScheduledAdvanceGrids(n) 00607 INTEGER :: n,i 00608 TYPE(NodeDef), POINTER :: node 00609 TYPE(NodeDefList), POINTER :: nodelist 00610 INTEGER :: level 00611 AdvanceNodeListByLevel(n)%p=>Nodes(n)%p 00612 IF (n == MaxLevel .AND. MaxLevel > 0) THEN 00613 CALL StartTimer(iScheduledAdvanceGrids, n) 00614 CALL CalcEstimatedWaitingTimes(n) 00615 CALL StopTimer(iScheduledAdvanceGrids, n) 00616 END IF 00617 END SUBROUTINE ScheduledAdvanceGrids 00618 00621 SUBROUTINE CompleteAdvanceGrids(n) 00622 INTEGER :: n 00623 TYPE(NodeDef), POINTER :: node 00624 if (levels(n)%dt == 0) RETURN 00625 ! CALL StartTimer(iCompleteAdvancedGrids, n) 00626 CALL StartTimer(iAdvanceGrids, n) 00627 00628 DO WHILE (ASSOCIATED(AdvanceNodeListByLevel(n)%p)) 00629 node=>AdvanceNodeListByLevel(n)%p%self 00630 CALL Advance(node%info, .true.) 00631 AdvanceNodeListByLevel(n)%p=>AdvanceNodeListByLevel(n)%p%next 00632 END DO 00633 levels(n)%tnow=levels(n)%tnow+levels(n)%dt 00634 00635 CALL StopTimer(iAdvanceGrids, n) 00636 ! CALL StopTimer(iCompleteAdvancedGrids, n) 00637 00638 END SUBROUTINE CompleteAdvanceGrids 00639 00642 SUBROUTINE WaitingAdvances(n) 00643 INTEGER :: n, level,i 00644 TYPE(NodeDef), POINTER :: node 00645 REAL(KIND=qPREC) :: WorkDoneThisStep 00646 ! CALL StartTimer(iWaitingAdvances, n) 00647 level=n-1 00648 if (levels(n)%dt == 0) RETURN 00649 ! IF (WaitingTimes(n) <= 0) RETURN 00650 00651 IF (StartTime+SyncTime(n) < mpi_wtime()) THEN 00652 ! write(*,'(A,I4,A,12E15.3)') 'exiting late on processor ', MPI_ID, ' at ', mpi_wtime()-StartTime-Synctime(n), ((/WorkDoneByLevel(i),WorkLoadByLevelPerStep(i,levels(i)%step)/), i=0,MaxLevel) 00653 RETURN 00654 END IF 00655 ! TimeAvailableToSolver=WaitingTimes(n) 00656 TimeAvailableToSolver=StartTime+SyncTime(n) !-mpi_wtime() !WaitingTimes(n) 00657 ! write(*,*) MPI_ID, 'waiting advances ', n, WaitingTimes(n) 00658 DO WHILE (level >= 0) 00659 DO WHILE (ASSOCIATED(AdvanceNodeListByLevel(level)%p)) 00660 CALL StartTimer(iAdvanceGrids, level) 00661 00662 node=>AdvanceNodeListByLevel(level)%p%self 00663 CALL Advance(node%info) 00664 ! TimeAvailableToSolver=TimeAvailableToSolver-TimeUsedBySolver(level) 00665 IF (NodeCompleted(level)) THEN 00666 AdvanceNodeListByLevel(level)%p=>AdvanceNodeListByLevel(level)%p%next 00667 ELSE 00668 CALL StopTimer(iAdvanceGrids, level) 00669 EXIT 00670 END IF 00671 CALL StopTimer(iAdvanceGrids, level) 00672 END DO 00673 00674 IF (StartTime+SyncTime(n) < mpi_wtime()) EXIT !TimeAvailableToSolver <= 0) EXIT 00675 level=level-1 00676 END DO 00677 IF (mpi_wtime() < StartTime+SyncTime(n)) THEN 00678 ! write(*,'(A,I4,A,12E15.3)') 'exiting early on processor ', MPI_ID, ' at ', mpi_wtime()-StartTime-SyncTime(n), ((/WorkDoneByLevel(i), WorkLoadByLevelPerStep(i,levels(i)%step)/), i=0,MaxLevel) 00679 ! write(*,'(I4,A,E25.15)') MPI_ID, 'exiting WaitingAdvances at t = ', mpi_wtime()-StartTime 00680 END IF 00681 ! CALL StopTimer(iWaitingAdvances, n) 00682 END SUBROUTINE WaitingAdvances 00684 00685 ! Routine for calculating mean density on root level 00686 SUBROUTINE UpdateMeanDensity(n) 00687 INTEGER :: n 00688 REAL(KIND=qPREC) :: total_mass 00689 TYPE(NodeDef), POINTER :: node 00690 TYPE(NodeDefList), POINTER :: nodelist 00691 INTEGER :: iErr 00692 TYPE(InfoDef), POINTER :: info 00693 INTEGER :: i, mB(3,2) 00694 total_mass=0 00695 DO i=0,n 00696 nodelist=>Nodes(i)%p 00697 DO WHILE(ASSOCIATED(nodelist)) 00698 info=>nodelist%self%info 00699 mB=1 00700 mB(1:nDim,2)=Info%mX(1:nDim) 00701 IF (i < n) THEN 00702 total_mass=total_mass+SUM(Info%q(1:Info%mX(1),1:Info%mX(2),1:Info%mX(3),irho), Info%ChildMask(1:Info%mX(1),1:Info%mX(2),1:Info%mX(3)) <= 0)*levels(i)%dx**nDim 00703 ELSE 00704 total_mass=total_mass+SUM(Info%q(1:Info%mX(1),1:Info%mX(2),1:Info%mX(3),irho))*levels(i)%dx**nDim 00705 END IF 00706 nodelist=>nodelist%next 00707 END DO 00708 END DO 00709 CALL StartTimer(iBarrier, 0) 00710 CALL MPI_ALLREDUCE(MPI_IN_PLACE, total_mass, 1, MPI_DOUBLE_PRECISION, MPI_SUM,levels(0)%MPI_COMM, iErr) 00711 CALL StopTimer(iBarrier, 0) 00712 mean_density=total_mass/(product(GxBounds(1:nDim,2)-GxBounds(1:nDim,1))) 00713 ! IF (MPI_ID == 0) write(*,*) "mean density=", mean_density, total_mass, n 00714 END SUBROUTINE UpdateMeanDensity 00715 00716 00717 END MODULE DataLevelOps 00718