1d/operators/restrict1.f

c-----------------------------------------------------------------------
c     One-dimensional restriction operator for AMROC.
c     A coarse cell value is overwritten by the mean value 
c     of all refined cells within this particular coarse cell.
c
c     Interface:
c        mfx := shape of fine grid
c        mcx := shape of coarse grid
c
c        uf() := fine grid
c        uc() := coarse grid
c
c        lbc(1) := lower bound for coarse grid
c        ubc(1) := upper bound for coarse grid
c        lbf(1) := lower bound for fine grid
c        ubf(1) := upper bound for fine grid
c        lbr(1) := lower bound for region restriction desired
c        ufr(1) := upper bound for region restriction desired
c        shaper(1) := shape of region restriction desired
c
c     Author: Ralf Deiterding
c-----------------------------------------------------------------------

      subroutine restrict1(uf,mfx,lbf,ubf,
     &     uc,mcx,lbc,ubc,
     &     lbr,ubr,shaper,args,argc)
      implicit none
      common /ghosts/ mbc
      integer mbc, mcx, mfx

      integer args, argc                  
      integer shaper(1)
      
      real*8 uf(args,mfx), uc(args,mcx)
      
      integer  lbf(1), ubf(1),
     &     lbc(1), ubc(1),
     &     lbr(1), ubr(1)
               
c      Local variables

      integer   i, ii, imin, imax, m, ifine, icoarse, refine, 
     &     stridec, stridef, meqn, getindx, mbcf

      meqn = args
c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c      See definition of member-function extents() in BBox.h 
c      for calculation of stride
c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
         
      stridec = (ubc(1) - lbc(1))/(mcx-1)
      stridef = (ubf(1) - lbf(1))/(mfx-1)
      refine = stridec/stridef
      mbcf = mbc * stridef

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c     Find coarse domain over which to refine
c     Take three regions and select out intersection
c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      imin = max(lbf(1)+mbcf, lbc(1), lbr(1))
      imax = min(ubf(1)-mbcf, ubc(1), ubr(1))
      
      if (mod(imin-lbc(1),stridec) .ne. 0) then
         imin = imin + stridec - mod(imin-lbc(1),stridec) 
      endif

c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c     Inject points to coarse grid from fine grid
c     Loop from lower bound to upper bound with stride of refine.
c     Convert the integer coordinates to fine and coarse grid absolute
c     coordinates...
c- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      do 10 i = imin, imax, stridec
         ifine = getindx(i, lbf(1), stridef)
         icoarse = getindx(i, lbc(1), stridec)
         
!         if (icoarse .gt. mcx ) then
!            write(0,*)'ERROR in restriction: ',icoarse
!         end if

         do 10 m=1, meqn
            uc(m,icoarse) = 0
            do 20 ii = 0, refine-1
               uc(m,icoarse) = uc(m,icoarse) + uf(m,ifine+ii)
 20         continue
            uc(m,icoarse) = uc(m,icoarse) / refine

 10   continue

      return
      end