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