/*
** (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: HYPERCLAW_3D.F,v 1.2 1999/04/02 19:28:19 car Exp $
c

#undef  BL_LANG_CC
#ifndef BL_LANG_FORT
#define BL_LANG_FORT
#endif

#include "REAL.H"
#include "CONSTANTS.H"
#include "BC_TYPES.H"
#include "HYPERCLAW_F.H"
#include "ArrayLim.H"
#include "integrator.fh"

#define SDIM 3

c :: 
c :: ----------------------------------------------------------
c :: estimate the timestep for this grid r
c :: 
c :: INPUTS/OUTPUTS
c :: state      =>  state array
c :: slo,shi    =>  index limits of state array
c :: c          =>   c array 
c :: clo,chi    =>  index limits of c array
c :: delta      =>  cell size
c :: dt        <=   timestep estimate
c :: 
c :: ----------------------------------------------------------
c :: 

      subroutine FORT_ESTDT (state,DIMS(s),c,DIMS(c),lo,hi,delta,dt,nv)

      integer   nv
      integer lo(SDIM), hi(SDIM)
      integer   DIMDEC(s)
      integer   DIMDEC(c)
      REAL_T    dt
      REAL_T    delta(SDIM)
      REAL_T 	state(DIMV(s),nv)
      REAL_T 	c(DIMV(c))

      integer   i, j, k, is,ie,js,je, ks,ke
      REAL_T    ux,uy,uz,dt1,dt2,dt3,dx,dy, dz
      REAL_T    small,gdum,pdum,csdum
 
      is = lo(1)
      js = lo(2)
      ks = lo(3)
      ie = hi(1)
      je = hi(2)
      ke = hi(3)

      dx = delta(1)
      dy = delta(2)
      dz = delta(3)

      dt = bigreal
      do k = ks, ke         
         do j = js, je         
            do i = is, ie             
               ux = state(i,j,k,2)/state(i,j,k,1)
               uy = state(i,j,k,3)/state(i,j,k,1)
               uz = state(i,j,k,4)/state(i,j,k,1)
               state(i,j,k,5) = state(i,j,k,5)/state(i,j,k,1) -
     $              half*(ux**2 + uy**2 + uz**2)
               state(i,j,k,6) = state(i,j,k,6)/state(i,j,k,1)
            end do
         end do
      end do
      call eos(state(is,js,ks,1),state(is,js,ks,5),state(is,js,ks,6),
     $     DIMS(s),
     $     gdum,pdum,c,csdum,
     $     DIMS(c),
     $     lo, hi,0,0,1,0)
      do k = ks, ke           
         do j = js, je           
            do i = is, ie         
               ux = abs(state(i,j,k,2))/state(i,j,k,1)
               uy = abs(state(i,j,k,3))/state(i,j,k,1)
               uz = abs(state(i,j,k,4))/state(i,j,k,1)
               dt1 = dx/(c(i,j,k) + ux)
               dt2 = dy/(c(i,j,k) + uy)
               dt3 = dz/(c(i,j,k) + uz)
               dt = min(dt,dt1,dt2,dt3)
            end do
         end do
      end do

      end

c :: ----------------------------------------------------------
c :: Volume-weight average the fine grid data onto the coarse
c :: grid.  Overlap is given in coarse grid coordinates.
c ::
c :: INPUTS / OUTPUTS:
c ::  crse      <=  coarse grid data
c ::  clo,chi    => index limits of crse array interior
c ::  ngc        => number of ghost cells in coarse array
c ::  nvar	 => number of components in arrays
c ::  fine       => fine grid data
c ::  flo,fhi    => index limits of fine array interior
c ::  ngf        => number of ghost cells in fine array
c ::  rfine      => (ignore) used in 2-D RZ calc
c ::  lo,hi      => index limits of overlap (crse grid)
c ::  lrat       => refinement ratio
c ::
c :: NOTE:
c ::  Assumes all data cell centered
c :: ----------------------------------------------------------
c ::
      subroutine FORT_AVGDOWN (crse,DIMS(c),nvar,cv,DIMS(cv),
     &                         fine,DIMS(f),fv,DIMS(fv),lo,hi,lrat)
      integer  DIMDEC(c)
      integer  DIMDEC(cv)
      integer  DIMDEC(f)
      integer  DIMDEC(fv)
      integer  lo(SDIM), hi(SDIM)
      integer  nvar, lrat(SDIM)
      REAL_T   crse(DIMV(c),nvar)
      REAL_T   cv(DIMV(cv))
      REAL_T   fine(DIMV(f),nvar)
      REAL_T   fv(DIMV(fv))

      integer  i, j, k, n, ic, jc, kc, ioff, joff, koff
      integer  lenx, leny, lenz, mxlen
      integer  lratx, lraty, lratz

      REAL_T   volfrac

      lratx = lrat(1)
      lraty = lrat(2)
      lratz = lrat(3)
      lenx = hi(1)-lo(1)+1
      leny = hi(2)-lo(2)+1
      lenz = hi(3)-lo(3)+1
      mxlen = max(lenx,leny,lenz)
      volfrac = one/float(lrat(1)*lrat(2)*lrat(3))

      if (lenx .eq. mxlen) then
         do n = 1, nvar
c
c         ::::: set coarse grid to zero on overlap
c
            do kc = lo(3), hi(3)
               do jc = lo(2), hi(2)
                  do ic = lo(1), hi(1)
                     crse(ic,jc,kc,n) = zero
                  enddo
               enddo
            enddo
c
c         ::::: sum fine data
c
            do koff = 0, lratz-1
               do kc = lo(3),hi(3)
                  k = kc*lratz + koff
                  do joff = 0, lraty-1
                     do jc = lo(2), hi(2)
                        j = jc*lraty + joff
                        do ioff = 0, lratx-1
                           do ic = lo(1), hi(1)
                              i = ic*lratx + ioff
                              crse(ic,jc,kc,n) = crse(ic,jc,kc,n) + fine(i,j,k,n)
                           enddo
                        enddo
                     enddo
                  enddo
               enddo
            enddo
c            
c         ::::: divide out by volume weight
c
            do kc = lo(3), hi(3)
               do jc = lo(2), hi(2)
                  do ic = lo(1), hi(1)
                     crse(ic,jc,kc,n) = volfrac*crse(ic,jc,kc,n)
                  enddo
               enddo
            enddo
            
         end do

      else if (leny .eq. mxlen) then

         do n = 1, nvar
c
c         ::::: set coarse grid to zero on overlap
c
            do kc = lo(3), hi(3)
               do ic = lo(1), hi(1)
                  do jc = lo(2), hi(2)
                     crse(ic,jc,kc,n) = zero
                  enddo
               enddo
            enddo
c
c         ::::: sum fine data
c
            do koff = 0, lratz-1
               do kc = lo(3), hi(3)
                  k = kc*lratz + koff
                  do ioff = 0, lratx-1
                     do ic = lo(1), hi(1)
                        i = ic*lratx + ioff
                        do joff = 0, lraty-1
                           do jc = lo(2), hi(2)
                              j = jc*lraty + joff
                              crse(ic,jc,kc,n) = crse(ic,jc,kc,n) + fine(i,j,k,n)
                           enddo
                        enddo
                     enddo
                  enddo
               enddo
            enddo
c            
c         ::::: divide out by volume weight
c
            do kc = lo(3), hi(3)
               do ic = lo(1), hi(1)
                  do jc = lo(2), hi(2)
                     crse(ic,jc,kc,n) = volfrac*crse(ic,jc,kc,n)
                  enddo
               enddo
            enddo
            
         end do

      else

         do n = 1, nvar
c
c         ::::: set coarse grid to zero on overlap
c
            do ic = lo(1), hi(1)
               do jc = lo(2), hi(2)
                  do kc = lo(3), hi(3)
                     crse(ic,jc,kc,n) = zero
                  enddo
               enddo
            enddo
c
c         ::::: sum fine data
c
            do joff = 0, lraty-1
               do jc = lo(2), hi(2)
                  j = jc*lraty + joff
                  do ioff = 0, lratx-1
                     do ic = lo(1), hi(1)
                        i = ic*lratx + ioff
                        do koff = 0, lratz-1
                           do kc = lo(3), hi(3)
                              k = kc*lratz + koff
                              crse(ic,jc,kc,n) = crse(ic,jc,kc,n) + fine(i,j,k,n)
                           enddo
                        enddo
                     enddo
                  enddo
               enddo
            enddo
c            
c         ::::: divide out by volume weight
c
            do jc = lo(2), hi(2)
               do ic = lo(1), hi(1)
                  do kc = lo(3), hi(3)
                     crse(ic,jc,kc,n) = volfrac*crse(ic,jc,kc,n)
                  enddo
               enddo
            enddo
            
         end do

      end if

      end


c :: ----------------------------------------------------------
c :: SUMMASS
c ::             MASS = sum{ vol(i,j)*rho(i,j) }
c ::
c :: INPUTS / OUTPUTS:
c ::  rho        => density field
c ::  rlo,rhi    => index limits of rho aray
c ::  lo,hi      => index limits of grid interior
c ::  delta      => cell size
c ::  mass      <=  total mass
c ::  r          => radius at cell center
c ::  irlo,hi    => index limits of r array
c ::  rz_flag    => == 1 if R_Z coords
c ::  tmp        => temp column array
c :: ----------------------------------------------------------
c ::
       subroutine FORT_SUMMASS(rho,DIMS(r),lo,hi,delta,mass,
     &                         r,irlo,irhi,rz_flag,tmp, tlo, thi)
       integer irlo, irhi, rz_flag
       integer DIMDEC(r)
       integer lo(SDIM), hi(SDIM)
       REAL_T  mass, delta(SDIM)
       REAL_T  rho(DIMV(r))
       REAL_T  r(irlo:irhi)
       integer tlo, thi
       REAL_T  tmp(tlo:thi)

       integer i, j, k
       REAL_T  dx, dy, dz, vol

       dx = delta(1)
       dy = delta(2)
       dz = delta(3)
       vol = dx*dy*dz

       do j = lo(2),hi(2)
          tmp(j) = zero
       enddo

       do k = lo(3), hi(3)
          do i = lo(1), hi(1)
             do j = lo(2), hi(2)
                tmp(j) = tmp(j) + vol*rho(i,j,k)
             enddo
          enddo
       enddo

       mass = zero
       do j = lo(2), hi(2)
          mass = mass + tmp(j)
       enddo

       end

