/*
** (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.
*/

#include "REAL.H"
#include "CONSTANTS.H"
#include "GRID_F.H"
#include "BCTypes.H"

#define N_STATE 4
#define DIMS lo_1,lo_2,hi_1,hi_2

c *************************************************************************
c ** MKFLUX **
c ** If (velpred == 1), then predict normal edge velocities to be
c **    MAC_projected and used for advection velocities
c ** If (velpred == 0), then create the time-centered edge states to
c **    be used in defining the velocity and scalar fluxes.
c ***************************************************************

      subroutine FORT_MKFLUX(s,sedgex,sedgey,slopex,slopey,
     $                       uadv,vadv,utrans,vtrans,force,
     $                       s_l,s_r,s_b,s_t,DIMS,
     $                       dx,dt,visc_coef,irz,bc,velpred,
     $                       nstart,nend)

      implicit none

      integer DIMS
      integer nstart,nend

      REAL_T       s(lo_1-3:hi_1+3,lo_2-3:hi_2+3,N_STATE)
      REAL_T  sedgex(lo_1  :hi_1+1,lo_2  :hi_2  ,N_STATE)
      REAL_T  sedgey(lo_1  :hi_1  ,lo_2  :hi_2+1,N_STATE)
      REAL_T  slopex(lo_1-1:hi_1+1,lo_2-1:hi_2+1,N_STATE)
      REAL_T  slopey(lo_1-1:hi_1+1,lo_2-1:hi_2+1,N_STATE)
      REAL_T    uadv(lo_1  :hi_1+1,lo_2  :hi_2  )
      REAL_T    vadv(lo_1  :hi_1  ,lo_2  :hi_2+1)
      REAL_T  utrans(lo_1-1:hi_1+2,lo_2-1:hi_2+1)
      REAL_T  vtrans(lo_1-1:hi_1+1,lo_2-1:hi_2+2)
      REAL_T   force(lo_1-1:hi_1+1,lo_2-1:hi_2+1,nstart:nend)

      REAL_T    s_l(lo_1-1:hi_1+2)
      REAL_T    s_r(lo_1-1:hi_1+2)
      REAL_T    s_b(lo_2-1:hi_2+2)
      REAL_T    s_t(lo_2-1:hi_2+2)

      REAL_T  dx(2)
      REAL_T  dt
      REAL_T  visc_coef
      integer irz
      integer bc(2,2)
      integer velpred

c     Local variables
      REAL_T ubardth, vbardth
      REAL_T hx, hy, dth
      REAL_T splus,sminus
      REAL_T savg,st
      REAL_T sptop,spbot,smtop,smbot,splft,sprgt,smlft,smrgt
      integer n
      logical test

      REAL_T eps

      integer i,j,is,js,ie,je
      integer ii

      eps = 1.0e-8

      is = lo_1
      ie = hi_1
      js = lo_2
      je = hi_2

      dth = half*dt

      hx = dx(1)
      hy = dx(2)

c
c     Loop for fluxes on x-edges.
c
      do n = nstart,nend
       do j = js,je 
        if (velpred .eq. 0 .or. n .eq. 1) then
        do i = is-1,ie+1 

          spbot = s(i,j  ,n) + (half - dth*s(i,j  ,2)/hy) * slopey(i,j  ,n)
c    $            + dth * force(i,  j,n)
          sptop = s(i,j+1,n) - (half + dth*s(i,j+1,2)/hy) * slopey(i,j+1,n)
c    $            + dth * force(i,j+1,n)

          sptop = cvmgt(s(i,je+1,n),sptop,j.eq.je .and. BCY_HI .eq. INLET)
          spbot = cvmgt(s(i,je+1,n),spbot,j.eq.je .and. BCY_HI .eq. INLET)

          if (j .eq. je .and. BCY_HI .eq. WALL) then
            if (n .eq. 2) then
              sptop = zero
              spbot = zero
            elseif (n .eq. 1) then
              sptop = cvmgt(zero,spbot,visc_coef .gt. zero)
              spbot = cvmgt(zero,spbot,visc_coef .gt. zero)
            else
              sptop = spbot
            endif
          endif

          splus = cvmgp(spbot,sptop,vtrans(i,j+1))
          savg  = half * (spbot + sptop)
          splus = cvmgt(splus, savg, abs(vtrans(i,j+1)) .gt. eps)

          smtop = s(i,j  ,n) - (half + dth*s(i,j  ,2)/hy) * slopey(i,j  ,n)
