1d/operators/prolong1.f

c-----------------------------------------------------------------------
c     One-dimensional prolongation operator for AMROC.
c     A fine grid value is replaced by the value of a linear function
c     through the neighbouring coarse grid values at the center
c     of the particular fine grid 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 prolongation desired
c        ufr(1) := upper bound for region prolongation desired
c        shaper(1) := shape of region prolongation desired
c
c     Author: Ralf Deiterding
c-----------------------------------------------------------------------

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

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

c      Local variables

      integer   i, m, ic, mic,  
     &     refine, stridec, stridef,
     &     ifine, ics, meqn
      
      double precision eta1

      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
      
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c      Prolongation region is defined on the domain of the fine grid. 
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      do 10 i=lbr(1), ubr(1), stridef
         ifine = getindx(i, lbf(1), stridef)
         ics = getindx(i, lbc(1), stridec)
         
         ic = i - lbc(1)
         mic = ic - (ic/stridec)*stridec
         if(mic .lt. stridec*0.5) then
            ics = ics - 1
         end if
         ic = ic + stridec*0.5
         mic = ic - (ic/stridec)*stridec
         eta1 = (mic+0.5d0*stridef) / stridec

!         if(ics+1 .gt. mcx .or. 
!     &        ics .lt. 1) then
!            uf(m,ifine) = -100000.0
!            write(0,*)'ERROR in prolongation: ',ics
!         endif

         do 10 m=1, meqn
            uf(m,ifine) = (1.d0-eta1)*uc(m,ics  ) + 
     &                          eta1 *uc(m,ics+1)
               
 10   continue

      return
      end