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 Copyright (C) 2002 Ralf Deiterding
c Brandenburgische Universitaet Cottbus
c
c Copyright (C) 2003-2007 California Institute of Technology
c Ralf Deiterding, ralf@amroc.net
c-----------------------------------------------------------------------
subroutine prolong1(uc,mcx,lbc,ubc,
& uf,mfx,lbf,ubf,
& lbr,ubr,shaper,meqn,mbc)
implicit none
integer meqn, mbc, mcx, mfx, shaper(1)
double precision uf(meqn,mfx), uc(meqn,mcx)
integer lbf(1), ubf(1),
& lbc(1), ubc(1),
& lbr(1), ubr(1),
& getindx
c Local variables
integer i, m, ic, mic,
& stridec, stridef,
& ifine, ics
double precision eta1
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)
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