c    $            + dth * force(i,j  ,n)
          smbot = s(i,j-1,n) + (half - dth*s(i,j-1,2)/hy) * slopey(i,j-1,n)
c    $            + dth * force(i,j-1,n)

          smtop = cvmgt(s(i,js-1,n),smtop,j.eq.js .and. BCY_LO .eq. INLET)
          smbot = cvmgt(s(i,js-1,n),smbot,j.eq.js .and. BCY_LO .eq. INLET)

          if (j .eq. js .and. BCY_LO .eq. WALL) then
            if (n .eq. 2) then
              smtop = zero
              smbot = zero
            elseif (n .eq. 1) then
              smbot = cvmgt(zero,smtop,visc_coef .gt. zero)
              smtop = cvmgt(zero,smtop,visc_coef .gt. zero)
            else
              smbot = smtop
            endif
          endif

          sminus = cvmgp(smbot,smtop,vtrans(i,j))
          savg   = half * (smbot + smtop)
          sminus = cvmgt(sminus, savg, abs(vtrans(i,j)) .gt. eps)

          st = force(i,j,n) -
     $          half * (vtrans(i,j)+vtrans(i,j+1))*(splus - sminus) / hy

          ubardth = dth*s(i,j,1)/hx

          s_l(i+1)= s(i,j,n) + (half-ubardth)*slopex(i,j,n) + dth*st
          s_r(i  )= s(i,j,n) - (half+ubardth)*slopex(i,j,n) + dth*st

         enddo

         if (velpred .eq. 1) then
           do i = is, ie+1 
             savg = half*(s_r(i) + s_l(i))
             test = ( (s_l(i) .le. zero  .and.
     $                 s_r(i) .ge. zero)  .or.
     $               (abs(s_l(i) + s_r(i)) .lt. eps) )
             sedgex(i,j,n)=cvmgp(s_l(i),s_r(i),savg)
             sedgex(i,j,n)=cvmgt(savg,sedgex(i,j,n),test)
           enddo
         else
           do i = is, ie+1 
             sedgex(i,j,n)=cvmgp(s_l(i),s_r(i),uadv(i,j))
             savg = half*(s_r(i) + s_l(i))
             sedgex(i,j,n)=cvmgt(savg,sedgex(i,j,n),abs(uadv(i,j)) .lt. eps)
           enddo
         endif

         if (BCX_LO .eq. WALL) then
           if (n .eq. 1) then
             sedgex(is,j,n) = zero
           elseif (n .eq. 2) then
             sedgex(is,j,n) = cvmgt(zero,s_r(is),visc_coef.gt.0.0.and.irz.eq.0)
           else 
             sedgex(is,j,n) = s_r(is)
           endif
         elseif (BCX_LO .eq. INLET) then
           sedgex(is,j,n) = s(is-1,j,n)
         elseif (BCX_LO .eq. OUTLET) then
           sedgex(is,j,n) = s_r(is)
         endif
         if (BCX_HI .eq. WALL) then
           if (n .eq. 1) then
             sedgex(ie+1,j,n) = zero
           else if (n .eq. 2) then
             sedgex(ie+1,j,n) = cvmgt(zero,s_l(ie+1),visc_coef .gt. 0.0)
           else 
             sedgex(ie+1,j,n) = s_l(ie+1)
           endif
         elseif (BCX_HI .eq. INLET) then
           sedgex(ie+1,j,n) = s(ie+1,j,n)
         elseif (BCX_HI .eq. OUTLET) then
           sedgex(ie+1,j,n) = s_l(ie+1)
         endif

         if (velpred .eq. 1) then
           do i = is, ie+1 
             uadv(i,j) = sedgex(i,j,1)
           enddo
         endif
         endif
       enddo

      enddo

c
c     Loop for fluxes on y-edges.
c
      do n = nstart,nend
       do i = is, ie 
        if (velpred .eq. 0 .or. n .eq. 2) then
        do j = js-1, je+1 

          splft = s(i,j  ,n) + (half - dth*s(i  ,j,1)/hx) * slopex(i  ,j,n)
c    $            + dth * force(i  ,j,n)
          sprgt = s(i+1,j,n) - (half + dth*s(i+1,j,1)/hx) * slopex(i+1,j,n)
