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

#define DIMS lo_1,lo_2,hi_1,hi_2

c *************************************************************************
c ** CMPDT **
c ** Compute the new time step
c ********************************************************************

      subroutine FORT_CMPDT(u,rho,gp,force,dx,dtold,dt,cflfac,DIMS)

      implicit none

      integer DIMS
      REAL_T     u(lo_1-3:hi_1+3,lo_2-3:hi_2+3,2)
      REAL_T   rho(lo_1-3:hi_1+3,lo_2-3:hi_2+3)
      REAL_T    gp(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 dx(2)
      REAL_T dt, dtold
      REAL_T cflfac

c     Local variables
      REAL_T spdx,spdy
      REAL_T pforcex,pforcey
      REAL_T dtchange
      integer i, j

      REAL_T eps
      
      dtchange = 1.1d0
      eps = 1.0e-8

      spdx  = zero
      spdy  = zero
      pforcex = zero
      pforcey = zero

      do j = lo_2, hi_2
        do i = lo_1, hi_1
          spdx    = max(spdx ,abs(u(i,j,1))/dx(1))
          spdy    = max(spdy ,abs(u(i,j,2))/dx(2))
          pforcex = max(pforcex,abs(gp(i,j,1)/rho(i,j)-force(i,j,1)))
          pforcey = max(pforcey,abs(gp(i,j,2)/rho(i,j)-force(i,j,2)))
        enddo
      enddo

      if (spdx.lt.eps .and. spdy.lt.eps) then

        dt = min(dx(1),dx(2))

      else

        dt = one / max(spdx,spdy)

      endif

      if (pforcex .gt. eps) then
        dt = min(dt,sqrt(two*dx(1)/pforcex))
      endif

      if (pforcey .gt. eps) then
        dt = min(dt,sqrt(two*dx(2)/pforcey))
      endif

      dt = dt * cflfac

      if (dtold .gt. zero) dt = min(dt,dtchange*dtold)

      return
      end
