Scrambler  1
data_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 !    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 
 All Classes Files Functions Variables