c----------------------------------------------------------------------- c Two-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,mfy := shape of fine grid c mcx,mcy := shape of coarse grid c c uf(,) := fine grid c uc(,) := coarse grid c c lbc(2) := lower bound for coarse grid c ubc(2) := upper bound for coarse grid c lbf(2) := lower bound for fine grid c ubf(2) := upper bound for fine grid c lbr(2) := lower bound for region restriction desired c ufr(2) := upper bound for region restriction desired c shaper(2) := shape of region restriction 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@cacr.caltech.edu c----------------------------------------------------------------------- subroutine restrict2(uf,mfx,mfy,lbf,ubf, & uc,mcx,mcy,lbc,ubc, & lbr,ubr,shaper,meqn,mbc) implicit none integer meqn, mbc, mcx, mcy, mfx, mfy, shaper(2) double precision uf(meqn,mfx,mfy), uc(meqn,mcx,mcy) integer lbf(2), ubf(2), & lbc(2), ubc(2), & lbr(2), ubr(2) c Local variables integer i, j, ii, jj, imin, imax, jmin, jmax, m, & ifine, icoarse, jfine, jcoarse, & refine, stridec, stridef, getindx integer mbcf 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)) jmin = max(lbf(2)+mbcf, lbc(2), lbr(2)) jmax = min(ubf(2)-mbcf, ubc(2), ubr(2)) if (mod(imin-lbc(1),stridec) .ne. 0) then imin = imin + stridec - mod(imin-lbc(1),stridec) endif if (mod(jmin-lbc(2),stridec) .ne. 0) then jmin = jmin + stridec - mod(jmin-lbc(2),stridec) endif 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... do 10 j = jmin, jmax, stridec jfine = getindx(j, lbf(2), stridef) jcoarse = getindx(j, lbc(2), stridec) do 10 i = imin, imax, stridec ifine = getindx(i, lbf(1), stridef) icoarse = getindx(i, lbc(1), stridec) ! if(icoarse .gt. mcx .or. jcoarse .gt. mcy)then ! write(0,*)'ERROR in restriction: ',icoarse,jcoarse ! end if do 10 m=1, meqn uc(m,icoarse,jcoarse) = 0 do 20 ii = 0, refine-1 do 20 jj = 0, refine-1 uc(m,icoarse,jcoarse) = uc(m,icoarse,jcoarse) + & uf(m,ifine+ii,jfine+jj) 20 continue uc(m,icoarse,jcoarse) = uc(m,icoarse,jcoarse) / refine**2 10 continue return end