c    $            + dth * force(i+1,j,n)

          sprgt = cvmgt(s(ie+1,j,n),sprgt,i.eq.ie .and. BCX_HI .eq. INLET)
          splft = cvmgt(s(ie+1,j,n),splft,i.eq.ie .and. BCX_HI .eq. INLET)

          if (i .eq. ie .and. BCX_HI .eq. WALL) then
            if (n .eq. 1) then
              splft = zero
              sprgt = zero
            elseif (n .eq. 2) then
              sprgt = cvmgt(zero,splft,visc_coef .gt. zero)
              splft = cvmgt(zero,splft,visc_coef .gt. zero)
            else
              sprgt = splft
            endif
          endif

          splus = cvmgp(splft,sprgt,utrans(i+1,j))
          savg  = half * (splft + sprgt)
          splus = cvmgt(splus, savg, abs(utrans(i+1,j)) .gt. eps)

          smrgt = s(i  ,j,n) - (half + dth*s(i  ,j,1)/hx) * slopex(i  ,j,n)
c    $            + dth * force(i  ,j,n)
          smlft = s(i-1,j,n) + (half - dth*s(i-1,j,1)/hx) * slopex(i-1,j,n)
c    $            + dth * force(i-1,j,n)

          smrgt = cvmgt(s(is-1,j,n),smrgt,i.eq.is .and. BCX_LO .eq. INLET)
          smlft = cvmgt(s(is-1,j,n),smlft,i.eq.is .and. BCX_LO .eq. INLET)

          if (i .eq. is .and. BCX_LO .eq. WALL) then
            if (n .eq. 1) then
              smlft = zero
              smrgt = zero
            elseif (n .eq. 2) then
              smlft = cvmgt(zero,smrgt,visc_coef.gt.zero.and.irz.eq.0)
              smrgt = cvmgt(zero,smrgt,visc_coef.gt.zero.and.irz.eq.0)
            else
              smlft = smrgt
            endif
          endif

          sminus = cvmgp(smlft,smrgt,utrans(i,j))
          savg   = half * (smlft + smrgt)
          sminus = cvmgt(sminus, savg, abs(utrans(i,j)) .gt. eps)

          st = force(i,j,n) -
     $         half * (utrans(i,j)+utrans(i+1,j))*(splus - sminus) / hx

          vbardth = dth*s(i,j,2)/hy

          s_b(j+1)= s(i,j,n) + (half-vbardth)*slopey(i,j,n) + dth*st
          s_t(j  )= s(i,j,n) - (half+vbardth)*slopey(i,j,n) + dth*st

        enddo

        if (velpred .eq. 1) then
          do j = js, je+1 
            savg = half*(s_b(j) + s_t(j))
            test = ( (s_b(j) .le. zero  .and.
     $                s_t(j) .ge. zero)  .or.
     $             (abs(s_b(j) + s_t(j)) .lt. eps) )
            sedgey(i,j,n)=cvmgp(s_b(j),s_t(j),savg)
            sedgey(i,j,n)=cvmgt(savg,sedgey(i,j,n),test)
          enddo
        else

          do j = js, je+1 
            sedgey(i,j,n)=cvmgp(s_b(j),s_t(j),vadv(i,j))
            savg = half*(s_b(j) + s_t(j))
            sedgey(i,j,n)=cvmgt(savg,sedgey(i,j,n),abs(vadv(i,j)) .lt. eps)
          enddo
        endif

        if (BCY_LO .eq. WALL) then
          if (n .eq. 2) then
            sedgey(i,js,n) = zero
          else if (n .eq. 1) then
            sedgey(i,js,n) = cvmgt(zero,s_t(js),visc_coef .gt. 0.0)
          else 
            sedgey(i,js,n) = s_t(js)
          endif
        elseif (BCY_LO .eq. INLET) then
          sedgey(i,js,n) = s(i,js-1,n)
        elseif (BCY_LO .eq. OUTLET) then
          sedgey(i,js,n) = s_t(js)
        endif

        if (BCY_HI .eq. WALL) then
          if (n .eq. 2) then
            sedgey(i,je+1,n) = zero
          else if (n .eq. 1) then
            sedgey(i,je+1,n) = cvmgt(zero,s_b(je+1),visc_coef .gt. 0.0)
          else 
            sedgey(i,je+1,n) = s_b(je+1)
          endif
        elseif (BCY_HI .eq. INLET) then
          sedgey(i,je+1,n) = s(i,je+1,n)
        elseif (BCY_HI .eq. OUTLET) then
          sedgey(i,je+1,n) = s_b(je+1)
        endif

        if (velpred .eq. 1) then
          do j = js, je+1 
            vadv(i,j) = sedgey(i,j,2)
          enddo
        endif
        endif
       enddo
      enddo

      return
      end
