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