Scrambler  1
scheduling.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 !    scheduling.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 
00029 
00032 MODULE Scheduling
00033 
00034    USE GlobalDeclarations
00035    USE TreeDeclarations
00036    USE HyperbolicDeclarations
00037    USE Timing
00038 !   USE HyperBolicControl
00039 
00040    IMPLICIT NONE
00041 !   REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: WorkLoadByLevel
00042 
00043    REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: WorkLoadByLevelPerStep
00044    REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: MeanWorkLoadByLevelPerStep
00045    TYPE(pNodeDeflist), DIMENSION(:), ALLOCATABLE :: AdvanceNodeListBylevel
00046 !   REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: WaitingTimesByLevel
00047 !   REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: AdvanceTimesByLevel
00048 !   REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: WaitingTimes
00049    REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: SyncTime
00050    REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: AccumulatedWorkDoneByLevel
00051 !   REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: TimeWastedByLevel
00052 !   REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE  :: TimeUsedBySolver  !Values used for partial updates
00053 
00054     REAL(KIND=qPREC) :: TimeAvailableToSolver
00055    
00056    SAVE
00057 CONTAINS
00058 
00061    SUBROUTINE CalcEstimatedWaitingTimes(n)
00062       INTEGER :: ierr, n, i, j
00063       INTEGER :: MinLevel, NumLevels
00064       REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: WaitTimes, WorkLeft, tSynchronize
00065       REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: MyWorkLeft
00066       REAL(KIND=qPREC) :: safety_fact
00067       REAL(KIND=qPREC) :: MyFinerWorkLeft, MyCoarserWorkLeft
00068       ! First fine the minimum level that will be going into a waiting advance before another call to calcEstimatedWaiting
00069       DO MinLevel=MaxLevel, 0, -1
00070          IF (levels(MinLevel)%step == 1) EXIT
00071       END DO
00072 
00073 
00074       safety_fact=1.1d0
00075       
00076       ! So level i is on it's first step...  It will have to complete it's second step before the next coarser level has to complete it's step and then go into a waiting advance
00077 
00078 !      IF (MPI_ID == 0) write(*,*) 'looking from levels ', minlevel, ' to ', maxlevel
00079       ALLOCATE(WorkLeft(MinLevel:MaxLevel, 0:MPI_NP-1))
00080       ALLOCATE(WaitTimes(MinLevel:MaxLevel, 0:MPI_NP-1))
00081       ALLOCATE(MyWorkLeft(MinLevel:MaxLevel))
00082       ALLOCATE(tSynchronize(MinLevel:MaxLevel,2))
00083 !      WaitTimes=0
00084       
00085       DO i = MaxLevel, MinLevel, -1
00086          MyFinerWorkLeft=SUM((/(WorkLoadByLevelPerStep(j,levels(j)%step)-WorkDoneByLevel(j),j=i,MaxLevel)/))
00087          MyCoarserWorkLeft=SUM((/(WorkLoadByLevelPerStep(j,levels(j)%step)-WorkDoneByLevel(j),j=0,i-1)/))
00088          tSynchronize(i,1)=MyFinerWorkLeft*safety_fact !earliest i'll likely be ready
00089          tSynchronize(i,2)=(MyFinerWorkLeft+MyCoarserWorkLeft) ! longest i would like to wait before redistributing
00090       END DO
00091 
00092 
00093 
00094 !SUM(WorkLoadByLevelPerStep(, levels(i)%step)-WorkDoneByLevel(i)
00095 !         CoarserWorkCanUse=SUM((/(WorkLoadByLevelPerStep(j,levels(j)%step)-WorkDoneByLevel(j),j=0,i-1)/))/(levels(i)%steps-levels(i)%step + 1)
00096 !         tSyncrhonize(i)=min(MyWorkThisLevel*1.1,MyWorkThisLevel+CoarserWorkCanUse)
00097 !         CoarserWorkWillUse=MyWorkLef
00098 
00099 !              (WorkLoadByLevelPerStep(i,levels(i)%step)-WorkDoneByLevel(i)) + &
00100 !              SUM((/(WorkLoadByLevelPerStep(j,levels(j)%step)-WorkDoneByLevel(j),j=0,i)/))/(levels(i)%steps-levels(i)%step + 1)
00101 
00102 
00103  !        MyWorkLeft(i)=min((WorkLoadByLevelPerStep(i, levels(i)%step)-WorkDoneByLevel(i))*1.1, &
00104  !             (WorkLoadByLevelPerStep(i,levels(i)%step)-WorkDoneByLevel(i)) + &
00105  !             SUM((/(WorkLoadByLevelPerStep(j,levels(j)%step)-WorkDoneByLevel(j),j=0,i)/))/(levels(i)%steps-levels(i)%step + 1)
00106  !     END DO
00107 
00108       ! If all you have is work on level 4 - then you don't have time to burn on coarser advances... - so you want to encourage other processors to stop waiting advances earlier...'
00109 
00110 
00111 ! On each processor we have
00112   !Tearliestpossible=workloadbylevelperstep-workdonebylevel
00113   !TEarliestDoneForSure=tearliestpossible*1.1
00114   !TCouldWait=CoarserWorkLoadLeft / number of fine level steps remaining within coarse step
00115 
00116 ! we have steps remaining for entire root step
00117 !  steps_remaining(i) = sum((levels(-1:i)%steps-levels(-1:i)%step) * 2**(/((i-j),j=-1,i)/))+1
00118 
00119 
00120 
00121 
00122   ! how many steps can we 
00123 
00124 ! Why not choose tearliestdoneforsure?
00125 ! because if tearliestdoneforsure > tearliestpossible+tcouldwait then maybe idle
00126 ! tAimtobeready = min(tearliestdoneforsure, tearliestpossible+tcouldwait)
00127 ! 
00128 
00129 
00130  !     write(*,*) 'myworkleft=', myworkleft(i)
00131       NumLevels=MaxLevel-MinLevel+1
00132 
00133       ! invert tsynchronize since we want to do mpi_min on the longest any proc can wait
00134       tSynchronize(:,2)=-tSynchronize(:,2)
00135       
00136       CALL StartTimer(iBarrier, n)
00137       CALL MPI_ALLReduce(MPI_IN_PLACE, tSynchronize, NumLevels*2, MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_WORLD, iErr)
00138 !      CALL MPI_ALLGather(MyWorkLeft, NumLevels , MPI_DOUBLE_PRECISION, WorkLeft, NumLevels, MPI_DOUBLE_PRECISION, levels(n)%MPI_COMM, iErr)      
00139       CALL StopTimer(iBarrier, n)
00140       tSynchronize(:,2)=-tSynchronize(:,2)
00141 
00142       !Now tSynchronize(:,1) is earliest everyone will be ready
00143       !and tSynchronize(:,2) is latest everyone can stay busy
00144 
00145  !     DO i=MaxLevel, MinLevel, -1
00146  !        CALL GetMaxDiff(WaitTimes(i,:), WorkLeft(i,:)-sum(WaitTimes(i+1:MaxLevel,:),1))
00147  !     END DO
00148 !      WaitingTimes(MinLevel:MaxLevel)=WaitTimes(MinLevel:MaxLevel, MPI_ID)
00149 
00150 !      DO i=Maxlevel, MaxLevel
00151 !         SyncTime(i)=mpi_wtime()-StartTime+SUM(WaitingTimes(i:MaxLevel)+MyWorkLeft(i:MaxLevel))
00152 !         write(*,'(A,2I4,3E18.7)') 'time to sync level ', i, MPI_ID, SUM(WaitingTimes(i:MaxLevel)+MyWorkLeft(i:MaxLevel))
00153 !      END DO
00154 
00155 
00156       DO i=Minlevel, MaxLevel
00157          IF (tSynchronize(i,2) > tSynchronize(i,1)) THEN !no problem
00158             SyncTime(i)=mpi_wtime()-StartTime+tSynchronize(i,1) 
00159          ELSE !take average
00160             SyncTime(i)=mpi_wtime()-StartTime+half*SUM(tSynchronize(i,1:2))
00161          END IF
00162 !         IF (MPi_ID == 0) write(*,'(A,2I4,3E18.7)') 'time to sync level ', i, MPI_ID, SyncTime(i), mpi_wtime()-StartTime+tSynchronize(i,:) !SUM(WaitingTimes(i:MaxLevel)+MyWorkLeft(i:MaxLevel))
00163       END DO
00164       
00165       
00166 
00167 !      SUM(WaitingTimes(i:MaxLevel) + WorkLeft(i:MaxLevel)) = constant
00168 
00169  
00170 !      WaitingTimes(
00171 !      IF (MPI_ID == 0) THEN
00172 !         write(*,'(A,10E25.15)') 'WorkLeft = ', MyWorkLeft
00173 !         write(*,'(A,10E25.15)') 'Waiting Times = ', WaitingTimes
00174 !      END IF
00175 
00176 !      write(*,*) MPI_ID, ' has time available to solver ', WaitingTimes(MinLevel:MaxLevel)
00177       
00178       DEALLOCATE(WorkLeft, WaitTimes, MyWorkLeft, tSynchronize)
00179 
00180    END SUBROUTINE CalcEstimatedWaitingTimes
00181    
00182 
00186    SUBROUTINE GetMaxDiff(maxdiff, x)
00187      REAL(KIND=qPREC), DIMENSION(:) :: maxdiff, x
00188 !     write(*,*) 'x = ', x
00189      maxdiff=maxval(x)-x
00190 !     write(*,*) 'maxdiff = ', maxdiff
00191    END SUBROUTINE GetMaxDiff
00192 
00193 
00195    SUBROUTINE SchedulingInit()
00196 
00197       ALLOCATE(AccumulatedWorkDoneByLevel(0:MaxLevel))
00198       ALLOCATE(WorkLoadByLevelPerStep(-1:MaxLevel,2))
00199       ALLOCATE(MeanWorkLoadByLevelPerStep(-1:MaxLevel))
00200       ALLOCATE(AdvanceNodeListByLevel(-1:MaxLevel))
00201 !      ALLOCATE(TimeUsedBySolver(-1:MaxLevel))
00202 !      ALLOCATE(WaitingTimes(-1:MaxLevel))
00203       ALLOCATE(SyncTime(0:MaxLevel))
00204       WorkLoadByLevelPerStep=0d0
00205       MeanWorkLoadByLevelPerStep=0d0
00206       AccumulatedWorkDoneByLevel=0d0
00207 !               WaitingTimesByLevel(0:MaxLevel), AdvanceTimesByLevel(0:MaxLevel), , &
00208 !               AccumulatedWorkDoneByLevel(0:MaxLevel), TimeWastedByLevel(0:MaxLevel), NumCellUpdatesByLevel(0:MaxLevel), EffectiveCellUpdatesByLevel(0:MaxLevel))
00209 
00210 
00211 !      TimeWastedByLevel=0
00212 !      AccumulatedWorkDoneByLevel=0
00213 !      NumCellUpdatesByLevel=0
00214 !      EffectiveCellUpdatesByLevel=0
00215 !      WorkDoneByLevel=0
00216       
00217 !      CALL ProfileAdvance
00218    END SUBROUTINE SchedulingInit
00219 
00220 END MODULE Scheduling
00221 
00222 
00223 
00224 
 All Classes Files Functions Variables