/*
** (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 DIMS lo_1,lo_2,hi_1,hi_2

c *************************************************************************
c ** MKVELFLUX **
c ** Create the time-centered edge states for the velocity components
c ***************************************************************

      subroutine FORT_MKVELFLUX(s,sedgex,sedgey,slopex,slopey,uadv,vadv,
     $                          utrans,vtrans,rho,px,py,lapu,
     $                          s_l,s_r,s_b,s_t,DIMS,
     $                          dx,dt,force,visc_coef,irz,
     $                          bcx_lo,bcx_hi,bcy_lo,bcy_hi)

      implicit none

      integer DIMS

      REAL_T       s(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)
      REAL_T  sedgex(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)
      REAL_T  sedgey(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)
      REAL_T  slopex(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)
      REAL_T  slopey(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)
      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:hi_1+1,lo_2:hi_2  )
      REAL_T  vtrans(lo_1:hi_1  ,lo_2:hi_2+1)
      REAL_T     rho(lo_1-1:hi_1+1,lo_2-1:hi_2+1)
      REAL_T      px(lo_1-1:hi_1+1,lo_2-1:hi_2+1)
      REAL_T      py(lo_1-1:hi_1+1,lo_2-1:hi_2+1)
      REAL_T    lapu(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)
      REAL_T   force(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)

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

      REAL_T  dx(2)
      REAL_T  dt
      integer irz
      REAL_T  visc_coef
      integer bcx_lo, bcx_hi
      integer bcy_lo, bcy_hi

c     Local variables
      REAL_T ubardth, vbardth
      REAL_T hx, hy, dth
      REAL_T uplus,uminus,vplus,vminus,ut,vt
      REAL_T utr,vtr,savg,uavg,vavg
      REAL_T uptop,upbot,umtop,umbot,uplft,uprgt,umlft,umrgt
      REAL_T vptop,vpbot,vmtop,vmbot,vplft,vprgt,vmlft,vmrgt

      REAL_T eps

      logical ltm0,ltp0
      integer i,j,is,js,ie,je,n

      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)

      do j = js,je 
        do i = is,ie 

          vpbot = s(i,j  ,2) + (half - dth*s(i,j  ,2)/hy) * slopey(i,j,  2) 
c    $            + dth * lapu(i,j  ,2) / rho(i,j)
          vptop = s(i,j+1,2) - (half + dth*s(i,j+1,2)/hy) * slopey(i,j+1,2)
c    $            + dth * lapu(i,j+1,2) / rho(i,j+1)
          upbot = s(i,j  ,1) + (half - dth*s(i,j  ,2)/hy) * slopey(i,j  ,1)
c    $            + dth * lapu(i,  j,1) / rho(i,j)
          uptop = s(i,j+1,1) - (half + dth*s(i,j+1,2)/hy) * slopey(i,j+1,1)
c    $            + dth * lapu(i,j+1,1) / rho(i,j+1)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. INLET)
          vptop = cvmgt(s(i,je+1,2),vptop,ltp0)
          vpbot = cvmgt(s(i,je+1,2),vpbot,ltp0)
          uptop = cvmgt(s(i,je+1,1),uptop,ltp0)
          upbot = cvmgt(s(i,je+1,1),upbot,ltp0)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. WALL)
          vptop = cvmgt(zero,vptop,ltp0)
          vpbot = cvmgt(zero,vpbot,ltp0)
          uptop = cvmgt(upbot,uptop,ltp0)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. WALL  .and.  visc_coef .gt. zero)
          uptop = cvmgt(zero,uptop,ltp0)
          upbot = cvmgt(zero,upbot,ltp0)

          uplus = cvmgp(upbot,uptop,vtrans(i,j+1))
          uavg  = half * (upbot + uptop)
          uplus = cvmgt(uplus, uavg, abs(vtrans(i,j+1)) .gt. eps)

          vplus = cvmgp(vpbot,vptop,vtrans(i,j+1))
          vavg  = half * (vpbot + vptop)
          vplus = cvmgt(vplus, vavg, abs(vtrans(i,j+1)) .gt. eps)

          vmtop = s(i,j  ,2) - (half + dth*s(i,j  ,2)/hy) * slopey(i,j  ,2)
c    $            + dth * lapu(i,j  ,2) / rho(i,j)
          vmbot = s(i,j-1,2) + (half - dth*s(i,j-1,2)/hy) * slopey(i,j-1,2)
c    $            + dth * lapu(i,j-1,2) / rho(i,j-1)
          umtop = s(i,j  ,1) - (half + dth*s(i,j  ,2)/hy) * slopey(i,j  ,1)
c    $            + dth * lapu(i,j  ,1) / rho(i,j)
          umbot = s(i,j-1,1) + (half - dth*s(i,j-1,2)/hy) * slopey(i,j-1,1)
c    $            + dth * lapu(i,j-1,1) / rho(i,j-1)

          ltm0 = (j .eq. js  .and.  bcy_lo .eq. INLET)
          vmtop = cvmgt(s(i,js-1,2),vmtop,ltm0)
          vmbot = cvmgt(s(i,js-1,2),vmbot,ltm0)
          umtop = cvmgt(s(i,js-1,1),umtop,ltm0)
          umbot = cvmgt(s(i,js-1,1),umbot,ltm0)

          ltm0 = (j .eq. js .and. bcy_lo .eq. WALL)
          vmtop = cvmgt(zero ,vmtop,ltm0)
          vmbot = cvmgt(zero ,vmbot,ltm0)
          umbot = cvmgt(umtop,umbot,ltm0)

          ltm0 = (j .eq. js .and. bcy_lo .eq. WALL .and. visc_coef .gt. zero)
          umtop = cvmgt(zero,umtop,ltm0)
          umbot = cvmgt(zero,umbot,ltm0)

          uminus = cvmgp(umbot,umtop,vtrans(i,j))
          uavg   = half * (umbot + umtop)
          uminus = cvmgt(uminus, uavg, abs(vtrans(i,j)) .gt. eps)

          vminus = cvmgp(vmbot,vmtop,vtrans(i,j))
          vavg   = half * (vmbot + vmtop)
          vminus = cvmgt(vminus, vavg, abs(vtrans(i,j)) .gt. eps)

          utr = half * (vtrans(i,j)+vtrans(i,j+1))*(uplus - uminus) / hy
          vtr = half * (vtrans(i,j)+vtrans(i,j+1))*(vplus - vminus) / hy

          ut = (lapu(i,j,1)-px(i,j))/rho(i,j) - utr + force(i,j,1)
          vt = (lapu(i,j,2)-py(i,j))/rho(i,j) - vtr + force(i,j,2)

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

          s_l(i+1,1)= s(i,j,1) + (half-ubardth)*slopex(i,j,1) + dth*ut
          s_l(i+1,2)= s(i,j,2) + (half-ubardth)*slopex(i,j,2) + dth*vt

          s_r(i  ,1)= s(i,j,1) - (half+ubardth)*slopex(i,j,1) + dth*ut
          s_r(i  ,2)= s(i,j,2) - (half+ubardth)*slopex(i,j,2) + dth*vt

        enddo

        if (bcx_lo .eq. PERIODIC) then
          s_l(is  ,1) = s_l(ie+1,1)
          s_l(is  ,2) = s_l(ie+1,2)
        elseif (bcx_lo .eq. WALL) then
          s_l(is  ,1) = zero
          s_r(is  ,1) = zero
          s_l(is  ,2) = s_r(is  ,2)
        elseif (bcx_lo .eq. INLET) then
          s_l(is  ,1) = s(is-1,j,1)
          s_l(is  ,2) = s(is-1,j,2)
        elseif (bcx_lo .eq. OUTLET) then
          s_l(is  ,1) = s_r(is  ,1)
          s_l(is  ,2) = s_r(is  ,2)
        endif

        if (bcx_hi .eq. PERIODIC) then
          s_r(ie+1,1) = s_r(is  ,1)
          s_r(ie+1,2) = s_r(is  ,2)
        elseif (bcx_hi .eq. WALL) then
          s_l(ie+1,1) = zero
          s_r(ie+1,1) = zero
          s_r(ie+1,2) = s_l(ie+1,2)
        elseif (bcx_hi .eq. INLET) then
          s_r(ie+1,1) = s(ie+1,j,1)
          s_r(ie+1,2) = s(ie+1,j,2)
        elseif (bcx_hi .eq. OUTLET) then
          s_r(ie+1,1) = s_l(ie+1,1)
          s_r(ie+1,2) = s_l(ie+1,2)
        endif

        do n = 1,2
        do i = is, ie+1 
          sedgex(i,j,n)=cvmgp(s_l(i,n),s_r(i,n),uadv(i,j))
          savg = half*(s_r(i,n) + s_l(i,n))
          sedgex(i,j,n)=cvmgt(savg,sedgex(i,j,n),abs(uadv(i,j)) .lt. eps)
        enddo
        enddo

        if (bcx_lo .eq. WALL) then
          sedgex(is  ,j,1) = zero
        endif
        if (bcx_hi .eq. WALL) then
          sedgex(ie+1,j,1) = zero
        endif

        if (bcx_lo .eq. WALL .and. visc_coef .gt. 0.0 .and. irz .eq. 0) then
          sedgex(is  ,j,2) = zero
        endif
        if (bcx_hi .eq. WALL .and. visc_coef .gt. 0.0) then
          sedgex(ie+1,j,2) = zero
        endif

      enddo

c ::: loop for y fluxes

      do i = is, ie 
        do j = js, je 

          vplft = s(i  ,j,2) + (half - dth*s(i  ,j,1)/hx) * slopex(i  ,j,2)
c    $            + dth * lapu(i  ,j,2) / rho(i  ,j)
          vprgt = s(i+1,j,2) - (half + dth*s(i+1,j,1)/hx) * slopex(i+1,j,2)
c    $            + dth * lapu(i+1,j,2) / rho(i+1,j)
          uplft = s(i,j ,1 ) + (half - dth*s(i  ,j,1)/hx) * slopex(i  ,j,1)
c    $            + dth * lapu(i  ,j,1) / rho(i  ,j)
          uprgt = s(i+1,j,1) - (half + dth*s(i+1,j,1)/hx) * slopex(i+1,j,1)
c    $            + dth * lapu(i+1,j,1) / rho(i+1,j)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. INLET)
          uprgt = cvmgt(s(ie+1,j,1),uprgt,ltp0)
          uplft = cvmgt(s(ie+1,j,1),uplft,ltp0)
          vprgt = cvmgt(s(ie+1,j,2),vprgt,ltp0)
          vplft = cvmgt(s(ie+1,j,2),vplft,ltp0)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. WALL)
          uprgt = cvmgt(zero,uprgt,ltp0)
          uplft = cvmgt(zero,uplft,ltp0)
          vprgt = cvmgt(vplft,vprgt,ltp0)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. WALL  .and.  visc_coef .gt. zero)
          vprgt = cvmgt(zero,vprgt,ltp0)
          vplft = cvmgt(zero,vplft,ltp0)

          uplus = cvmgp(uplft,uprgt,utrans(i+1,j))
          uavg  = half * (uplft + uprgt)
          uplus = cvmgt(uplus, uavg, abs(utrans(i+1,j)) .gt. eps)

          vplus = cvmgp(vplft,vprgt,utrans(i+1,j))
          vavg  = half * (vplft + vprgt)
          vplus = cvmgt(vplus, vavg, abs(utrans(i+1,j)) .gt. eps)

          vmrgt = s(i  ,j,2) - (half + dth*s(i  ,j,1)/hx) * slopex(i  ,j,2)
c    $            + dth * lapu(i  ,j,2) / rho(i  ,j)
          vmlft = s(i-1,j,2) + (half - dth*s(i-1,j,1)/hx) * slopex(i-1,j,2)
c    $            + dth * lapu(i-1,j,2) / rho(i-1,j)
          umrgt = s(i  ,j,1) - (half + dth*s(i  ,j,1)/hx) * slopex(i  ,j,1)
c    $            + dth * lapu(i  ,j,1) / rho(i  ,j)
          umlft = s(i-1,j,1) + (half - dth*s(i-1,j,1)/hx) * slopex(i-1,j,1)
c    $            + dth * lapu(i-1,j,1) / rho(i-1,j)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. INLET)
          umrgt = cvmgt(s(is-1,j,1),umrgt,ltm0)
          umlft = cvmgt(s(is-1,j,1),umlft,ltm0)
          vmrgt = cvmgt(s(is-1,j,2),vmrgt,ltm0)
          vmlft = cvmgt(s(is-1,j,2),vmlft,ltm0)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. WALL)
          umrgt = cvmgt(zero ,umrgt,ltm0)
          umlft = cvmgt(zero ,umlft,ltm0)
          vmlft = cvmgt(vmrgt,vmlft,ltm0)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. WALL  .and.  
     $            visc_coef .gt. zero .and. irz .eq. 0)
          vmrgt = cvmgt(zero,vmrgt,ltm0)
          vmlft = cvmgt(zero,vmlft,ltm0)

          uminus = cvmgp(umlft,umrgt,utrans(i,j))
          uavg   = half * (umlft + umrgt)
          uminus = cvmgt(uminus, uavg, abs(utrans(i,j)) .gt. eps)

          vminus = cvmgp(vmlft,vmrgt,utrans(i,j))
          vavg   = half * (vmlft + vmrgt)
          vminus = cvmgt(vminus, vavg, abs(utrans(i,j)) .gt. eps)

          utr = half * (utrans(i,j)+utrans(i+1,j))*(uplus - uminus) / hx
          vtr = half * (utrans(i,j)+utrans(i+1,j))*(vplus - vminus) / hx

          ut = (lapu(i,j,1)-px(i,j))/rho(i,j) - utr + force(i,j,1)
          vt = (lapu(i,j,2)-py(i,j))/rho(i,j) - vtr + force(i,j,2)

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

          s_b(j+1,1)= s(i,j,1) + (half-vbardth)*slopey(i,j,1) + dth*ut
          s_t(j  ,1)= s(i,j,1) - (half+vbardth)*slopey(i,j,1) + dth*ut
          s_b(j+1,2)= s(i,j,2) + (half-vbardth)*slopey(i,j,2) + dth*vt
          s_t(j  ,2)= s(i,j,2) - (half+vbardth)*slopey(i,j,2) + dth*vt

        enddo

        if (bcy_lo .eq. PERIODIC) then
          s_b(js  ,1) = s_b(je+1,1)
          s_b(js  ,2) = s_b(je+1,2)
        elseif (bcy_lo .eq. WALL) then
          s_b(js  ,1) = s_t(js  ,1)
          s_b(js  ,2) = zero
          s_t(js  ,2) = zero
        elseif (bcy_lo .eq. INLET) then
          s_b(js  ,1) = s(i,js-1,1)
          s_b(js  ,2) = s(i,js-1,2)
        elseif (bcy_lo .eq. OUTLET) then
          s_b(js  ,1) = s_t(js  ,1)
          s_b(js  ,2) = s_t(js  ,2)
        endif

        if (bcy_hi .eq. PERIODIC) then
          s_t(je+1,1) = s_t(js  ,1)
          s_t(je+1,2) = s_t(js  ,2)
        elseif (bcy_hi .eq. WALL) then
          s_t(je+1,1) = s_b(je+1,1)
          s_b(je+1,2) = zero
          s_t(je+1,2) = zero
        elseif (bcy_hi .eq. INLET) then
          s_t(je+1,1) = s(i,je+1,1)
          s_t(je+1,2) = s(i,je+1,2)
        elseif (bcy_hi .eq. OUTLET) then
          s_t(je+1,1) = s_b(je+1,1)
          s_t(je+1,2) = s_b(je+1,2)
        endif

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

        if ((visc_coef .gt. zero)  .and.  (bcy_lo .eq. WALL)) then
          sedgey(i,js  ,1) = zero
          sedgey(i,js  ,2) = zero
        endif
        if ((visc_coef .gt. zero)  .and.  (bcy_hi .eq. WALL)) then
          sedgey(i,je+1,1) = zero
          sedgey(i,je+1,2) = zero
        endif

      enddo

      return
      end
