CCC#  /*@@
CCC#    @file      restrict3.F
CCC#    @date      Tue Jan 30 14:39:23 1996
CCC#    @author    Paul Walker
CCC#    @desc 
CCC#    Restriction routines for the DNA code.
CCC#    @enddesc 
CCC#  @@*/
CCC# 
CCC# 
CCC#  /*@@
CCC#    @routine    restrict3
CCC#    @date       Tue Jan 30 14:39:19 1996
CCC#    @author     Paul Walker
CCC#    @desc 
CCC#       This is a simple injecting restriction.  Note it could probably be
CCC#       more efficient (see the triple loop with the "if" in it below) but
CCC#       it was coring out, so for now, I'll just leave it like this.
CCC#    @enddesc 
CCC#    @calledby   main, RecursiveAMRStep
CCC#    @comment 
CCC#       @seeroutine main and @seeroutine RecursiveAMRStep do not actuall
CCC#       "call" this routine.  @seeroutine main sets it as the restrict function, 
CCC#       and @seeroutine RecursiveAMRStep calls DAGH retrict, which calls
CCC#       (*rfunc).
CCC#    @endcomment
CCC# @@*/

      subroutine restrict3(datf,lbf,ubf,shapef,
     &                    datc,lbc,ubc,shapec,
     &                    lbr,ubr,shaper,args,argc) 
      implicit none
      integer lbf(3),ubf(3),shapef(3)
      integer lbc(3),ubc(3),shapec(3)
      integer lbr(3),ubr(3),shaper(3)

      real*8  datf(shapef(1),shapef(2),shapef(3))
      real*8  datc(shapec(1),shapec(2),shapec(3))
      
      integer argc
      real*8 args

      integer dif, dic
c coordinates in 123 space
      integer i,j,k, ii, jj, kk
c coordinates in the logical integer space
      integer ic, jc, kc, if, jf, kf, ir, jr, kr

      dif = (ubf(1)-lbf(1))/(shapef(1)-1)
      dic = (ubc(1)-lbc(1))/(shapec(1)-1)

c Lets hope the restricted region overlaps both the grids...
      do ir=lbr(1),ubr(1),dic
         i  = (ir-lbc(1))/dic + 1
         ii = (ir-lbf(1))/dif + 1
         do jr=lbr(2),ubr(2),dic
            j  = (jr-lbc(2))/dic + 1
            jj = (jr-lbf(2))/dif + 1
            do kr=lbr(3),ubr(3),dic
               k  = (kr-lbc(3))/dic + 1
               kk = (kr-lbf(3))/dif + 1
c OK we know the restrictive region will be in the coarse grid,
c but not neccesarily in the fine so check
               if ((ii.ge.1).and.(ii.le.shapef(1)).and.
     $              (jj.ge.1).and.(jj.le.shapef(2)).and.
     $              (kk.ge.1).and.(kk.le.shapef(3))) then 
                  datc(i,j,k) = datf(ii,jj,kk)
               endif
            enddo
         enddo
      enddo

      return
      end