/*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy.  Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov.  NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly.  Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/

c
c     $Id: MCLO_2D.F,v 1.2 1998/11/17 19:11:09 lijewski Exp $
c
#include <REAL.H>
#include <LO_BCTYPES.H>
#include <MCLO_F.H>
#include <ArrayLim.H>

c-----------------------------------------------------------------------
      subroutine FORT_RESIDL (
     $     res, DIMS(res), 
     $     rhs, DIMS(rhs),
     $     phi, DIMS(phi),
     $     lo, hi, nc
     $     )
      integer nc
      integer lo(BL_SPACEDIM)
      integer hi(BL_SPACEDIM)
      integer DIMDEC(phi)
      REAL_T phi(DIMV(phi),nc)
      integer DIMDEC(rhs)
      REAL_T rhs(DIMV(rhs),nc)
      integer DIMDEC(res)
      REAL_T res(DIMV(res),nc)
c
      integer i
      integer j
      integer n
c
      do n = 1, nc
         do j = lo(2), hi(2)
            do i = lo(1), hi(1)
               res(i,j,n) = rhs(i,j,n) - phi(i,j,n)
            enddo
         enddo
      enddo
c
      end
c-----------------------------------------------------------------------
      subroutine FORT_HARMONIC_AVERAGEEC (
     $     c, DIMS(c),
     $     f, DIMS(f),
     $     lo, hi, nc,
     $     cdir
     $     )
c
      integer nc
      integer lo(BL_SPACEDIM)
      integer hi(BL_SPACEDIM)
      integer cdir
      integer DIMDEC(f)
      REAL_T f(DIMV(f),nc)
      integer DIMDEC(c)
      REAL_T c(DIMV(c),nc)
c
      REAL_T factor, den
      parameter(factor=2.00)
      integer n
      integer i
      integer j
c
      if ( cdir .eq. 0 ) then
         do n = 1, nc
            do j = lo(2), hi(2)
               do i = lo(1), hi(1)+1
                  den = f(2*i,2*j,n) + f(2*i,2*j+1,n)
                  if (den .ne. 0.0) then
                    c(i,j,n) =  factor*f(2*i,2*j,n)*f(2*i,2*j+1,n)/den
                  else
                    c(i,j,n) =  0.0
                  endif
               enddo
            enddo
         enddo
      else if (cdir .eq. 1 ) then
         do n = 1, nc
            do j = lo(2), hi(2)+1
               do i = lo(1), hi(1)
                  den = f(2*i,2*j,n) + f(2*i+1,2*j,n)
                  if (den .ne. 0.0) then
                    c(i,j,n) =  factor*f(2*i,2*j,n)*f(2*i+1,2*j,n)/den
                  else
                    c(i,j,n) =  0.0
                  endif
               enddo
            enddo
         enddo
      endif
c
      end
c-----------------------------------------------------------------------
      subroutine FORT_AVERAGEEC (
     $     c, DIMS(c),
     $     f, DIMS(f),
     $     lo, hi, nc,
     $     cdir
     $     )
c
      integer nc
      integer lo(BL_SPACEDIM)
      integer hi(BL_SPACEDIM)
      integer cdir
      integer DIMDEC(f)
      REAL_T f(DIMV(f),nc)
      integer DIMDEC(c)
      REAL_T c(DIMV(c),nc)
c
      integer n
      integer i
      integer j
      REAL_T denom
      parameter(denom=0.50d0)
c
      if (cdir .eq. 0 ) then
         do n = 1, nc
            do j = lo(2), hi(2)
               do i = lo(1), hi(1)+1
                  c(i,j,n) = (f(2*i,2*j,n) + f(2*i,2*j+1,n))*denom
               enddo
            enddo
         enddo
      else if (cdir .eq. 1) then
         do n = 1, nc
            do j = lo(2), hi(2)+1
               do i = lo(1), hi(1)
                  c(i,j,n) = (f(2*i,2*j,n) + f(2*i+1,2*j,n))*denom
               enddo
            enddo
         enddo
      endif
c
      end
c-----------------------------------------------------------------------
      subroutine FORT_AVERAGECC (
     $     c, DIMS(c),
     $     f, DIMS(f),
     $     lo, hi, nc
     $     )
c
      integer nc
      integer DIMDEC(f)
      integer DIMDEC(c)
      integer lo(BL_SPACEDIM)
      integer hi(BL_SPACEDIM)
      REAL_T f(DIMV(f),nc)
      REAL_T c(DIMV(c),nc)
c
      integer i
      integer j
      integer n
      REAL_T denom
      parameter(denom=0.25d0)
c
      do n = 1, nc
         do j = lo(2), hi(2)
            do i = lo(1), hi(1)
               c(i,j,n) =  (
     $              f(2*i+1,2*j+1,n) + f(2*i  ,2*j+1,n)
     $              + f(2*i+1,2*j  ,n) + f(2*i  ,2*j  ,n))*denom
            enddo
         enddo
      enddo
c
      end
