      subroutine dqawfe(f,a,omega,integr,epsabs,limlst,limit,maxp1,
     *   result,abserr,neval,ier,rslst,erlst,ierlst,lst,alist,blist,
     *   rlist,elist,iord,nnlog,chebmo)
c***begin prologue  dqawfe
c***date written   800101   (yymmdd)
c***revision date  830518   (yymmdd)
c***category no.  h2a3a1
c***keywords  automatic integrator, special-purpose,
c             fourier integrals,
c             integration between zeros with dqawoe,
c             convergence acceleration with dqelg
c***author  piessens,robert,appl. math. & progr. div. - k.u.leuven
c           dedoncker,elise,appl. math. & progr. div. - k.u.leuven
c***purpose  the routine calculates an approximation result to a
c            given fourier integal
c            i = integral of f(x)*w(x) over (a,infinity)
c            where w(x)=cos(omega*x) or w(x)=sin(omega*x),
c            hopefully satisfying following claim for accuracy
c            abs(i-result).le.epsabs.
c***description
c
c        computation of fourier integrals
c        standard fortran subroutine
c        double precision version
c
c        parameters
c         on entry
c            f      - double precision
c                     function subprogram defining the integrand
c                     function f(x). the actual name for f needs to
c                     be declared e x t e r n a l in the driver program.
c
c            a      - double precision
c                     lower limit of integration
c
c            omega  - double precision
c                     parameter in the weight function
c
c            integr - integer
c                     indicates which weight function is used
c                     integr = 1      w(x) = cos(omega*x)
c                     integr = 2      w(x) = sin(omega*x)
c                     if integr.ne.1.and.integr.ne.2, the routine will
c                     end with ier = 6.
c
c            epsabs - double precision
c                     absolute accuracy requested, epsabs.gt.0
c                     if epsabs.le.0, the routine will end with ier = 6.
c
c            limlst - integer
c                     limlst gives an upper bound on the number of
c                     cycles, limlst.ge.1.
c                     if limlst.lt.3, the routine will end with ier = 6.
c
c            limit  - integer
c                     gives an upper bound on the number of subintervals
c                     allowed in the partition of each cycle, limit.ge.1
c                     each cycle, limit.ge.1.
c
c            maxp1  - integer
c                     gives an upper bound on the number of
c                     chebyshev moments which can be stored, i.e.
c                     for the intervals of lengths abs(b-a)*2**(-l),
c                     l=0,1, ..., maxp1-2, maxp1.ge.1
c
c         on return
c            result - double precision
c                     approximation to the integral x
c
c            abserr - double precision
c                     estimate of the modulus of the absolute error,
c                     which should equal or exceed abs(i-result)
c
c            neval  - integer
c                     number of integrand evaluations
c
c            ier    - ier = 0 normal and reliable termination of
c                             the routine. it is assumed that the
c                             requested accuracy has been achieved.
c                     ier.gt.0 abnormal termination of the routine. the
c                             estimates for integral and error are less
c                             reliable. it is assumed that the requested
c                             accuracy has not been achieved.
c            error messages
c                    if omega.ne.0
c                     ier = 1 maximum number of  cycles  allowed
c                             has been achieved., i.e. of subintervals
c                             (a+(k-1)c,a+kc) where
c                             c = (2*int(abs(omega))+1)*pi/abs(omega),
c                             for k = 1, 2, ..., lst.
c                             one can allow more cycles by increasing
c                             the value of limlst (and taking the
c                             according dimension adjustments into
c                             account).
c                             examine the array iwork which contains
c                             the error flags on the cycles, in order to
c                             look for eventual local integration
c                             difficulties. if the position of a local
c                             difficulty can be determined (e.g.
c                             singularity, discontinuity within the
c                             interval) one will probably gain from
c                             splitting up the interval at this point
c                             and calling appropriate integrators on
c                             the subranges.
c                         = 4 the extrapolation table constructed for
c                             convergence acceleration of the series
c                             formed by the integral contributions over
c                             the cycles, does not converge to within
c                             the requested accuracy. as in the case of
c                             ier = 1, it is advised to examine the
c                             array iwork which contains the error
c                             flags on the cycles.
c                         = 6 the input is invalid because
c                             (integr.ne.1 and integr.ne.2) or
c                              epsabs.le.0 or limlst.lt.3.
c                              result, abserr, neval, lst are set
c                              to zero.
c                         = 7 bad integrand behaviour occurs within one
c                             or more of the cycles. location and type
c                             of the difficulty involved can be
c                             determined from the vector ierlst. here
c                             lst is the number of cycles actually
c                             needed (see below).
c                             ierlst(k) = 1 the maximum number of
c                                           subdivisions (= limit) has
c                                           been achieved on the k th
c                                           cycle.
c                                       = 2 occurrence of roundoff error
c                                           is detected and prevents the
c                                           tolerance imposed on the
c                                           k th cycle, from being
c                                           achieved.
c                                       = 3 extremely bad integrand
c                                           behaviour occurs at some
c                                           points of the k th cycle.
c                                       = 4 the integration procedure
c                                           over the k th cycle does
c                                           not converge (to within the
c                                           required accuracy) due to
c                                           roundoff in the
c                                           extrapolation procedure
c                                           invoked on this cycle. it
c                                           is assumed that the result
c                                           on this interval is the
c                                           best which can be obtained.
c                                       = 5 the integral over the k th
c                                           cycle is probably divergent
c                                           or slowly convergent. it
c                                           must be noted that
c                                           divergence can occur with
c                                           any other value of
c                                           ierlst(k).
c                    if omega = 0 and integr = 1,
c                    the integral is calculated by means of dqagie
c                    and ier = ierlst(1) (with meaning as described
c                    for ierlst(k), k = 1).
c
c            rslst  - double precision
c                     vector of dimension at least limlst
c                     rslst(k) contains the integral contribution
c                     over the interval (a+(k-1)c,a+kc) where
c                     c = (2*int(abs(omega))+1)*pi/abs(omega),
c                     k = 1, 2, ..., lst.
c                     note that, if omega = 0, rslst(1) contains
c                     the value of the integral over (a,infinity).
c
c            erlst  - double precision
c                     vector of dimension at least limlst
c                     erlst(k) contains the error estimate corresponding
c                     with rslst(k).
c
c            ierlst - integer
c                     vector of dimension at least limlst
c                     ierlst(k) contains the error flag corresponding
c                     with rslst(k). for the meaning of the local error
c                     flags see description of output parameter ier.
c
c            lst    - integer
c                     number of subintervals needed for the integration
c                     if omega = 0 then lst is set to 1.
c
c            alist, blist, rlist, elist - double precision
c                     vector of dimension at least limit,
c
c            iord, nnlog - integer
c                     vector of dimension at least limit, providing
c                     space for the quantities needed in the subdivision
c                     process of each cycle
c
c            chebmo - double precision
c                     array of dimension at least (maxp1,25), providing
c                     space for the chebyshev moments needed within the
c                     cycles
c
c***references  (none)
c***routines called  d1mach,dqagie,dqawoe,dqelg
c***end prologue  dqawfe
c
      double precision a,abseps,abserr,alist,blist,chebmo,correc,cycle,
     *  c1,c2,dabs,dl,dla,dmax1,drl,d1mach,elist,erlst,ep,eps,epsa,
     *  epsabs,errsum,f,fact,omega,p,pi,p1,psum,reseps,result,res3la,
     *  rlist,rslst,uflow
      integer ier,ierlst,integr,iord,ktmin,l,last,lst,limit,limlst,ll,
     *    maxp1,momcom,nev,neval,nnlog,nres,numrl2
c
      dimension alist(limit),blist(limit),chebmo(maxp1,25),elist(limit),
     *  erlst(limlst),ierlst(limlst),iord(limit),nnlog(limit),psum(52),
     *  res3la(3),rlist(limit),rslst(limlst)
c
      external f
c
c
c            the dimension of  psum  is determined by the value of
c            limexp in subroutine dqelg (psum must be of dimension
c            (limexp+2) at least).
c
c           list of major variables
c           -----------------------
c
c           c1, c2    - end points of subinterval (of length cycle)
c           cycle     - (2*int(abs(omega))+1)*pi/abs(omega)
c           psum      - vector of dimension at least (limexp+2)
c                       (see routine dqelg)
c                       psum contains the part of the epsilon table
c                       which is still needed for further computations.
c                       each element of psum is a partial sum of the
c                       series which should sum to the value of the
c                       integral.
c           errsum    - sum of error estimates over the subintervals,
c                       calculated cumulatively
c           epsa      - absolute tolerance requested over current
c                       subinterval
c           chebmo    - array containing the modified chebyshev
c                       moments (see also routine dqc25f)
c
      data p/0.9d+00/
      data pi / 3.14159265358979323846264338327950d0 /
c
c           test on validity of parameters
c           ------------------------------
c
c***first executable statement  dqawfe
      result = 0.0d+00
      abserr = 0.0d+00
      neval = 0
      lst = 0
      ier = 0
      if((integr.ne.1.and.integr.ne.2).or.epsabs.le.0.0d+00.or.
     *  limlst.lt.3) ier = 6
      if(ier.eq.6) go to 999
      if(omega.ne.0.0d+00) go to 10
c
c           integration by dqagie if omega is zero
c           --------------------------------------
c
      if(integr.eq.1) call dqagie(f,0.0d+00,1,epsabs,0.0d+00,limit,
     *  result,abserr,neval,ier,alist,blist,rlist,elist,iord,last)
      rslst(1) = result
      erlst(1) = abserr
      ierlst(1) = ier
      lst = 1
      go to 999
c
c           initializations
c           ---------------
c
   10 l = dabs(omega)
      dl = 2*l+1
      cycle = dl*pi/dabs(omega)
      ier = 0
      ktmin = 0
      neval = 0
      numrl2 = 0
      nres = 0
      c1 = a
      c2 = cycle+a
      p1 = 0.1d+01-p
      uflow = d1mach(1)
      eps = epsabs
      if(epsabs.gt.uflow/p1) eps = epsabs*p1
      ep = eps
      fact = 0.1d+01
      correc = 0.0d+00
      abserr = 0.0d+00
      errsum = 0.0d+00
c
c           main do-loop
c           ------------
c
      do 50 lst = 1,limlst
c
c           integrate over current subinterval.
c
        dla = lst
        epsa = eps*fact
        call dqawoe(f,c1,c2,omega,integr,epsa,0.0d+00,limit,lst,maxp1,
     *  rslst(lst),erlst(lst),nev,ierlst(lst),last,alist,blist,rlist,
     *  elist,iord,nnlog,momcom,chebmo)
        neval = neval+nev
        fact = fact*p
        errsum = errsum+erlst(lst)
        drl = 0.5d+02*dabs(rslst(lst))
c
c           test on accuracy with partial sum
c
        if((errsum+drl).le.epsabs.and.lst.ge.6) go to 80
        correc = dmax1(correc,erlst(lst))
        if(ierlst(lst).ne.0) eps = dmax1(ep,correc*p1)
        if(ierlst(lst).ne.0) ier = 7
        if(ier.eq.7.and.(errsum+drl).le.correc*0.1d+02.and.
     *  lst.gt.5) go to 80
        numrl2 = numrl2+1
        if(lst.gt.1) go to 20
        psum(1) = rslst(1)
        go to 40
   20   psum(numrl2) = psum(ll)+rslst(lst)
        if(lst.eq.2) go to 40
c
c           test on maximum number of subintervals
c
        if(lst.eq.limlst) ier = 1
c
c           perform new extrapolation
c
        call dqelg(numrl2,psum,reseps,abseps,res3la,nres)
c
c           test whether extrapolated result is influenced by roundoff
c
        ktmin = ktmin+1
        if(ktmin.ge.15.and.abserr.le.0.1d-02*(errsum+drl)) ier = 4
        if(abseps.gt.abserr.and.lst.ne.3) go to 30
        abserr = abseps
        result = reseps
        ktmin = 0
c
c           if ier is not 0, check whether direct result (partial sum)
c           or extrapolated result yields the best integral
c           approximation
c
        if((abserr+0.1d+02*correc).le.epsabs.or.
     *  (abserr.le.epsabs.and.0.1d+02*correc.ge.epsabs)) go to 60
   30   if(ier.ne.0.and.ier.ne.7) go to 60
   40   ll = numrl2
        c1 = c2
        c2 = c2+cycle
   50 continue
c
c         set final result and error estimate
c         -----------------------------------
c
   60 abserr = abserr+0.1d+02*correc
      if(ier.eq.0) go to 999
      if(result.ne.0.0d+00.and.psum(numrl2).ne.0.0d+00) go to 70
      if(abserr.gt.errsum) go to 80
      if(psum(numrl2).eq.0.0d+00) go to 999
   70 if(abserr/dabs(result).gt.(errsum+drl)/dabs(psum(numrl2)))
     *  go to 80
      if(ier.ge.1.and.ier.ne.7) abserr = abserr+drl
      go to 999
   80 result = psum(numrl2)
      abserr = errsum+drl
  999 return
      end


      subroutine delt
c
c     *****************************************************************
c     *                                                               *
c     *   calculates the boundary layer thickness                     *
c     *                                                               *
c     *****************************************************************
c
      use dims
c
c     ******************************************************************
c
      use flo_var
      use mesh_var
      use solv_var
c
c     ******************************************************************
c
      use flo_param
      use solv_param
c
c     ******************************************************************
c
      real, dimension(je)               :: qs,dn,ut
c
c     ******************************************************************
c
      logical locke
c
c     ******************************************************************
c
c     js        = 2*jl/3  -2
      js        = .75*(ny  -4)

      do 20 i=2,il

      qs(1)     = 0.
      ut(1)     = 0.
      j         = js
      xy        = .5*(x(i,j,1)  -x(i,j-1,1)
     .               +x(i-1,j,1)  -x(i-1,j-1,1))
      yy        = .5*(x(i,j,2)  -x(i,j-1,2)
     .               +x(i-1,j,2)  -x(i-1,j-1,2))
      qs(j)     = (yy*w(i,j,2)  -xy*w(i,j,3))/(w(i,j,1))
      si        = sign(1.,qs(js))

      do j=2,js
         xy        = .5*(x(i,j,1)  -x(i,j-1,1)
     .                  +x(i-1,j,1)  -x(i-1,j-1,1))
         yy        = .5*(x(i,j,2)  -x(i,j-1,2)
     .                  +x(i-1,j,2)  -x(i-1,j-1,2))
         dsi       = 1./sqrt(xy**2  +yy**2)
         qs(j)     = si*(yy*w(i,j,2)  -xy*w(i,j,3))
         dn(j)     = 1./dsi
         ut(j)     = qs(j)*dsi
      end do

      dsti(i)   = 0.
      ynot(i)   = 0.
      ssmax(i)  = 0.
      cdu       = .98
      jmax      = idmax(js,ut,1)
      fx        = .6*ut(jmax)
      lend      = 2
      lbig      = 2
      locke     = .false.

      do  j=3,js
         if ( ut(j-1) .lt. 0. .and. ut(j) .ge. .0) then
            lbig      = j
         end if
         if (.not. locke) then
            if ( ut(j-1) .ge. cdu*ut(j) .and. ut(j) .gt. fx) then
               locke     = .true.
               lend      = j
            end if
         end if
      end do

      uinf      = 1./ut(lend)
      do j=lbig,lend
         dsti (i)  = dsti(i) + (ut(lend)*dn(j) - qs(j))
         ra        = w(i,lend,1)/w(i,j,1)
         ssmax(i)  = ssmax(i) + ra*ut(j)*uinf*(dn(j)-qs(j)*uinf)
      end do

      dsti(i)   = dsti(i)*uinf
      dsti (i)  = max(dsti(i),1.e-6)
      ra        = w(i,lend,1)/w(i,2,1)
      ssmax(i)  = max(ssmax(i),ra*qs(2)*uinf)
      fc        = .95*ut(lend)

      jse       = lend
      do j=2,jse
         lend      = j  -1
         if (ut(j).gt.fc) go to 11
      end do

   11 xbi       = .5*(x(i,1,1)+x(i-1,1,1))
      ybi       = .5*(x(i,1,2)+x(i-1,1,2))
      ycorr     = sqrt((xc(i,lend,1) - xbi)**2+(xc(i,lend,2)-ybi)**2)
      ynot(i)   = 1.5*(ycorr  +dn(lend)*
     .                (fc  -ut(lend))/(ut(lend+1)  -ut(lend)))

   20 continue

      return

      end


!> \file radcons.f90
!! This file contains module radcons.

!> \defgroup radcons GFS RRTMG Constants Module
!> This module contains some of the most frequently used math and physics
!! constants for RRTMG.

!> This module contains some of the most frequently used math and physics
!! constants for RRTMG.
          module radcons
!
  use machine,      only : kind_phys
!
  implicit none
!
  public

!  ---  version tag and last revision date
      character(40), parameter ::                                       &
     &   VTAGRAD='NCEP-Radiation_driver    v5.2  Jan 2013 '
!    &   VTAGRAD='NCEP-Radiation_driver    v5.1  Nov 2012 '
!    &   VTAGRAD='NCEP-Radiation_driver    v5.0  Aug 2012 '

!>\name Constant values
      real (kind=kind_phys) :: QMIN                     !< lower limit of saturation vapor pressure (=1.0e-10)
      real (kind=kind_phys) :: QME5                     !< lower limit of specific humidity (=1.0e-7)
      real (kind=kind_phys) :: QME6                     !< lower limit of specific humidity (=1.0e-7)
!> EPSQ=1.0e-12
      real (kind=kind_phys) :: EPSQ
!     parameter (QMIN=1.0e-10, QME5=1.0e-5,  QME6=1.0e-6,  EPSQ=1.0e-12)
      parameter (QMIN=1.0e-10, QME5=1.0e-7,  QME6=1.0e-7,  EPSQ=1.0e-12)
!     parameter (QMIN=1.0e-10, QME5=1.0e-20, QME6=1.0e-20, EPSQ=1.0e-12)

!> lower limit of toa pressure value in mb
      real, parameter :: prsmin = 1.0e-6

!> control flag for LW surface temperature at air/ground interface
!! (default=0, the value will be set in subroutine radinit)
      integer :: itsfc  =0

!> new data input control variables (set/reset in subroutines radinit/radupdate):
      integer :: month0=0,   iyear0=0,   monthd=0

!> control flag for the first time of reading climatological ozone data
!! (set/reset in subroutines radinit/radupdate, it is used only if the
!! control parameter ioznflg=0)
      logical :: loz1st =.true.

! DH* THIS MUST GO BUT NEED IT RIGHT NOW TO DEFINE LEXTOP
!> optional extra top layer on top of low ceiling models
!!\n LTP=0: no extra top layer
      integer, parameter :: LTP = 0   ! no extra top layer
!     integer, parameter :: LTP = 1   ! add an extra top layer
! *DH

!> control flag for extra top layer
      logical, parameter :: lextop = (LTP > 0)

!----------------------------
! Module variable definitions
!----------------------------
!CCPP: copy from GFS_driver.F90
  real(kind=kind_phys), parameter :: con_24  =   24.0_kind_phys
  real(kind=kind_phys), parameter :: con_hr  = 3600.0_kind_phys
  real(kind=kind_phys), parameter :: con_99  =   99.0_kind_phys
  real(kind=kind_phys), parameter :: con_100 =  100.0_kind_phys
 ! real(kind=kind_phys), parameter :: qmin    =    1.0e-10

!........................................!
      end module radcons                !
!========================================!


module verlet_integrator_mod
  use object_space_mod
  implicit none

contains

  subroutine run_verlet_integration(list, siz, timescale, lenght, everyNth, output_file)
    implicit none
    integer, intent(in) :: siz, lenght, everyNth
    real, intent(in) :: timescale
    type(object_space), intent(inout) :: list(siz)
    character(LEN=100), intent(in) :: output_file
    integer :: i, step, ios

!Opening the file for output
    open(unit=1, file=output_file, status='replace')

!write the amount of objects in simulation and the amount of frames
    write(1,*) siz
    write(1,*) (lenght / everyNth)

!calculate all initial accelerations for the objects
    do i = 1, siz
      call total_acceleration(i, siz, list)
    end do

    do step = 1, lenght
      !do the first step for all objects
      do i = 1, siz
        call verlet_integration_first(i, siz, list, timescale)
      end do

      !Second step for all objects
      do i = 1, siz
        call verlet_integration_second(i, siz, list, timescale)
      end do

      !Third step for all objects. Identical to function total acceleration
      do i = 1, siz
        call total_acceleration(i, siz, list)
      end do
      !Fourth step for all objects
      do i = 1, siz
        call verlet_integration_fourth(i, siz, list, timescale)
      end do

      if (MOD(step, everyNth) == 1) then
        do i = 1, siz
          write (1,*) list(i)%pos(1)
          write (1,*) list(i)%pos(2)
          write (1,*) list(i)%pos(3)
        end do
      end if
    end do

!Closing the file
    close(unit=1, status='keep')

  end subroutine

!Subroutine for one iteration of verlet_integration for one object the first phase. siz is the amount of objects in list
  subroutine verlet_integration_first(object, siz, list, timescale)
    implicit none
    integer, intent(in) :: siz, object
    real, intent(in) :: timescale
    type(object_space), intent(inout) :: list(siz)
    integer :: i

!Do the first step v(t + 0.5*dt) = v(y) + .5a(t)*dt for one object
    do i = 1, 3
      list(object)%vel(i) = list(object)%vel(i)+0.5*list(object)%acc(i)*timescale
    end do
  end subroutine verlet_integration_first

!Subroutine for one iteration of verlet integration for one object for the second phase of the integrator.
  subroutine verlet_integration_second(object, siz, list, timescale)
    implicit none
    integer, intent(in) :: object, siz
    type(object_space), intent(inout) :: list(siz)
    real, intent(in) :: timescale
    integer :: i

!Do the second step x(t + dt) = x(t) + v(t + 0.5*dt)*dt
    do i = 1, 3
      list(object)%pos(i) = list(object)%pos(i)+list(object)%vel(i)*timescale
    end do

  end subroutine
!the fourth phase of verlet integration. Calculating the final velocity for the next phase
  subroutine verlet_integration_fourth(object, siz, list, timescale)
    implicit none
    integer, intent(in) :: object, siz
    type(object_space), intent(inout) :: list(siz)
    real, intent(in) :: timescale
    integer :: i
    real :: acc(3)

!Calculate the v(t + dt) = v(t + 0.5*dt) + 0.5*a(t + dt)*timescale
    do i = 1, 3
      list(object)%vel(i)=list(object)%vel(i)+0.5*list(object)%acc(i)*timescale
    end do

  end subroutine

end module verlet_integrator_mod


module mms_geom
   use precision, only: WP

   interface cube_refine
      module procedure cube_refine_vol              ! compute volume and area
      module procedure cube_refine_vfunc_afunc_fd   ! compute volume and area integrals - finite difference
      module procedure cube_refine_afunc_fd         ! compute area integrals - finite difference
   end interface cube_refine
   interface rec_refine
      module procedure rec_refine_area      ! compute area
      module procedure rec_refine_afunc_fd  ! compute area integral - finite difference
   end interface rec_refine

   real(WP), parameter :: r16=1.0_WP/6.0_WP
   real(WP), parameter :: r13=1.0_WP/3.0_WP

   ! ==== A triangle :
   !
   !    - vertex labels (vx), edge labels (ex) and contribution to case number [1,2,4]
   !
   !              v1  -  +1
   !             /  \
   !            /    \
   !           e3     e1
   !          /        \
   !         /          \
   !  +4 - v3-----e2-----v2  - +2
   !
   ! =====

   ! ==== lookup table for edge to vertices
   integer, parameter, dimension(2,3) :: tri_edge_to_vertex=reshape([1,2,2,3,1,3],shape(tri_edge_to_vertex))

   !==== lookup table for case to intersected edges :
   !     0 is a sentinel value indicating no more edges
   !     ordering of the edges important for area calculations
   integer, parameter, dimension(2,0:7) :: tri_case_to_edge=reshape([0,0,1,3,1,2,3,2,2,3,1,2,1,3,0,0],shape(tri_case_to_edge))

   !==== lookup table for case to vertices with G > 0 :
   !     0 is a sentinel value
   !     ordering is important for decomposing quads into tris
   integer, parameter, dimension(2,0:7) :: tri_case_to_vertex=reshape([0,0,1,0,2,0,1,2,3,0,1,3,2,3,0,0],shape(tri_case_to_vertex))
   !==== number of vertices with G > 0 (non-zero entries above) per case
   integer, parameter, dimension(0:7) :: tri_nverts=[0,1,1,2,1,2,2,3]

   type tri
      real(WP), dimension(3,3) :: vertex
      real(WP), dimension(3) :: G
      ! triangle area
      real(WP) :: area
      ! intersection points (1 tuple per edge)
      real(WP), dimension(3,3) :: intp
      ! intersected area with G > 0
      real(WP) :: A_intersect
      ! centroid of intersected area
      real(WP), dimension(3) :: C_intersect
      ! centroid of triangle
      real(WP), dimension(3) :: T_centroid
      integer :: case
   end type tri

   !==== A Rectangle *** lookup table based on this vertex ordering ***
   !
   !       vertices
   !
   !      3---------4
   !      |         |
   !      |         |
   !      |         |
   !      1---------2
   !
   !=====

   !===== lookup table for rec vertices to tri vertices
   integer, parameter, dimension(3,2) :: rec_to_tri=reshape([1,4,2,1,4,3],shape(rec_to_tri))

   !==== A Tetrahedron:
   !
   !      -vertex labels (vx), edge labels (ex) and contribution to case number [1,2,4,8]
   !
   !              v1  - +1
   !             /|\
   !            / | \
   !           e4 |  e1
   !          /   e5  \
   !         /    |    \
   !  +8 - v4--e6-|-----v2  - +2
   !         \    |    /
   !          \   |   /
   !           e3 |  e2
   !            \ | /
   !             \|/
   !              v3 - + 4
   !======

   ! ==== lookup table for edge to vertices
   integer, parameter, dimension(2,6) :: edge_to_vertex=reshape([1,2,2,3,3,4,1,4,1,3,2,4],shape(edge_to_vertex))

   !==== lookup table for case to intersected edges :
   !     0 is a sentinel value indicating no more edges
   !     ordering of the edges for each case are important for area/volume calcs
   integer, parameter, dimension(4,0:15) :: case_to_edge=reshape([0,0,0,0, &                     ! case 0
   &                                                              1,4,5,0, &                     ! case 1
   &                                                              1,2,6,0, &                     ! case 2
   &                                                              2,6,5,4, &                     ! case 3
   &                                                              2,5,3,0, &                     ! case 4
   &                                                              3,2,4,1, &                     ! case 5
   &                                                              6,1,3,5, &                     ! case 6
   &                                                              6,4,3,0, &                     ! case 7
   &                                                              3,4,6,0, &                     ! case 8
   &                                                              5,1,3,6, &                     ! case 9
   &                                                              1,2,4,3, &                     ! case 10
   &                                                              2,3,5,0, &                     ! case 11
   &                                                              2,5,6,4, &                     ! case 12
   &                                                              2,1,6,0, &                     ! case 13
   &                                                              1,5,4,0, &                     ! case 14
   &                                                              0,0,0,0],shape(case_to_edge))  ! case 15

   !==== number of intersected edges (non-zero entries above) per case
   integer, parameter, dimension(0:15) :: nedges=[0,3,3,4,3,4,4,3,3,4,4,3,4,3,3,0]

   !==== lookup table for case to vertices with G > 0 :
   !     0 is a sentinel value
   !     ordering is important for decomposing polyhedra into tets
   integer, parameter, dimension(4,0:15) :: case_to_vertex=reshape([0,0,0,0, &                       ! case 0
   &                                                                1,0,0,0, &                       ! case 1
   &                                                                2,0,0,0, &                       ! case 2
   &                                                                2,1,0,0, &                       ! case 3
   &                                                                3,0,0,0, &                       ! case 4
   &                                                                3,1,0,0, &                       ! case 5
   &                                                                2,3,0,0, &                       ! case 6
   &                                                                2,1,3,0, &                       ! case 7
   &                                                                4,0,0,0, &                       ! case 8
   &                                                                1,4,0,0, &                       ! case 9
   &                                                                2,4,0,0, &                       ! case 10
   &                                                                2,4,1,0, &                       ! case 11
   &                                                                3,4,0,0, &                       ! case 12
   &                                                                3,1,4,0, &                       ! case 13
   &                                                                2,3,4,0, &                       ! case 14
   &                                                                1,2,3,4],shape(case_to_vertex))  ! case 15

   !==== number of vertices with G > 0 (non-zero entries above) per case
   integer, parameter, dimension(0:15) :: nverts=[0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4]

   type tet
      real(WP), dimension(3,4) :: vertex
      real(WP), dimension(4) :: G
      ! tet volume
      real(WP) :: Volume
      ! intersection points (1 tuple per edge)
      real(WP), dimension(3,6) :: intp
      ! Intersected volume and area with G > 0
      real(WP) :: V_intersect,A_intersect
      ! C_intersect : centroid of intersected volumne
      real(WP), dimension(3) :: C_intersect
      ! Tet and intersecting area Centroid
      real(WP), dimension(3) :: T_centroid,A_centroid
      integer :: case
   end type tet

   !==== A Hexahedron *** lookup table based on this vertex ordering ***
   !
   !       vertices
   !
   !      7---------8
   !     /|        /|
   !    / |       / |
   !   /  |      /  |
   !  5---3-----6---4
   !  |  /      |  /
   !  | /       | /
   !  |/        |/
   !  1---------2
   !
   !=====

   !===== lookup table for hex vertices to tet vertices
   integer, parameter, dimension(4,6) :: hex_to_tet=reshape([1,2,4,8,1,2,6,8,1,3,4,8,1,3,7,8,1,5,6,8,1,5,7,8],shape(hex_to_tet))

   !==== cube_shift is applied to cube vertices to generate 8 sub-cubes with
   !     appropriate vertices
   real(WP), parameter, dimension(3,8,8) :: cube_shift=reshape([ &
   +0.0_WP, 0.0_WP, 0.0_WP, &     ! subcube : 1, vertex  :1
   -0.5_WP, 0.0_WP, 0.0_WP, &     ! subcube : 1, vertex  :2
   +0.0_WP,-0.5_WP, 0.0_WP, &     ! subcube : 1, vertex  :3
   -0.5_WP,-0.5_WP, 0.0_WP, &     ! subcube : 1, vertex  :4
   +0.0_WP, 0.0_WP,-0.5_WP, &     ! subcube : 1, vertex  :5
   -0.5_WP, 0.0_WP,-0.5_WP, &     ! subcube : 1, vertex  :6
   +0.0_WP,-0.5_WP,-0.5_WP, &     ! subcube : 1, vertex  :7
   -0.5_WP,-0.5_WP,-0.5_WP, &     ! subcube : 1, vertex  :8
   +0.5_WP, 0.0_WP, 0.0_WP, &     ! subcube : 2, vertex  :1
   +0.0_WP, 0.0_WP, 0.0_WP, &     ! subcube : 2, vertex  :2
   +0.5_WP,-0.5_WP, 0.0_WP, &     ! subcube : 2, vertex  :3
   +0.0_WP,-0.5_WP, 0.0_WP, &     ! subcube : 2, vertex  :4
   +0.5_WP, 0.0_WP,-0.5_WP, &     ! subcube : 2, vertex  :5
   +0.0_WP, 0.0_WP,-0.5_WP, &     ! subcube : 2, vertex  :6
   +0.5_WP,-0.5_WP,-0.5_WP, &     ! subcube : 2, vertex  :7
   +0.0_WP,-0.5_WP,-0.5_WP, &     ! subcube : 2, vertex  :8
   +0.0_WP, 0.5_WP, 0.0_WP, &     ! subcube : 3, vertex  :1
   -0.5_WP, 0.5_WP, 0.0_WP, &     ! subcube : 3, vertex  :2
   +0.0_WP, 0.0_WP, 0.0_WP, &     ! subcube : 3, vertex  :3
   -0.5_WP, 0.0_WP, 0.0_WP, &     ! subcube : 3, vertex  :4
   +0.0_WP, 0.5_WP,-0.5_WP, &     ! subcube : 3, vertex  :5
   -0.5_WP, 0.5_WP,-0.5_WP, &     ! subcube : 3, vertex  :6
   +0.0_WP, 0.0_WP,-0.5_WP, &     ! subcube : 3, vertex  :7
   -0.5_WP, 0.0_WP,-0.5_WP, &     ! subcube : 3, vertex  :8
   +0.5_WP, 0.5_WP, 0.0_WP, &     ! subcube : 4, vertex  :1
   -0.0_WP, 0.5_WP, 0.0_WP, &     ! subcube : 4, vertex  :2
   +0.5_WP, 0.0_WP, 0.0_WP, &     ! subcube : 4, vertex  :3
   -0.0_WP, 0.0_WP, 0.0_WP, &     ! subcube : 4, vertex  :4
   +0.5_WP, 0.5_WP,-0.5_WP, &     ! subcube : 4, vertex  :5
   -0.0_WP, 0.5_WP,-0.5_WP, &     ! subcube : 4, vertex  :6
   +0.5_WP, 0.0_WP,-0.5_WP, &     ! subcube : 4, vertex  :7
   -0.0_WP, 0.0_WP,-0.5_WP, &     ! subcube : 4, vertex  :8
   +0.0_WP, 0.0_WP, 0.5_WP, &     ! subcube : 5, vertex  :1
   -0.5_WP, 0.0_WP, 0.5_WP, &     ! subcube : 5, vertex  :2
   +0.0_WP,-0.5_WP, 0.5_WP, &     ! subcube : 5, vertex  :3
   -0.5_WP,-0.5_WP, 0.5_WP, &     ! subcube : 5, vertex  :4
   +0.0_WP, 0.0_WP, 0.0_WP, &     ! subcube : 5, vertex  :5
   -0.5_WP, 0.0_WP, 0.0_WP, &     ! subcube : 5, vertex  :6
   +0.0_WP,-0.5_WP, 0.0_WP, &     ! subcube : 5, vertex  :7
   -0.5_WP,-0.5_WP, 0.0_WP, &     ! subcube : 5, vertex  :8
   +0.5_WP, 0.0_WP, 0.5_WP, &     ! subcube : 6, vertex  :1
   +0.0_WP, 0.0_WP, 0.5_WP, &     ! subcube : 6, vertex  :2
   +0.5_WP,-0.5_WP, 0.5_WP, &     ! subcube : 6, vertex  :3
   +0.0_WP,-0.5_WP, 0.5_WP, &     ! subcube : 6, vertex  :4
   +0.5_WP, 0.0_WP, 0.0_WP, &     ! subcube : 6, vertex  :5
   +0.0_WP, 0.0_WP, 0.0_WP, &     ! subcube : 6, vertex  :6
   +0.5_WP,-0.5_WP, 0.0_WP, &     ! subcube : 6, vertex  :7
   +0.0_WP,-0.5_WP, 0.0_WP, &     ! subcube : 6, vertex  :8
   +0.0_WP, 0.5_WP, 0.5_WP, &     ! subcube : 7, vertex  :1
   -0.5_WP, 0.5_WP, 0.5_WP, &     ! subcube : 7, vertex  :2
   +0.0_WP, 0.0_WP, 0.5_WP, &     ! subcube : 7, vertex  :3
   -0.5_WP, 0.0_WP, 0.5_WP, &     ! subcube : 7, vertex  :4
   +0.0_WP, 0.5_WP, 0.0_WP, &     ! subcube : 7, vertex  :5
   -0.5_WP, 0.5_WP, 0.0_WP, &     ! subcube : 7, vertex  :6
   +0.0_WP, 0.0_WP, 0.0_WP, &     ! subcube : 7, vertex  :7
   -0.5_WP, 0.0_WP, 0.0_WP, &     ! subcube : 7, vertex  :8
   +0.5_WP, 0.5_WP, 0.5_WP, &     ! subcube : 8, vertex  :1
   -0.0_WP, 0.5_WP, 0.5_WP, &     ! subcube : 8, vertex  :2
   +0.5_WP, 0.0_WP, 0.5_WP, &     ! subcube : 8, vertex  :3
   -0.0_WP, 0.0_WP, 0.5_WP, &     ! subcube : 8, vertex  :4
   +0.5_WP, 0.5_WP, 0.0_WP, &     ! subcube : 8, vertex  :5
   -0.0_WP, 0.5_WP, 0.0_WP, &     ! subcube : 8, vertex  :6
   +0.5_WP, 0.0_WP, 0.0_WP, &     ! subcube : 8, vertex  :7
   -0.0_WP, 0.0_WP, 0.0_WP  &     ! subcube : 8, vertex  :8
   ],shape(cube_shift))

   type(tet) :: tet_gl
   type(tri) :: tri_gl

contains

   !##################################################
   !##################################################
   ! begin geomtry related routines

   function magnitude(v1) result(M)
      use mathtools, only: cross_product
      implicit none
      real(WP), dimension(3), intent(in) :: v1
      real(WP) :: M
      M = sqrt(dot_product(v1,v1))
   end function magnitude

   ! vertex is an array of vertices for the polygon(hedra)
   ! vertex(:,i) contains the x,y,z coordinates of vertex 'i'
   function tet_volume(vertex) result(V)
      use mathtools, only: cross_product
      implicit none
      real(WP),dimension(:,:), intent(in) :: vertex
      real(WP) :: V
      V = r16*abs(dot_product(vertex(:,1)-vertex(:,4),cross_product(vertex(:,2)-vertex(:,4),vertex(:,3)-vertex(:,4))))
   end function tet_volume

   ! vertex is an array of vertices for the triangle/tetrahedra
   ! vertex(:,i) contains the x,y,z coordinates of vertex 'i'
   function poly_centroid(vertex) result(centroid)
      implicit none
      real(WP), dimension(:,:), intent(in) :: vertex
      real(WP), dimension(3) :: centroid
      centroid = sum(vertex,DIM=2)/real(size(vertex,DIM=2),WP)
   end function poly_centroid

   ! v1,v2,v3 are the three vertices of the triangle (any order)
   function triangle_area(vertex) result(A)
      use mathtools, only: cross_product
      implicit none
      real(WP), dimension(:,:), intent(in) :: vertex
      real(WP) :: A
      A = 0.5_WP*magnitude(cross_product((vertex(:,3)-vertex(:,1)),(vertex(:,3)-vertex(:,2))))
   end function triangle_area

   subroutine split_polygon_area(vertex,area,centroid)
      implicit none
      real(WP), dimension(:,:), intent(in) :: vertex
      real(WP), intent(out) :: area
      real(WP), dimension(:), intent(out) :: centroid
      integer :: npts,i
      real(WP), dimension(3,3) :: tri_vertex
      real(WP) :: myArea
      npts = size(vertex,DIM=2)
      area = 0.0_WP
      centroid = 0.0_WP
      do i=3,npts
         tri_vertex = vertex(:,i-2:i)
         myArea = triangle_area(tri_vertex)
         area = area + myArea
         centroid = centroid+ myArea*poly_centroid(tri_vertex)
      end do
      if (area.gt.0.0_WP) centroid = centroid/area
   end subroutine split_polygon_area

   subroutine split_polygon_volume(vertex,volume,centroid)
      implicit none
      real(WP), dimension(:,:), intent(in) :: vertex
      real(WP), intent(out) :: volume
      real(WP), dimension(:), intent(out) :: centroid
      integer :: npts,i
      real(WP), dimension(3,4) :: tet_vertex
      real(WP) :: myVolume
      npts = size(vertex,DIM=2)
      volume = 0.0_WP
      centroid = 0.0_WP
      tet_vertex(:,1) = vertex(:,1)
      do i=4,npts
         tet_vertex(:,2:4) = vertex(:,i-2:i)
         myVolume = tet_volume(tet_vertex)
         volume = volume + myVolume
         centroid = centroid+ myVolume*poly_centroid(tet_vertex)
      end do
      if (volume.gt.0.0_WP) centroid = centroid/volume
   end subroutine split_polygon_volume

   ! end geometry related routines
   !##################################################
   !##################################################

   subroutine HexToTets(hex_vertex,hex_G,ntet)
      implicit none
      real(WP), dimension(3,8),intent(in) :: hex_vertex
      real(WP), dimension(8), intent(in) :: hex_G
      integer, intent(in) :: ntet
      tet_gl%vertex = hex_vertex(:,hex_to_tet(:,ntet))
      tet_gl%G = hex_G(hex_to_tet(:,ntet))
      tet_gl%Volume = tet_volume(tet_gl%vertex)
      tet_gl%T_Centroid = poly_centroid(tet_gl%vertex)
   end subroutine HexToTets

   subroutine computeCase(T)
      implicit none
      type(tet) :: T
      T%case = int(0.5_WP+sign(0.51_WP,T%G(1)))+2*int(0.5_WP+sign(0.51_WP,T%G(2)))+4*int(0.5_WP+sign(0.51_WP,T%G(3)))+8*int(0.5_WP+sign(0.51_WP,T%G(4)))
   end subroutine computeCase

   subroutine computeIntersectionPtsLinear(T)
      implicit none
      type(tet) :: T
      real(WP), dimension(3) :: p1,p2
      real(WP) :: m
      integer :: i,iedge
      ! loop over edges
      do i=1,nedges(T%case)
         !estimate intersection point
         iedge = case_to_edge(i,T%case)
         p1 = T%vertex(:,edge_to_vertex(1,iedge))
         p2 = T%vertex(:,edge_to_vertex(2,iedge))
         m = -T%G(edge_to_vertex(1,iedge))/(T%G(edge_to_vertex(2,iedge))-T%G(edge_to_vertex(1,iedge)))
         T%intp(1:3,iedge) = p1 + m *(p2-p1)
      end do
   end subroutine computeIntersectionPtsLinear

   subroutine RecToTris(rec_vertex,rec_G,ntri)
      implicit none
      real(WP), dimension(3,4),intent(in) :: rec_vertex
      real(WP), dimension(4), intent(in) :: rec_G
      integer, intent(in) :: ntri
      tri_gl%vertex = rec_vertex(:,rec_to_tri(:,ntri))
      tri_gl%G = rec_G(rec_to_tri(:,ntri))
      tri_gl%area = triangle_area(tri_gl%vertex)
      tri_gl%T_centroid = poly_centroid(tri_gl%vertex)
   end subroutine RecToTris

   subroutine triCase(T)
      implicit none
      type(tri) :: T
      ! sum over vertices
      T%case = int(0.5_WP+sign(0.51_WP,T%G(1)))+2*int(0.5_WP+sign(0.51_WP,T%G(2)))+4*int(0.5_WP+sign(0.51_WP,T%G(3)))
   end subroutine triCase

   subroutine triIntersectionPtsLinear(T)
      implicit none
      type(tri) :: T
      real(WP), dimension(3) :: p1,p2
      real(WP) :: m
      integer :: i,iedge
      ! loop over edges (two edges always!)
      do i=1,2
         !estimate intersection point
         iedge = tri_case_to_edge(i,T%case)
         p1 = T%vertex(:,tri_edge_to_vertex(1,iedge))
         p2 = T%vertex(:,tri_edge_to_vertex(2,iedge))
         m = -T%G(tri_edge_to_vertex(1,iedge))/(T%G(tri_edge_to_vertex(2,iedge))-T%G(tri_edge_to_vertex(1,iedge)))
         T%intp(1:3,iedge) = p1 + m *(p2-p1)
      end do
   end subroutine triIntersectionPtsLinear

   !##################################################
   !##################################################
   ! at this point case and interections points have been set
   ! so compute surface areas, volumes, and centroids

   subroutine computeIntersectionData(T)
      implicit none
      type(tet) :: T
      integer :: ne,nv
      real(WP) :: vertex(3,6)
      ne = nedges(T%case)
      nv = nverts(T%case)
      ! area
      vertex(:,1:ne) = T%intp(:,case_to_edge(1:ne,T%case))
      call split_polygon_area(vertex(:,1:ne),T%A_intersect,T%A_centroid)
      ! construct vertex array such that (0,i,i+1,i+2) for a tet
      vertex(:,1) = T%vertex(:,case_to_vertex(1,T%case))
      vertex(:,2:ne+1) = T%intp(:,case_to_edge(1:ne,T%case))
      vertex(:,ne+2:ne+nv) = T%vertex(:,case_to_vertex(2:nv,T%case))
      call split_polygon_volume(vertex(:,1:nv+ne),T%V_intersect,T%C_intersect)
   end subroutine computeIntersectionData

   subroutine triIntersectionData(T)
      implicit none
      type(tri) :: T
      integer :: nv
      real(WP) :: vertex(3,4)
      nv = tri_nverts(T%case)
      ! area
      vertex(:,1:nv) = T%vertex(:,tri_case_to_vertex(:,T%case))
      vertex(:,nv+1:nv+2) = T%intp(:,tri_case_to_edge(:,T%case))
      call split_polygon_area(vertex(:,1:nv+2),T%A_intersect,T%C_intersect)
   end subroutine triIntersectionData

   !##################################################
   !##################################################

   subroutine splitTetLinear(T)
      implicit none
      type(tet) :: T
      ! first determine case
      call computeCase(T)
      if (T%case == 0) then
         ! all nodes are negative
         T%V_intersect= 0.0_WP
         T%C_intersect=0.0_WP
         ! no surface area here
         T%A_intersect=0.0_WP
         T%A_centroid=0.0_WP
      else if (T%case == 15) then
         ! all nodes are positive
         T%V_intersect=T%volume
         T%C_intersect=T%T_Centroid
         ! no surface area here
         T%A_intersect=0.0_WP
         T%A_centroid=0.0_WP
      else
         ! determine intersection points
         call computeIntersectionPtsLinear(T)
         ! compute vol/area data for intersected tet
         call computeIntersectionData(T)
      end if
   end subroutine splitTetLinear

   subroutine splitTriLinear(T)
      implicit none
      type(tri) :: T
      ! first determine case
      call triCase(T)
      if (T%case == 0) then
         ! all nodes are negative
         T%A_intersect= 0.0_WP
         T%C_intersect=0.0_WP
      else if (T%case == 7) then
         ! all nodes are positive
         T%A_intersect=T%area
         T%C_intersect=T%T_Centroid
      else
         ! determine intersection points
         call triIntersectionPtsLinear(T)
         call triIntersectionData(T)
      end if
   end subroutine splitTriLinear

   !##################################################
   !##################################################

   subroutine marching_tets(hex_vertex,G,vol,area,v_cent,a_cent)
      implicit none
      real(WP), dimension(3,8), intent(in) :: hex_vertex
      real(WP), dimension(8  ), intent(in) :: G
      real(WP), intent(out) :: vol,area
      real(WP), intent(out),dimension(3) :: v_cent,a_cent

      !--------------------------------------------------
      integer :: i,cubeCase
      real(WP), dimension(3) :: c_dxyz

      ! initialize case
      cubeCase = 0
      ! initialize volume/area
      vol = 0.0_WP; v_cent = 0.0_WP; area = 0.0_WP; a_cent = 0.0_WP

      do i=1,8
         cubeCase = cubeCase + int(0.5_WP+sign(0.51_WP,G(i)))
      end do

      if (cubeCase == 0) then
         ! no positive G values
         return
      end if

      if (cubeCase == 8) then
         ! all positive G values
         c_dxyz = hex_vertex(:,8)-hex_vertex(:,1)
         vol = product(c_dxyz)
         v_cent = poly_centroid(hex_vertex)
         return
      end if

      ! cube is intersected by G=0

      ! split cube into tets
      do i=1,6
         call HexToTets(hex_vertex,G,i)
         call splitTetLinear(tet_gl)
         ! sum up volume and areas
         vol = vol + tet_gl%V_intersect
         v_cent = v_cent + tet_gl%V_intersect*tet_gl%C_intersect

         area = area + tet_gl%A_intersect
         a_cent = a_cent + tet_gl%A_intersect*tet_gl%A_centroid
      end do

      if (vol .gt.0.0_WP) v_cent = v_cent/vol
      if (area.gt.0.0_WP) a_cent = a_cent/area

      return
   end subroutine marching_tets

   ! splits a cut cube recursively until level=0 - decrease level by one each call
   recursive subroutine cube_refine_vol(hex_vertex,vol,area,v_cent,a_cent,G_func,time,level)
      implicit none
      real(WP), dimension(3,8), intent(in) :: hex_vertex
      real(WP), intent(inout), dimension(3) :: v_cent,a_cent
      real(WP), intent(inout) :: vol,area
      real(WP), intent(in) :: time
      integer, intent(in) :: level
      interface
         function G_func(x,t)
            use precision, only: WP
            implicit none
            real(WP), dimension(3),intent(in) :: x
            real(WP), intent(in) :: t
            real(WP) :: G_func
         end function G_func
      end interface
      !--------------------------------------------------
      real(WP), dimension(3,8) :: sub_cube
      integer :: i,j,cubeCase
      real(WP), dimension(8) :: G
      real(WP), dimension(3) :: c_dxyz

      ! initialize case
      cubeCase = 0
      ! dx,dy,dz for this cube
      c_dxyz = hex_vertex(:,8)-hex_vertex(:,1)

      do i=1,8
         G(i) = G_func(hex_vertex(:,i),time)
         cubeCase = cubeCase + int(0.5_WP+sign(0.51_WP,G(i)))
      end do

      if(cubeCase == 0) then
         ! no positive G-values
         return
      end if

      if(cubeCase == 8) then
         v_cent = vol*v_cent +  product(c_dxyz)*poly_centroid(hex_vertex)
         vol = vol + product(c_dxyz)
         if(vol.gt.0.0_WP) v_cent = v_cent/vol
         return
      end if

      ! cube is intersected by G=0
      if(level > 0) then
         ! loop over sub_cubes
         do i=1,8
            ! loop over sub cube vertices
            do j=1,8
               sub_cube(:,j) = hex_vertex(:,j)+cube_shift(:,j,i)*c_dxyz
            end do
            call cube_refine_vol(sub_cube,vol,area,v_cent,a_cent,G_func,time,level-1)
         end do
         return
      end if

      ! split cube into tets
      do i=1,6
         call HexToTets(hex_vertex,G,i)
         call splitTetLinear(tet_gl)
         ! sum up volume and areas
         v_cent = vol*v_cent + tet_gl%V_intersect*tet_gl%C_intersect
         vol = vol + tet_gl%V_intersect

         a_cent = area*a_cent + tet_gl%A_intersect*tet_gl%A_centroid
         area = area + tet_gl%A_intersect
         if(vol > 0.0_WP) v_cent = v_cent/vol
         if(area> 0.0_WP) a_cent = a_cent/area

      end do
      return
   end subroutine cube_refine_vol

   ! splits a cut cube recursively until level=0 - decrease level by one each call
   recursive subroutine cube_refine_vfunc_afunc_fd(hex_vertex,vol,area,v_cent,a_cent,v_int,a_int,V_func,A_func,G_func,time,level)
      implicit none
      real(WP), dimension(3,8), intent(in) :: hex_vertex
      real(WP), intent(inout), dimension(3) :: v_cent,a_cent
      real(WP), intent(inout) :: vol,area,v_int,a_int
      real(WP), intent(in) :: time
      integer, intent(in) :: level
      interface
         function G_func(x,t)
            use precision, only: WP
            implicit none
            real(WP), dimension(3),intent(in) :: x
            real(WP), intent(in) :: t
            real(WP) :: G_func
         end function G_func
         function V_func(x,t)
            use precision, only: WP
            implicit none
            real(WP), dimension(3),intent(in) :: x
            real(WP), intent(in) :: t
            real(WP) :: V_func
         end function V_func
         function A_func(x,t)
            use precision, only: WP
            implicit none
            real(WP), dimension(3),intent(in) :: x
            real(WP), intent(in) :: t
            real(WP) :: A_func
         end function A_func
      end interface
      !--------------------------------------------------
      real(WP), dimension(3,8) :: sub_cube
      real(WP), dimension(  8) :: G
      integer :: i,j,cubeCase
      real(WP), dimension(3) :: c_dxyz,c_cent
      real(WP) :: c_vol

      ! initialize case
      cubeCase = 0
      ! dx,dy,dz for this cube
      c_dxyz = hex_vertex(:,8)-hex_vertex(:,1)

      do i=1,8
         G(i) = G_func(hex_vertex(:,i),time)
         cubeCase = cubeCase + int(0.5_WP+sign(0.51_WP,G(i)))
      end do

      if(cubeCase == 0) then
         ! no positive G-values
         return
      end if

      if(cubeCase == 8) then
         c_vol = product(c_dxyz); c_cent = poly_centroid(hex_vertex)
         v_int = v_int+c_vol*V_func(c_cent,time)
         v_cent = vol*v_cent +  c_vol*c_cent
         vol = vol + c_vol
         if(vol.gt.0.0_WP) v_cent = v_cent/vol
         return
      end if

      ! cube is intersected by G=0
      if(level > 0) then
         ! loop over sub_cubes
         do i=1,8
            ! loop over sub cube vertices
            do j=1,8
               sub_cube(:,j) = hex_vertex(:,j)+cube_shift(:,j,i)*c_dxyz
            end do
            call cube_refine_vfunc_afunc_fd(sub_cube,vol,area,v_cent,a_cent,v_int,a_int,V_func,A_func,G_func,time,level-1)
         end do
         return
      end if

      ! split cube into tets
      do i=1,6
         call HexToTets(hex_vertex,G,i)
         call splitTetLinear(tet_gl)
         ! sum up volume and areas
         v_int = v_int+tet_gl%V_intersect*V_func(tet_gl%C_intersect,time)
         v_cent = vol*v_cent + tet_gl%V_intersect*tet_gl%C_intersect
         vol = vol + tet_gl%V_intersect

         a_int = a_int+tet_gl%A_intersect*V_func(tet_gl%A_centroid,time)
         a_cent = area*a_cent + tet_gl%A_intersect*tet_gl%A_centroid
         area = area + tet_gl%A_intersect
         if(vol > 0.0_WP) v_cent = v_cent/vol
         if(area> 0.0_WP) a_cent = a_cent/area

      end do
      return
   end subroutine cube_refine_vfunc_afunc_fd

   ! splits a cut cube recursively until level=0 - decrease level by one each call
   recursive subroutine cube_refine_afunc_fd(hex_vertex,vol,area,v_cent,a_cent,a_int,A_func,G_func,time,level)
      implicit none
      real(WP), dimension(3,8), intent(in) :: hex_vertex
      real(WP), intent(inout), dimension(3) :: v_cent,a_cent
      real(WP), intent(inout) :: vol,area,a_int
      real(WP), intent(in) :: time
      integer, intent(in) :: level
      interface
         function G_func(x,t)
            use precision, only: WP
            implicit none
            real(WP), dimension(3),intent(in) :: x
            real(WP), intent(in) :: t
            real(WP) :: G_func
         end function G_func
         function A_func(x,t)
            use precision, only: WP
            implicit none
            real(WP), dimension(3),intent(in) :: x
            real(WP), intent(in) :: t
            real(WP) :: A_func
         end function A_func
      end interface
      !--------------------------------------------------
      real(WP), dimension(3,8) :: sub_cube
      real(WP), dimension(  8) :: G
      integer :: i,j,cubeCase
      real(WP), dimension(3) :: c_dxyz

      ! initialize case
      cubeCase = 0
      ! dx,dy,dz for this cube
      c_dxyz = hex_vertex(:,8)-hex_vertex(:,1)

      do i=1,8
         G(i) = G_func(hex_vertex(:,i),time)
         cubeCase = cubeCase + int(0.5_WP+sign(0.51_WP,G(i)))
      end do

      if(cubeCase == 0) then
         ! no positive G-values
         return
      end if

      if(cubeCase == 8) then
         v_cent = vol*v_cent +  product(c_dxyz)*poly_centroid(hex_vertex)
         vol = vol + product(c_dxyz)
         if(vol.gt.0.0_WP) v_cent = v_cent/vol
         return
      end if

      ! cube is intersected by G=0
      if(level > 0) then
         ! loop over sub_cubes
         do i=1,8
            ! loop over sub cube vertices
            do j=1,8
               sub_cube(:,j) = hex_vertex(:,j)+cube_shift(:,j,i)*c_dxyz
            end do
            call cube_refine_afunc_fd(sub_cube,vol,area,v_cent,a_cent,a_int,A_func,G_func,time,level-1)
         end do
         return
      end if

      ! split cube into tets
      do i=1,6
         call HexToTets(hex_vertex,G,i)
         call splitTetLinear(tet_gl)
         ! sum up volume and areas
         v_cent = vol*v_cent + tet_gl%V_intersect*tet_gl%C_intersect
         vol = vol + tet_gl%V_intersect

         a_int = a_int+tet_gl%A_intersect*A_func(tet_gl%A_centroid,time)
         a_cent = area*a_cent + tet_gl%A_intersect*tet_gl%A_centroid
         area = area + tet_gl%A_intersect
         if(vol > 0.0_WP) v_cent = v_cent/vol
         if(area> 0.0_WP) a_cent = a_cent/area

      end do
      return
   end subroutine cube_refine_afunc_fd

   ! === 2D cutting

   subroutine marching_tris(rec_vertex,G,area,a_cent)
      implicit none
      real(WP), dimension(3,4), intent(in) :: rec_vertex
      real(WP), dimension(4  ), intent(in) :: G
      real(WP), intent(out) :: area
      real(WP), intent(out),dimension(3) :: a_cent

      !--------------------------------------------------
      integer :: i, recCase

      ! initialize case
      recCase = 0
      ! initialize area
      area = 0.0_WP; a_cent = 0.0_WP

      do i=1,4
         recCase = recCase + int(0.5_WP+sign(0.51_WP,G(i)))
      end do

      if(recCase == 0) then
         ! no positive G values
         return
      end if

      if(recCase == 4) then
         ! all positive G values
         call split_polygon_area(rec_vertex,area,a_cent)
         return
      end if

      ! rec is intersected by G=0

      ! split rec into tris
      do i=1,2
         call RecToTris(rec_vertex,G,i)
         call splitTriLinear(tri_gl)
         ! sum up areas
         area = area + tri_gl%A_intersect
         a_cent = a_cent + tri_gl%A_intersect*tri_gl%C_intersect
      end do

      if(area> 0.0_WP) a_cent = a_cent/area

      return
   end subroutine marching_tris

   subroutine split_rec(rec_vertex,sub_rec)
      implicit none
      real(WP), dimension(3,4), intent(in) :: rec_vertex
      real(WP), dimension(3,4,4), intent(out) :: sub_rec
      real(WP), dimension(3,5) :: mid_rec

      ! midpoints to construct sub-rectangles
      !
      !    v3----m4----v4
      !    | III | IV  |
      !    |     |     |
      !    m3----m5----m2
      !    |     |     |
      !    | I   |  II |
      !    v1----m1----v2
      !
      mid_rec(:,1) = 0.5_WP*(rec_vertex(:,1)+rec_vertex(:,2))
      mid_rec(:,2) = 0.5_WP*(rec_vertex(:,2)+rec_vertex(:,4))
      mid_rec(:,3) = 0.5_WP*(rec_vertex(:,1)+rec_vertex(:,3))
      mid_rec(:,4) = 0.5_WP*(rec_vertex(:,3)+rec_vertex(:,4))
      mid_rec(:,5) = 0.5_WP*(rec_vertex(:,1)+rec_vertex(:,4))

      ! sub-rec I
      sub_rec(:,1,1)=rec_vertex(:,1)
      sub_rec(:,2,1)=mid_rec(:,1)
      sub_rec(:,3,1)=mid_rec(:,3)
      sub_rec(:,4,1)=mid_rec(:,5)
      ! sub-rec II
      sub_rec(:,1,2)=mid_rec(:,1)
      sub_rec(:,2,2)=rec_vertex(:,2)
      sub_rec(:,3,2)=mid_rec(:,5)
      sub_rec(:,4,2)=mid_rec(:,2)
      ! sub-rec III
      sub_rec(:,1,3)=mid_rec(:,3)
      sub_rec(:,2,3)=mid_rec(:,5)
      sub_rec(:,3,3)=rec_vertex(:,3)
      sub_rec(:,4,3)=mid_rec(:,4)
      ! sub-rec IV
      sub_rec(:,1,4)=mid_rec(:,5)
      sub_rec(:,2,4)=mid_rec(:,2)
      sub_rec(:,3,4)=mid_rec(:,4)
      sub_rec(:,4,4)=rec_vertex(:,4)

   end subroutine split_rec

   recursive subroutine rec_refine_area(rec_vertex,area,a_cent,G_func,time,level)
      implicit none
      real(WP), dimension(3,4), intent(in) :: rec_vertex
      real(WP), intent(inout) :: area
      real(WP), intent(inout), dimension(3) :: a_cent
      integer, intent(in) :: level
      real(WP), intent(in) :: time
      interface
         function G_func(x,t)
            use precision, only: WP
            implicit none
            real(WP), dimension(3),intent(in) :: x
            real(WP), intent(in) :: t
            real(WP) :: G_func
         end function G_func
      end interface
      !--------------------------------------------------
      real(WP), dimension(3,4,4) :: sub_rec
      real(WP), dimension(4) :: G
      integer :: i,recCase
      real(WP), dimension(3) :: my_cent
      real(WP) :: my_area
      ! initialize case
      recCase = 0
      ! do not initialize area ...

      ! determine G/case
      do i=1,4
         G(i) = G_func(rec_vertex(:,i),time)
         recCase = recCase + int(0.5_WP+sign(0.51_WP,G(i)))
      end do

      if(recCase == 0) then
         ! no positive G values
         return
      end if

      if(recCase == 4) then
         ! all positive G values
         call split_polygon_area(rec_vertex,my_area,my_cent)
         ! update centroid, area
         a_cent = area*a_cent + my_area*my_cent
         area = area + my_area
         if(area.gt.0.0_WP) a_cent = a_cent/area
         return
      end if

      if(level > 0 ) then
         call split_rec(rec_vertex,sub_rec)

         ! loop over sub-recs
         do i=1,4
            call rec_refine_area(sub_rec(:,:,i),area,a_cent,G_func,time,level-1)
         end do
         return
      end if

      ! rec is intersected by G=0 and at max refinement level
      do i=1,2
         call RecToTris(rec_vertex,G,i)
         call splitTriLinear(tri_gl)
         ! sum up areas
         a_cent = area*a_cent + tri_gl%A_intersect*tri_gl%C_intersect
         area = area + tri_gl%A_intersect
         if(area> 0.0_WP) a_cent = a_cent/area
      end do

      return
   end subroutine rec_refine_area

   recursive subroutine rec_refine_afunc_fd(rec_vertex,area,a_cent,a_int,A_func,G_func,time,level)
      implicit none
      real(WP), dimension(3,4), intent(in) :: rec_vertex
      real(WP), intent(inout) :: area,a_int
      real(WP), intent(inout), dimension(3) :: a_cent
      integer, intent(in) :: level
      real(WP), intent(in) :: time
      interface
         function G_func(x,t)
            use precision, only: WP
            implicit none
            real(WP), dimension(3),intent(in) :: x
            real(WP), intent(in) :: t
            real(WP) :: G_func
         end function G_func
         function A_func(x,t)
            use precision, only: WP
            implicit none
            real(WP), dimension(3),intent(in) :: x
            real(WP), intent(in) :: t
            real(WP) :: A_func
         end function A_func
      end interface
      !--------------------------------------------------
      real(WP), dimension(3,4,4) :: sub_rec
      real(WP), dimension(4) :: G
      integer :: i,recCase
      real(WP), dimension(3) :: my_cent
      real(WP) :: my_area
      ! initialize case
      recCase = 0
      ! do not initialize area ...

      ! determine G/case
      do i=1,4
         G(i) = G_func(rec_vertex(:,i),time)
         recCase = recCase + int(0.5_WP+sign(0.51_WP,G(i)))
      end do

      if(recCase == 0) then
         ! no positive G values
         return
      end if

      if(recCase == 4) then
         ! all positive G values
         call split_polygon_area(rec_vertex,my_area,my_cent)
         ! update centroid, area
         a_int = a_int+my_area*A_func(my_cent,time)
         a_cent = area*a_cent + my_area*my_cent
         area = area + my_area
         if(area.gt.0.0_WP) a_cent = a_cent/area
         return
      end if

      if(level > 0 ) then
         call split_rec(rec_vertex,sub_rec)

         ! loop over sub-recs
         do i=1,4
            call rec_refine_afunc_fd(sub_rec(:,:,i),area,a_cent,a_int,A_func,G_func,time,level-1)
         end do
         return
      end if
      ! rec is intersected by G=0 and at max refinement level
      do i=1,2
         call RecToTris(rec_vertex,G,i)
         call splitTriLinear(tri_gl)
         ! sum up areas
         a_int = a_int+tri_gl%A_intersect*A_func(tri_gl%C_intersect,time)
         a_cent = area*a_cent + tri_gl%A_intersect*tri_gl%C_intersect
         area = area + tri_gl%A_intersect
         if(area> 0.0_WP) a_cent = a_cent/area
      end do

      return
   end subroutine rec_refine_afunc_fd

end module mms_geom