/*
** (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: MACOPERATOR_3D.F,v 1.8 2003/02/05 22:11:42 almgren Exp $
c
#undef  BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif

#include "REAL.H"
#include "CONSTANTS.H"
#include "MACOPERATOR_F.H"
#include "ArrayLim.H"

#define SDIM 3

c :: ----------------------------------------------------------
c :: MACCOEF
c ::             Compute the coefficents for MAC solve
c ::
c :: INPUTS / OUTPUTS:
c ::  cx,cy,cz    <=  edge coef arrays
c ::  DIMS(cx)     => index limits for cx
c ::  DIMS(cy)     => index limits for cy
c ::  DIMS(cz)     => index limits for cz
c ::  ax,ay,az     => edge based area arrays
c ::  DIMS(ax)     => index limits for ax
c ::  DIMS(ay)     => index limits for ay
c ::  DIMS(az)     => index limits for az
c ::  rho          => cell centered density array
c ::  DIMS(rho)    => index limits of rho array
c ::  lo,hi        => index limits for rhs
c ::  dx           => cell size
c :: ----------------------------------------------------------
c ::
       subroutine FORT_MACCOEF (cx,DIMS(cx),cy,DIMS(cy),cz,DIMS(cz),
     &                          ax,DIMS(ax),ay,DIMS(ay),az,DIMS(az),
     &                          rho,DIMS(rho),lo,hi,dx)
       integer DIMDEC(cx)
       integer DIMDEC(cy)
       integer DIMDEC(cz)
       integer DIMDEC(ax)
       integer DIMDEC(ay)
       integer DIMDEC(az)
       integer DIMDEC(rho)
       integer lo(SDIM), hi(SDIM)
       REAL_T  dx(SDIM)
       REAL_T  cx(DIMV(cx))
       REAL_T  cy(DIMV(cy))
       REAL_T  cz(DIMV(cz))
       REAL_T  ax(DIMV(ax))
       REAL_T  ay(DIMV(ay))
       REAL_T  az(DIMV(az))
       REAL_T  rho(DIMV(rho))

       integer i, j, k
       REAL_T  rhoavg

       do k = lo(3), hi(3)
          do j = lo(2), hi(2)
             do i = lo(1), hi(1)
                if (rho(i,j,k) .lt. zero) then
                   print *,' '
                   print *,'TESTING in MACCOEF '
                   print *,'RHO HAS GONE NEGATIVE AT ',i,j,k,rho(i,j,k)
                   call bl_abort(" ")
                end if
             end do
          end do
       end do
c
c      ::::: finish coef in X direction (part 2)
c
       do k = lo(3), hi(3)
          do j = lo(2), hi(2)
             do i = lo(1), hi(1)+1
                rhoavg = half * ( rho(i,j,k) + rho(i-1,j,k) )
c          cx(i,j,k) = half*dx(1)*ax(i,j,k)*(one/rho(i,j,k) + one/rho(i-1,j,k))
                cx(i,j,k) = dx(1) * ax(i,j,k) / rhoavg 
             end do
          end do
       end do
c
c      ::::: finish coef in Y direction (part 2)
c
       do k = lo(3), hi(3)
          do j = lo(2), hi(2)+1
             do i = lo(1), hi(1)
                rhoavg = half * ( rho(i,j,k) + rho(i,j-1,k) )
c          cy(i,j,k) = half*dx(2)*ay(i,j,k)*(one/rho(i,j,k) + one/rho(i,j-1,k))
                cy(i,j,k) = dx(2) * ay(i,j,k) / rhoavg 
             end do
          end do
       end do
c
c      ::::: finish coef in Z direction (part 2)
c
       do k = lo(3), hi(3)+1
          do j = lo(2), hi(2)
             do i = lo(1), hi(1)
                rhoavg = half * ( rho(i,j,k) + rho(i,j,k-1) )
c          cz(i,j,k) = half*dx(3)*az(i,j,k)*(one/rho(i,j,k) + one/rho(i,j,k-1))
                cz(i,j,k) = dx(3) * az(i,j,k) / rhoavg 
             end do
          end do
       end do

       end

c :: ----------------------------------------------------------
c :: MACRHS
c ::             Compute the RHS for MAC solve
c ::
c :: INPUTS / OUTPUTS:
c ::  ux,uy,uz    <=  edge velocity arrays
c ::  DIMS(ux)     => index limits for ux
c ::  DIMS(uy)     => index limits for uy
c ::  DIMS(uz)     => index limits for uz
c ::  ax,ay,az     => edge based area arrays
c ::  DIMS(ax)     => index limits for ax
c ::  DIMS(ay)     => index limits for ay
c ::  DIMS(az)     => index limits for az
c ::  vol          => cell centered volume array
c ::  DIMS(vol)    => index limits of vol array
c ::  rhs         <=> cell centered rhs array
c ::  DIMS(rhs)    => index limits of rhs array
c ::  lo,hi        => index limits for rhs
c ::  scale        => scale factor
c :: ----------------------------------------------------------
c ::
       subroutine FORT_MACRHS (ux,DIMS(ux),uy,DIMS(uy),uz,DIMS(uz),
     &                         ax,DIMS(ax),ay,DIMS(ay),az,DIMS(az),
     &                         vol,DIMS(vol),rhs,DIMS(rhs),lo,hi,scale)
       integer DIMDEC(ux)
       integer DIMDEC(uy)
       integer DIMDEC(uz)
       integer DIMDEC(ax)
       integer DIMDEC(ay)
       integer DIMDEC(az)
       integer DIMDEC(vol)
       integer DIMDEC(rhs)
       integer lo(SDIM), hi(SDIM)
       REAL_T  scale
       REAL_T  ux(DIMV(ux))
       REAL_T  uy(DIMV(uy))
       REAL_T  uz(DIMV(uz))
       REAL_T  ax(DIMV(ax))
       REAL_T  ay(DIMV(ay))
       REAL_T  az(DIMV(az))
       REAL_T  vol(DIMV(vol))
       REAL_T  rhs(DIMV(rhs))

       integer i, j, k
       REAL_T  divu
c
c      ::::: rhs holds the divergence condition (possibly zero)
c
       do k = lo(3), hi(3)
          do j = lo(2), hi(2)
             do i = lo(1), hi(1)
                divu = ax(i+1,j,k)*ux(i+1,j,k) - ax(i,j,k)*ux(i,j,k)
     &               + ay(i,j+1,k)*uy(i,j+1,k) - ay(i,j,k)*uy(i,j,k)
     &               + az(i,j,k+1)*uz(i,j,k+1) - az(i,j,k)*uz(i,j,k)
                rhs(i,j,k) = scale*(divu - vol(i,j,k)*rhs(i,j,k))
             end do
          end do
       end do

       end

c :: ----------------------------------------------------------
c :: MACUPDATE
c ::             Compute the update to velocity field to
c ::             make it divergence free
c ::
c :: INPUTS / OUTPUTS:
c ::  ux,uy,uz    <=  edge based velocity arrays
c ::  DIMS(ux)     => index limits for ux
c ::  DIMS(uy)     => index limits for uy
c ::  DIMS(uz)     => index limits for uz
c ::  phi          => soln from MAC project
c ::  DIMS(phi)    => index limits for phi
c ::  rho          => density at time N
c ::  DIMS(rho)    => index limits for rho
c ::  dx           => cell size
c ::  mult         => scalar multiplier
c :: ----------------------------------------------------------
c ::
       subroutine FORT_MACUPDATE(
     &     init,
     &     ux,DIMS(ux),uy,DIMS(uy),uz,DIMS(uz),
     &     phi,DIMS(phi),rho,DIMS(rho),
     &     lo,hi,dx,mult)

       integer DIMDEC(ux)
       integer DIMDEC(uy)
       integer DIMDEC(uz)
       integer DIMDEC(phi)
       integer DIMDEC(rho)
       integer lo(SDIM), hi(SDIM)
       REAL_T  dx(SDIM), mult
       REAL_T  ux(DIMV(ux))
       REAL_T  uy(DIMV(uy))
       REAL_T  uz(DIMV(uz))
       REAL_T  phi(DIMV(phi))
       REAL_T  rho(DIMV(rho))
       integer init

       integer i, j, k
       REAL_T  rhoavg, gp
c
c     set gradient to zero if initializing
c
       if ( init .eq. 1 ) then
          do k = ARG_L3(ux), ARG_H3(ux)
             do j = ARG_L2(ux), ARG_H2(ux)
                do i = ARG_L1(ux), ARG_H1(ux)
                   ux(i,j,k) = zero
                end do
             end do
          end do
          do k = ARG_L3(uy), ARG_H3(uy)
             do j = ARG_L2(uy), ARG_H2(uy)
                do i = ARG_L1(uy), ARG_H1(uy)
                   uy(i,j,k) = zero
                end do
             end do
          end do
          do k = ARG_L3(uz), ARG_H3(uz)
             do j = ARG_L2(uz), ARG_H2(uz)
                do i = ARG_L1(uz), ARG_H1(uz)
                   uz(i,j,k) = zero
                end do
             end do
          end do
       end if
c
c      compute x MAC gradient
c
       do k = lo(3),hi(3)
          do j = lo(2),hi(2)
             do i = lo(1),hi(1)+1
                rhoavg = half*(rho(i,j,k) + rho(i-1,j,k))
                gp = (phi(i,j,k)-phi(i-1,j,k))/dx(1)
                ux(i,j,k) = ux(i,j,k) + mult * gp / rhoavg
             end do
          end do
       end do
c     
c     compute y mac gradient
c
       do k = lo(3),hi(3)
          do j = lo(2),hi(2)+1
             do i = lo(1),hi(1)
                rhoavg = half*(rho(i,j,k) + rho(i,j-1,k))
                gp = (phi(i,j,k)-phi(i,j-1,k))/dx(2)
                uy(i,j,k) = uy(i,j,k) + mult * gp / rhoavg
             end do
          end do
       end do
c       
c     compute z mac gradient
c
       do k = lo(3),hi(3)+1
          do j = lo(2),hi(2)
             do i = lo(1),hi(1)
                rhoavg = half*(rho(i,j,k) + rho(i,j,k-1))
                gp = (phi(i,j,k)-phi(i,j,k-1))/dx(3)
                uz(i,j,k) = uz(i,j,k) + mult * gp / rhoavg
             end do
          end do
       end do

       end

c :: ----------------------------------------------------------
c :: MACSYNCRHS
c ::        Modify the RHS for MAC SYNC solve
c ::
c :: INPUTS / OUTPUTS:
c ::  rhs         <=  right hand side array
c ::  lo,hi        => index limits for rhs
c ::  vol          => cell centered volume array
c ::  vlo,vhi      => index limits of vol array
c ::  rhsscale     => const multiplier to rhs
c :: ----------------------------------------------------------
c ::
       subroutine FORT_MACSYNCRHS(rhs,DIMS(rhs),lo,hi,
     &                            vol,DIMS(vol),rhsscale)
       integer DIMDEC(rhs)
       integer DIMDEC(vol)
       integer lo(SDIM), hi(SDIM)
       REAL_T  rhsscale
       REAL_T  rhs(DIMV(rhs))
       REAL_T  vol(DIMV(vol))

       integer i, j, k
c
c      ::::: multiply by volume since reflux step (which computed rhs)
c      ::::: divided by volume.
c
       do k = lo(3), hi(3)
          do j = lo(2), hi(2)
             do i = lo(1), hi(1)
                rhs(i,j,k) = rhsscale*vol(i,j,k)*rhs(i,j,k)
             end do
          end do
       end do

       end
