/*
** (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: EXACT_3D.F,v 1.3 1999/03/25 23:37:42 sstanley 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 "PROB_AMR_F.H"
#include "ArrayLim.H"
#include "EXACT_F.H"

#define SDIM 3
c
c ::: -----------------------------------------------------------
c ::: This case is an unsteady  viscous benchmark for which the 
c ::: exact solution is,
c :::     u(x,y,t) = - Cos(Pi x) Sin(Pi y) Exp(-2 Pi^2 Nu t)
c :::     v(x,y,t) =   Sin(Pi x) Cos(Pi y) Exp(-2 Pi^2 Nu t)
c :::     p(x,y,t) = - {Cos(2 Pi x) + Cos(2 Pi y)} Exp(-4 Pi^2 Nu t) / 4
c ::: In this dircetory, ViscBench3d.cpp, reads a plot file and compares
c ::: the solution against this exact solution.  This benchmark was
c ::: originally derived by G.I. Taylor (Phil. Mag., Vol. 46, No. 274, 
c ::: pp. 671-674, 1923) and Ethier and Steinman
c ::: (Intl. J. Num. Meth. Fluids, Vol. 19, pp. 369-375, 1994) give
c ::: the pressure field.
c
      subroutine FORT_VISCBENCH(time, nu, unifdir, lo, hi, 
     &                          ncomp, state, DIMS(state),
     &                          dx, xlo, xhi)

      implicit none

      integer    ncomp, unifdir
      integer    lo(SDIM), hi(SDIM)
      integer    DIMDEC(state)
      REAL_T     time, nu, dx(SDIM)
      REAL_T     xlo(SDIM), xhi(SDIM)
      REAL_T     state(DIMV(state),ncomp)
c
c     ::::: local variables
c
      integer i, j, k, n
      REAL_T  x, y, z
      REAL_T  hx, hy, hz
      REAL_T  spx, spy, spz, cpx, cpy, cpz
      REAL_T expterm

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

      expterm = exp(-two*Pi**2*nu*time)

      do k = lo(3), hi(3)
        z = xlo(3) + hz*(float(k-lo(3)) + half)
        spz = sin(Pi*z)
        cpz = cos(Pi*z)

        do j = lo(2), hi(2)
          y = xlo(2) + hy*(float(j-lo(2)) + half)
          spy = sin(Pi*y)
          cpy = cos(Pi*y)

          do i = lo(1), hi(1)
            x = xlo(1) + hx*(float(i-lo(1)) + half)

            spx = sin(Pi*x)
            cpx = cos(Pi*x)

c
c           Uniform in the X-direction
c
            if (unifdir .eq. 0) then
              state(i,j,k,1) =   zero
              state(i,j,k,2) =   spz*cpy * expterm
              state(i,j,k,3) = - cpz*spy * expterm
              state(i,j,k,4) =   one
              do n = 5, ncomp
                state(i,j,k,n) =   cpz*cpy * expterm
              enddo

c
c           Uniform in the Y-direction
c
            elseif (unifdir .eq. 1) then
              state(i,j,k,1) = - cpx*spz * expterm
              state(i,j,k,2) =   zero
              state(i,j,k,3) =   spx*cpz * expterm
              state(i,j,k,4) =   one
              do n = 5, ncomp
                state(i,j,k,n) =   cpx*cpz * expterm
              enddo

c
c           Uniform in the Z-direction
c
            elseif (unifdir .eq. 2) then
              state(i,j,k,1) = - cpx*spy * expterm
              state(i,j,k,2) =   spx*cpy * expterm
              state(i,j,k,3) =   zero
              state(i,j,k,4) =   one
              do n = 5, ncomp
                state(i,j,k,n) =   cpx*cpy * expterm
              enddo
            endif
          end do
        end do
      end do

      end

