Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! stencil_control.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 !######################################################################### 00023 MODULE StencilControl 00024 USE GlobalDeclarations 00025 USE StencilDeclarations 00026 USE SchemeDeclarations 00027 USE Scheduling 00028 # if defined PTH 00029 USE PthDeclarations 00030 # endif 00031 IMPLICIT NONE 00032 CONTAINS 00035 00036 00038 SUBROUTINE setup() 00039 INTEGER :: dom_range(3,2), i 00040 CALL sweep_() 00041 CALL SetStencilNrVars 00042 CALL sort_dependencies() 00043 Stencil(aftersweepstep)%lead=0 00044 Stencil(aftersweepstep)%trail=0 00045 Stencil(aftersweepstep)%range=0 00046 CALL set_dependencies() 00047 CALL set_codependencies() 00048 CALL finalize_dependencies() 00049 CALL set_descriptions() 00050 hyperbolic_mbc=Stencil(q)%range(1,2) 00051 ! IF (MPI_ID == 0) CALL print_stencils 00052 END SUBROUTINE setup 00053 00054 00055 SUBROUTINE Clear_ranges() 00056 INTEGER :: dom_range(3,2) 00057 INTEGER :: i 00058 DO i=1,nStencils 00059 Stencil(slist(i))%range=RESHAPE( (/100,100,100,-100,-100,-100/), (/3,2/) ) 00060 END DO 00061 dom_range=square((/0,0,0,0,0,0/)) 00062 Stencil(aftersweepstep)%range=dom_range 00063 Stencil(aftersweepstep)%lead=0 00064 Stencil(aftersweepstep)%trail=0 00065 END SUBROUTINE Clear_ranges 00066 00068 SUBROUTINE print_stencils 00069 INTEGER :: i 00070 TYPE(StencilDef), POINTER :: a 00071 write(*,'(A16,6A4,2A7,A6)') 'Description ',' x1',' y1',' z1',' x2',' y2',' z2','| rank',' lead',' lag' 00072 DO i=1, nStencils 00073 a=>Stencil(slist(i)) 00074 write(*,'(A16,6I4,A2,I4,A1,3I6)') a%description, a%range, "| ", a%rank, " ", a%lead, a%lead-a%trail, slist(i) 00075 END DO 00076 END SUBROUTINE print_stencils 00077 00078 00079 00080 00082 SUBROUTINE sort_dependencies() 00083 INTEGER :: i,j,k,l,m,next_rank 00084 INTEGER :: a, inc 00085 !sort list of dependencies in backwards causal order 00086 !a depends on b called before any b depends on ... 00087 !find thing(s) that are depended on by nothing... 00088 !do all dependencies of that. 00089 !find things that are depended on only by things already taken care of... 00090 !find the next component that has no unranked dependendants or groupings 00091 00092 next_rank=1 00093 inc=1 00094 OuterLoop: DO m=1,nStencils 00095 InnerLoop: DO j=1,nStencils 00096 ! If j already has been ranked cycle 00097 IF (Stencil(j)%rank .ne. -1) CYCLE 00098 00099 ! If any of the things that depend on j are not yet ranked then skip 00100 DO k=1,di 00101 IF ((dependencies(k)%p2==j) .AND. Stencil(dependencies(k)%p1)%rank == -1) CYCLE InnerLoop 00102 END DO 00103 00104 ! If j is in an unranked group then cycle 00105 DO k=1,gi 00106 IF ((groupings(k)%p2 == j) .AND. Stencil(groupings(k)%p1)%rank == -1) CYCLE InnerLoop 00107 END DO 00108 00109 00110 ! If j is in a codepency then we would like to add both - so first check it's codependent partner 00111 DO l=1,ci 00112 IF (codependencies(l)%p1 == j .OR. codependencies(l)%p2 == j) THEN 00113 00114 i=merge(codependencies(l)%p1, codependencies(l)%p2, codependencies(l)%p2 == j) 00115 DO k=1,di 00116 IF ((dependencies(k)%p2==i) .AND. Stencil(dependencies(k)%p1)%rank == -1) CYCLE InnerLoop 00117 END DO 00118 00119 ! If i is in an unranked group then cycle 00120 DO k=1,gi 00121 IF ((groupings(k)%p2 == i) .AND. Stencil(groupings(k)%p1)%rank == -1) CYCLE InnerLoop 00122 END DO 00123 00124 Stencil(i)%rank=next_rank 00125 slist(inc)=i 00126 inc=inc+1 00127 00128 ! next_rank=next_rank+1 00129 ! m=m+1 !we can skip one m loop since we added an extra term 00130 END IF 00131 END DO 00132 00133 00134 slist(inc)=j 00135 inc=inc+1 00136 Stencil(j)%rank=next_rank 00137 00138 DO k=1,gi 00139 IF (groupings(k)%p1 == j) THEN 00140 i=groupings(k)%p2 00141 Stencil(i)%rank=next_rank 00142 slist(inc)=i 00143 inc=inc+1 00144 END IF 00145 END DO 00146 00147 next_rank=next_rank+1 00148 exit 00149 5 END DO InnerLoop 00150 END DO OuterLoop 00151 END SUBROUTINE sort_dependencies 00152 00153 00155 SUBROUTINE set_dependencies() 00156 INTEGER :: j,k,l,m 00157 DO k=1,nStencils 00158 00159 DO j=1,ci 00160 IF (codependencies(j)%p1 == slist(k) .OR. codependencies(j)%p2 == slist(k)) THEN 00161 ! i=merge(codependencies(j)%p1, codependencies(j)%p2, codependencies(j)%p2 == slist(k)) 00162 CALL ExpandIfNeeded(Stencil(codependencies(j)%p1)%range, Stencil(codependencies(j)%p2)%range, codependencies(j)%range) 00163 CALL ExpandIfNeeded(Stencil(codependencies(j)%p2)%range, Stencil(codependencies(j)%p1)%range, -codependencies(j)%range) 00164 Stencil(codependencies(j)%p2)%lead=MAX(Stencil(codependencies(j)%p1)%lead+codependencies(j)%range(1,1), Stencil(codependencies(j)%p2)%lead) 00165 Stencil(codependencies(j)%p1)%lead=Stencil(codependencies(j)%p2)%lead-codependencies(j)%range(1,1) 00166 END IF 00167 END DO 00168 00169 DO j=1,di 00170 IF (dependencies(j)%p1==slist(k)) THEN !need to adjust dependencies and groupings 00171 Stencil(dependencies(j)%p2)%lead=max(Stencil(dependencies(j)%p2)%lead, Stencil(dependencies(j)%p1)%lead+dependencies(j)%range(1,2)) 00172 Stencil(dependencies(j)%p2)%trail=min(Stencil(dependencies(j)%p2)%trail, Stencil(dependencies(j)%p1)%lead+dependencies(j)%range(1,1)) 00173 CALL ExpandIfNeeded(Stencil(dependencies(j)%p1)%range, Stencil(dependencies(j)%p2)%range, dependencies(j)%range) 00174 END IF 00175 END DO 00176 DO j=1,gi 00177 IF (groupings(j)%p1==slist(k)) THEN !need to adjust dependencies and groupings 00178 CALL ExpandIfNeeded(Stencil(groupings(j)%p1)%range, Stencil(groupings(j)%p2)%range, square((/0,0,0,0,0,0/))) 00179 Stencil(groupings(j)%p2)%lead=max(Stencil(groupings(j)%p2)%lead, Stencil(groupings(j)%p1)%lead) 00180 Stencil(groupings(j)%p2)%trail=min(Stencil(groupings(j)%p2)%trail, Stencil(groupings(j)%p1)%trail) 00181 END IF 00182 END DO 00183 END DO 00184 MaxLead=maxval(-Stencil(1:nStencils)%range(1,1)+Stencil(1:nStencils)%Lead) 00185 MaxTrail=minval(Stencil(1:nStencils)%range(1,2)-Stencil(1:nStencils)%Lead) 00186 END SUBROUTINE set_dependencies 00187 00188 00190 SUBROUTINE set_codependencies() 00191 INTEGER :: j 00192 DO j=1,ci 00193 CALL ExpandIfNeeded(Stencil(codependencies(j)%p1)%range, Stencil(codependencies(j)%p2)%range, codependencies(j)%range) 00194 CALL ExpandIfNeeded(Stencil(codependencies(j)%p2)%range, Stencil(codependencies(j)%p1)%range, -codependencies(j)%range) 00195 Stencil(codependencies(j)%p2)%lead=MAX(Stencil(codependencies(j)%p1)%lead+codependencies(j)%range(1,1), Stencil(codependencies(j)%p2)%lead) 00196 Stencil(codependencies(j)%p1)%lead=Stencil(codependencies(j)%p2)%lead-codependencies(j)%range(1,1) 00197 END DO 00198 END SUBROUTINE set_codependencies 00199 00201 SUBROUTINE finalize_dependencies() 00202 INTEGER :: j,k,l,m 00203 DO k=1,nStencils 00204 DO j=1,di 00205 IF (dependencies(j)%p1 == slist(k)) THEN !need to adjust dependencies and groupings 00206 Stencil(dependencies(j)%p2)%lead=max(Stencil(dependencies(j)%p2)%lead, Stencil(dependencies(j)%p1)%lead+dependencies(j)%range(1,2)) 00207 Stencil(dependencies(j)%p2)%trail=min(Stencil(dependencies(j)%p2)%trail, Stencil(dependencies(j)%p1)%lead+dependencies(j)%range(1,1)) 00208 CALL ExpandIfNeeded(Stencil(dependencies(j)%p1)%range, Stencil(dependencies(j)%p2)%range, dependencies(j)%range) 00209 END IF 00210 END DO 00211 DO j=1,gi 00212 IF (groupings(j)%p1 == slist(k)) THEN !need to adjust dependencies and groupings 00213 CALL ExpandIfNeeded(Stencil(groupings(j)%p1)%range, Stencil(groupings(j)%p2)%range, square((/0,0,0,0,0,0/))) 00214 Stencil(groupings(j)%p2)%lead=max(Stencil(groupings(j)%p2)%lead, Stencil(groupings(j)%p1)%lead) 00215 Stencil(groupings(j)%p2)%trail=min(Stencil(groupings(j)%p2)%trail, Stencil(groupings(j)%p1)%trail) 00216 END IF 00217 END DO 00218 END DO 00219 00220 END SUBROUTINE finalize_dependencies 00221 00222 00223 00226 subroutine shift(index, level, iStencil, mB) 00227 INTEGER :: iStencil, level, index, mB(3,2) 00228 INTEGER :: temp,ii 00229 mB=0 00230 mB(1,:)=Stencil(iStencil)%lead 00231 mB(2:3,:)=LevelBuffers(level)%StencilBuffer(iStencil)%range(2:3,:) 00232 IF (index >= LevelBuffers(level)%StencilBuffer(iStencil)%start) THEN !Need to cycle in case values still used 00233 temp=LevelBuffers(level)%StencilBuffer(iStencil)%x(Stencil(iStencil)%trail) 00234 do ii=Stencil(iStencil)%trail, Stencil(iStencil)%lead-1 00235 Levelbuffers(level)%StencilBuffer(iStencil)%x(ii)=LevelBuffers(level)%StencilBuffer(iStencil)%x(ii+1) 00236 end do 00237 LevelBuffers(level)%StencilBuffer(iStencil)%x(Stencil(iStencil)%lead)=temp 00238 END IF 00239 end subroutine shift 00240 00245 LOGICAL FUNCTION istimeshift(index,level,iStencil,mB) 00246 INTEGER :: iStencil, level, index, mB(3,2) 00247 INTEGER :: temp,ii 00248 REAL(8) :: wtime 00249 mB=0 00250 ! write(*,*) 'level =', level 00251 00252 istimeshift=.false. 00253 IF (iStencil == 0) RETURN 00254 IF (iThreaded == PSEUDO_THREADED) then ! .AND. tStopAdvance /= FOREVER) THEN 00255 IF (AdvanceState==STOPPING) RETURN 00256 IF (AdvanceState==RESUMING) THEN 00257 IF (AdvanceStencil(level) == iStencil) THEN 00258 AdvanceState = RUNNING 00259 AdvanceStencil(level) = 0 00260 ! write(*,*) MPI_ID, index, level, 'resuming on stencil', Stencil(iStencil)%description 00261 ELSE 00262 RETURN 00263 END IF 00264 END IF 00265 IF (mpi_wtime() > tStopAdvance) THEN 00266 AdvanceState=STOPPING 00267 AdvanceStencil(level)=iStencil 00268 ! write(*,*) MPI_ID, index, level, 'stopped on stencil', Stencil(iStencil)%description 00269 RETURN 00270 END IF 00271 END IF 00272 00273 istimeshift=LevelBuffers(level)%StencilBuffer(iStencil)%start <= index .AND. index <= LevelBuffers(level)%StencilBuffer(iStencil)%finish 00274 IF (istimeshift) THEN 00275 00276 # if defined PTH 00277 IF (iThreaded == THREADED .AND. level < MaxLevel) CALL yield(level) 00278 # endif 00279 00280 mB(1,:)=Stencil(iStencil)%lead 00281 mB(2:3,:)=LevelBuffers(level)%StencilBuffer(iStencil)%range(2:3,:) 00282 END IF 00283 IF (index >= LevelBuffers(level)%StencilBuffer(iStencil)%start) THEN !Need to cycle in case values still used 00284 temp=LevelBuffers(level)%StencilBuffer(iStencil)%x(Stencil(iStencil)%trail) 00285 do ii=Stencil(iStencil)%trail, Stencil(iStencil)%lead-1 00286 Levelbuffers(level)%StencilBuffer(iStencil)%x(ii)=LevelBuffers(level)%StencilBuffer(iStencil)%x(ii+1) 00287 end do 00288 LevelBuffers(level)%StencilBuffer(iStencil)%x(Stencil(iStencil)%lead)=temp 00289 END IF 00290 00291 END FUNCTION istimeshift 00292 00297 LOGICAL FUNCTION istime(index,level,iStencil, mB) 00298 INTEGER :: iStencil, level, index, mB(3,2) 00299 INTEGER :: temp,ii 00300 mB=0 00301 istime=.false. 00302 IF (iStencil == 0) RETURN 00303 IF (iThreaded == PSEUDO_THREADED .AND. AdvanceState /= RUNNING) RETURN 00304 istime=LevelBuffers(level)%StencilBuffer(iStencil)%start <= index .AND. index <= LevelBuffers(level)%StencilBuffer(iStencil)%finish 00305 IF (istime) THEN 00306 # if defined PTH 00307 IF (iThreaded == THREADED .AND. level < MaxLevel) CALL yield(level) 00308 # endif 00309 mB(1,:)=Stencil(iStencil)%lead 00310 mB(2:3,:)=LevelBuffers(level)%StencilBuffer(iStencil)%range(2:3,:) 00311 END IF 00312 END FUNCTION istime 00313 00314 00315 00316 00317 FUNCTION BufferSizes(dom_range) 00318 INTEGER, DIMENSION(3,2) :: dom_range 00319 INTEGER :: i,mb(3,2), BufferSizes 00320 BufferSizes=0 00321 DO i=1,nStencils 00322 mb=dom_range+Stencil(i)%range 00323 BufferSizes=BufferSizes+(Stencil(i)%lead-Stencil(i)%trail+1)*PRODUCT(mb(2:3,2)-mb(2:3,1)+1)*PRODUCT(Stencil(i)%NrVars(:)) 00324 END DO 00325 00326 END FUNCTION BufferSizes 00327 00328 SUBROUTINE initialize_buffer(Buffer, dom_range) 00329 TYPE(BufferDataDef) :: Buffer 00330 INTEGER, DIMENSION(3,2) :: dom_range 00331 INTEGER :: i,j,mb(3,2) 00332 ALLOCATE(Buffer%StencilBuffer(nStencils)) 00333 ! write(*,*) 'dom_range=', dom_range 00334 00335 DO i=1,nStencils 00336 mb=dom_range+Stencil(i)%range 00337 Buffer%StencilBuffer(i)%range=mB 00338 Buffer%StencilBuffer(i)%start=mB(1,1)-Stencil(i)%lead 00339 Buffer%StencilBuffer(i)%finish=mB(1,2)-Stencil(i)%lead !mB(1,2)-Stencil(i)%lead 00340 IF (PRODUCT(Stencil(i)%NrVars) > 0) THEN 00341 ALLOCATE(Buffer%StencilBuffer(i)%data(Stencil(i)%trail:Stencil(i)%lead,mb(2,1):mb(2,2),mb(3,1):mb(3,2),Stencil(i)%NrVars(1), Stencil(i)%NrVars(2))) 00342 ! write(*,*) size(Buffer%StencilBuffer(i)%data) 00343 CALL CheckAllocation(SweepAllocator, size(Buffer%StencilBuffer(i)%data)*8) 00344 IF (Stencil(i)%clear) THEN 00345 Buffer%StencilBuffer(i)%data=0 00346 ELSE 00347 ! Buffer%StencilBuffer(i)%data=0d0/0d0 00348 00349 END IF 00350 ! write(*,*) 'allocated data for buffer', stencil(i)%description, mB 00351 ELSE 00352 ! write(*,*) 'skipped allocation for buffer', stencil(i)%description, stencil(i)%nrvars 00353 END IF 00354 DO j=Stencil(i)%trail, Stencil(i)%lead 00355 Buffer%StencilBuffer(i)%x(j)=j 00356 END DO 00357 ! write(*,*) Stencil(i)%description, Buffer%StencilBuffer(i)%start, Buffer%StencilBuffer(i)%finish 00358 END DO 00359 ! write(*,*) 'init buffer loc', LOC(LevelBuffers(0)%StencilBuffer(w)), ASSOCIATED(LevelBuffers(0)%StencilBuffer(w)%data) 00360 00361 END SUBROUTINE initialize_buffer 00362 00363 SUBROUTINE Clear_Buffer(Buffer) 00364 TYPE(BufferDataDef) :: Buffer 00365 INTEGER :: i 00366 DO i=1,nStencils 00367 ! write(*,*) Stencil(i)%description, Stencil(i)%NrVars, ASSOCIATED(Buffer%StencilBuffer(i)%data) 00368 IF (ASSOCIATED(Buffer%StencilBuffer(i)%data)) THEN 00369 CALL CheckDeAllocation(SweepAllocator, size(Buffer%StencilBuffer(i)%data)*8) 00370 DEALLOCATE(Buffer%StencilBuffer(i)%data) 00371 END IF 00372 END DO 00373 DEALLOCATE(Buffer%StencilBuffer) 00374 END SUBROUTINE Clear_Buffer 00375 00376 00377 END MODULE StencilControl