prepc.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	prepc (level, nvar)
	This routine is called because regridding just changed the fine grids. More...

Function/Subroutine Documentation

prepc()

subroutine prepc	(		level,
			nvar
	)

This routine is called because regridding just changed the fine grids.

It modifies boundary list of each level level grid such that each grid knows along its boundary, what fine cells its cell borders and where to get saved flux for conservation fix-up

Parameters

[in]	level	boudnary lists of grids on this level get updated
[in]	nvar	number of equations for the system

Definition at line 12 of file prepc.f.

References amr_module::alloc, amr_module::cfluxptr, amr_module::hxposs, amr_module::hyposs, igetsp(), amr_module::intratx, amr_module::intraty, amr_module::iregsz, amr_module::jregsz, amr_module::levelptr, amr_module::listsp, amr_module::lstart, amr_module::ndihi, amr_module::ndilo, amr_module::ndjhi, amr_module::ndjlo, amr_module::node, setuse(), amr_module::spheredom, amr_module::xperdom, and amr_module::yperdom.

Referenced by regrid(), and setgrd().

c
      use amr_module
      implicit double precision (a-h,o-z)

c
c :::::::::::::::::::: PREPC ::::::::::::::::::::::::::::::::::::::
c
c this routine called because regridding just changed the fine grids.
c modify coarse grid boundary lists to store fluxes in appropriate
c fine grids lists.
c assume new fine grids have node(cfluxptr) initialized to null
c
c  first compute max. possible number of list cells. allocate
c  initially so that one pass through is enough.
c
c ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
c
      maxsp  = 0
      mkid   = lstart(level+1)
 10   if (mkid .eq. 0) go to 20
         ikeep  = (node(ndihi,mkid)-node(ndilo,mkid)+1)/intratx(level)
         jkeep  = (node(ndjhi,mkid)-node(ndjlo,mkid)+1)/intraty(level)
         maxsp  = maxsp + 2*(ikeep+jkeep)
      mkid = node(levelptr,mkid)
      go to 10
 20   listsp(level) = maxsp
      if (maxsp .eq. 0) go to 99
c
      hxpar   = hxposs(level)
      hypar   = hyposs(level)
      hxkid   = hxposs(level+1)
      hykid   = hyposs(level+1)
      imax    = iregsz(level) - 1
      jmax    = jregsz(level) - 1

      mpar = lstart(level)
 30   if (mpar .eq. 0) go to 99
c
       ispot   = 0
       ilo     = node(ndilo,mpar)
       jlo     = node(ndjlo,mpar)
       ihi     = node(ndihi,mpar)
       jhi     = node(ndjhi,mpar)
       locbc   = igetsp(5*maxsp)
c      #  initialize list to 0 (0 terminator indicates end of bc list)
       do 35 i = 1,5*maxsp
 35      alloc(locbc+i-1) = 0.d0
       node(cfluxptr,mpar) = locbc
c
       mkid = lstart(level+1)
 40    if (mkid .eq. 0) go to 60

          iclo = node(ndilo,mkid)/intratx(level)
          jclo = node(ndjlo,mkid)/intraty(level)
          ichi = node(ndihi,mkid)/intratx(level)
          jchi = node(ndjhi,mkid)/intraty(level)

          iplo = max(ilo,iclo)
          jplo = max(jlo,jclo)
          iphi = min(ihi,ichi)
          jphi = min(jhi,jchi)

c   regular intersections (will check in setuse that no duplication)
c   this first call is only interior interfaces. 

          if (iplo .le. iphi+1 .and. jplo .le. jphi+1) then
               kflag = 1 ! interior stuff, no mappings
                call setuse(alloc(locbc),maxsp,ispot,mkid,
     2          ilo,ihi,jlo,jhi,iclo,ichi,jclo,jchi,kflag)
          endif

c   for fine grids touching periodic boundary on right
          if  (xperdom .and. ilo .eq. 0 .and. ichi .eq. imax) then
              kflag = 1 ! periodic in x
              call setuse(alloc(locbc),maxsp,ispot,mkid,
     2          ilo,ihi,jlo,jhi,iclo-iregsz(level),ichi-iregsz(level),
     3          jclo,jchi,kflag)
           endif

c   for fine grids touching periodic boundary on left
          if  (xperdom .and. iclo .eq. 0 .and. ihi .eq. imax) then
              kflag = 1
              call setuse(alloc(locbc),maxsp,ispot,mkid,
     2          ilo,ihi,jlo,jhi,iclo+iregsz(level),ichi+iregsz(level),
     3          jclo,jchi,kflag)
          endif

c   for fine grids touching periodic boundary on top
          if  (yperdom .and. jlo .eq. 0 .and. jchi .eq. jmax) then
                kflag = 1
                call setuse(alloc(locbc),maxsp,ispot,mkid,
     2          ilo,ihi,jlo,jhi,iclo,ichi,
     3          jclo-jregsz(level),jchi-jregsz(level),kflag)
          endif

c   for fine grids touching periodic boundary on bottom
          if  (yperdom .and. jclo .eq. 0 .and. jhi .eq. jmax)  then
              kflag = 1
              call setuse(alloc(locbc),maxsp,ispot,mkid,
     2          ilo,ihi,jlo,jhi,iclo,ichi,
     3          jclo+jregsz(level),jchi+jregsz(level),kflag)
          endif

c   for fine grids touching boundary on top in spherically mapped case
c   and coarse grid touches top too. see if (mapped) x extent overlap.
          if  (spheredom .and. jhi .eq. jmax .and. jchi .eq. jmax) then
               kflag = 2
c              write(dbugunit,*)" for coarse grid ",mpar
               iwrap2 = iregsz(level) - iclo - 1  !higher mapped index
               iwrap1 = iregsz(level) - ichi - 1  !lower mapped index
               if (max(ilo,iwrap1) .le. min(ihi,iwrap2)) then
                  call setuse(alloc(locbc),maxsp,ispot,mkid,
     1                        ilo,ihi,jlo,jhi,iclo,ichi,
     2                        jclo,jchi,kflag)
               endif
          endif

c   fine grids touching boundary on bottom for spherically mapped case
c   coarse grid touches bottom too. see if (mapped) x extents overlap
          if  (spheredom .and. jclo .eq. 0 .and. jlo .eq. 0) then
               kflag = 3
               iwrap2 = iregsz(level) - iclo - 1  !higher mapped index
               iwrap1 = iregsz(level) - ichi - 1  !lower mapped index
               if (max(ilo,iwrap1) .le. min(ihi,iwrap2)) then
                  call setuse(alloc(locbc),maxsp,ispot,mkid,
     1                        ilo,ihi,jlo,jhi,iclo,ichi,
     2                        jclo,jchi,kflag)
               endif
          endif

 50     mkid = node(levelptr,mkid)
        go to 40
c
c  done with subgrid cycle. if no cells would need fixing, all done
c  else cycle through again to set up list with info. for bc processing
c
 60     continue
c
c  for now, leave unused space allocated to the grid. alternative is to
c  return (maxsp-ispot) amt starting at loc node(cfluxptr,mpar)+ispot.
c
       mpar = node(levelptr,mpar)
       go to 30
c
 99    return

Here is the call graph for this function:

Here is the caller graph for this function: