path: root/src/EHFinder_Integrate.F90

! Integrating over the surface(s). Right now only in full mode.
! $Header$

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

subroutine EHFinder_FindSurfaceElement(CCTK_ARGUMENTS)

  use EHFinder_mod

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k, l, im, jm
  CCTK_INT :: interp_handle, table_handle, coord_system_handle

  character(len=200) :: area_interp
  character(len=128) :: warn_message
  CCTK_INT :: area_interp_len
  character(len=7) :: area_order

  CCTK_INT, dimension(4) :: bbox
  CCTK_INT, dimension(2) :: gsh, lsh, lbnd, ubnd, nghost

  CCTK_REAL :: dtheta, dphi, dthetainv, dphiinv
  CCTK_REAL :: dxdth, dxdph, dydth, dydph, dzdth, dzdph
  CCTK_POINTER, dimension(3) :: interp_coords
  CCTK_POINTER, dimension(7) :: out_array
  CCTK_INT, dimension(7) :: in_array
  CCTK_INT, dimension(7), parameter :: out_types = (/ CCTK_VARIABLE_REAL, &
                                                      CCTK_VARIABLE_REAL, &
                                                      CCTK_VARIABLE_REAL, &
                                                      CCTK_VARIABLE_REAL, &
                                                      CCTK_VARIABLE_REAL, &
                                                      CCTK_VARIABLE_REAL, &
                                                      CCTK_VARIABLE_REAL /)
  
! If finding of surface failed do not try to integrate but exit.
  if ( find_surface_status .lt. 0 ) then
    return
  endif

! Store the levelset_counter in a shorter named variable for convenience.
  l = levelset_counter

! Write an Info message about what we are doing.
  call CCTK_INFO ( 'Finding surface element' )

! Obtain the dimensions and characteristics of the grid arrays.
  call CCTK_GroupbboxGN ( ierr, cctkGH, 4, bbox, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get bounding box for surface arrays' )
  end if
  call CCTK_GroupgshGN ( ierr, cctkGH, 2, gsh, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get global size for surface arrays' )
  end if
  call CCTK_GrouplbndGN ( ierr, cctkGH, 2, lbnd, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get lower bounds for surface arrays' )
  end if
  call CCTK_GroupubndGN ( ierr, cctkGH, 2, ubnd, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get upper bounds for surface arrays' )
  end if
  call CCTK_GrouplshGN ( ierr, cctkGH, 2, lsh, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get local size for surface arrays' )
  end if
  call CCTK_GroupnghostzonesGN ( ierr, cctkGH, 2, nghost, &
                                           'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get local size for surface arrays' )
  end if

! Setup the theta and phi spacings and their inverse.
  dtheta = ctheta(2,1) - ctheta(1,1)
  dphi = cphi(1,2) - cphi(1,1)
  dthetainv = one / dtheta
  dphiinv = one / dphi

! Convert the interpolator parameter into a fortran string.
  call CCTK_FortranString ( area_interp_len, area_interpolator, &
                                             area_interp )

! Get an interpolation handle.
  call CCTK_InterpHandle ( interp_handle, area_interp(1:area_interp_len) )

  if ( interp_handle .lt. 0 ) then
    warn_message = 'Cannot get handle for interpolation. '
    warn_message = trim(warn_message)//'Forgot to activate an implementation '
    warn_message = trim(warn_message)//'providing interpolation operators?'
    call CCTK_WARN( 0, trim(warn_message) )
  end if

! Write the interpolation order parameter into a string
  write(area_order,'(a6,i1)') 'order=',area_interpolation_order

! Create a table from the interpolation order string.
  call Util_TableCreateFromString ( table_handle, area_order )
  if ( table_handle .lt. 0 ) then
    call CCTK_WARN( 0, 'Cannot create parameter table for interpolator' )
  end if

! Get a handle for the coordinate system.
  call CCTK_CoordSystemHandle ( coord_system_handle, 'cart3d' )
  if ( coord_system_handle .lt. 0) then
    warn_message = 'Cannot get handle for cart3d coordinate system. '
    warn_message = trim(warn_message)//'Forgot to activate an implementation '
    warn_message = trim(warn_message)//'providing coordinates?'
    call CCTK_WARN( 0, trim(warn_message) )
  endif

! Get the pointers to the interpolation points.
  interp_coords(1) = CCTK_PointerTo(interp_x)
  interp_coords(2) = CCTK_PointerTo(interp_y)
  interp_coords(3) = CCTK_PointerTo(interp_z)

! Get the pointers to the interpolation return arrays.
  out_array(1) = CCTK_PointerTo(gxxi)
  out_array(2) = CCTK_PointerTo(gxyi)
  out_array(3) = CCTK_PointerTo(gxzi)
  out_array(4) = CCTK_PointerTo(gyyi)
  out_array(5) = CCTK_PointerTo(gyzi)
  out_array(6) = CCTK_PointerTo(gzzi)
  out_array(7) = CCTK_PointerTo(psii)

! find the cartesian coordinates for the interpolation points
  do j = 1, lsh(2)
    do i = 1, lsh(1)
      interp_x(i,j) = center(1) + rsurf(i,j) * sintheta(i,j) * cosphi(i,j)
      interp_y(i,j) = center(2) + rsurf(i,j) * sintheta(i,j) * sinphi(i,j)
      interp_z(i,j) = center(3) + rsurf(i,j) * costheta(i,j)
    end do
  end do

! Get the indices for the grid functions to be interpolated.
  call CCTK_VarIndex ( in_array(1), 'admbase::gxx' )
  call CCTK_VarIndex ( in_array(2), 'admbase::gxy' )
  call CCTK_VarIndex ( in_array(3), 'admbase::gxz' )
  call CCTK_VarIndex ( in_array(4), 'admbase::gyy' )
  call CCTK_VarIndex ( in_array(5), 'admbase::gyz' )
  call CCTK_VarIndex ( in_array(6), 'admbase::gzz' )

! If the static conformal factor is used, we also need to interpolate it.
  if ( CCTK_EQUALS ( metric_type, 'static conformal' ) ) then
    call CCTK_VarIndex ( in_array(7), 'staticconformal::psi' )

!   Call the interpolator for the metric and the conformal factor.
    call CCTK_InterpGridArrays ( ierr, cctkGH, 3, interp_handle, &
                                 table_handle, coord_system_handle, &
                                 lsh(1) * lsh(2), CCTK_VARIABLE_REAL, &
                                 interp_coords, 7, in_array, &
                                 7, out_types, out_array )

!   Get the physical metric.
    gxxi = psii**4 * gxxi
    gxyi = psii**4 * gxyi
    gxzi = psii**4 * gxzi
    gyyi = psii**4 * gyyi
    gyzi = psii**4 * gyzi
    gzzi = psii**4 * gzzi
  else
!   Else call the interpolater only for the metric.
    call CCTK_InterpGridArrays ( ierr, cctkGH, 3, interp_handle, &
                                 table_handle, coord_system_handle, &
                                 lsh(1) * lsh(2), CCTK_VARIABLE_REAL, &
                                 interp_coords, 6, in_array(1:6), &
                                 6, out_types(1:6), out_array(1:6) )
  end if

! For all points on the surface...
  do j = 1, lsh(2)
    do i = 1, lsh(1)

!     Calculate the coordinate transformation between the 3-d cartesian
!     coordinates and the 2-d (theta,phi) coordinates on the surface.
      dxdth = ( drdtheta(i,j) * sintheta(i,j) + &
                rsurf(i,j) * costheta(i,j) ) * cosphi(i,j)
      dydth = ( drdtheta(i,j) * sintheta(i,j) + &
                rsurf(i,j) * costheta(i,j) ) * sinphi(i,j)
      dzdth = drdtheta(i,j) * costheta(i,j) - rsurf(i,j) * sintheta(i,j)
      dxdph = ( drdphi(i,j) * cosphi(i,j) - &
                rsurf(i,j) * sinphi(i,j) ) * sintheta(i,j)
      dydph = ( drdphi(i,j) * sinphi(i,j) + &
                rsurf(i,j) * cosphi(i,j) ) * sintheta(i,j)
      dzdph = drdphi(i,j) * costheta(i,j)

!     Using this coordinate transformation, calculate the induced 2-metric
!     on the surface.
      gtt(i,j) = dxdth**2 * gxxi(i,j) + dydth**2 * gyyi(i,j) + &
            dzdth**2 * gzzi(i,j) + &
            two * ( dxdth * dydth * gxyi(i,j) + &
                    dxdth * dzdth * gxzi(i,j) + &
                    dydth * dzdth * gyzi(i,j) )
      gtp(i,j) = dxdth * dxdph * gxxi(i,j) + &
            ( dxdth * dydph + dydth * dxdph ) * gxyi(i,j) + &
            ( dxdth * dzdph + dzdth * dxdph ) * gxzi(i,j) + &
            dydth * dydph * gyyi(i,j) + &
            ( dydth * dzdph + dzdth * dydph ) * gyzi(i,j) + &
            dzdth * dzdph * gzzi(i,j)
      gpp(i,j) = dxdph**2 * gxxi(i,j) + dydph**2 * gyyi(i,j) + &
            dzdph**2 * gzzi(i,j) + &
            two * ( dxdph * dydph * gxyi(i,j) + &
                    dxdph * dzdph * gxzi(i,j) + &
                    dydph * dzdph * gyzi(i,j) )

!     Calculate the area element as the square-root of the determinant
!     of the two metric multiplied by dtheta*dphi.
      da(i,j) = dtheta * dphi * sqrt ( gtt(i,j) * gpp(i,j) - gtp(i,j)**2 )

!     Calculate the arc length element for the polar circumference integration.
      dltheta(i,j) = dtheta * sqrt ( gtt(i,j) )

!     Calculate the arc length element for the equatorial circumference
!     integration.
      dlphi(i,j) = dphi * sqrt ( gpp(i,j) )

    end do
  end do
 
end subroutine EHFinder_FindSurfaceElement


subroutine EHFinder_IntegrateArea(CCTK_ARGUMENTS)

  use EHFinder_mod

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: int_var, sn, l
  CCTK_REAL :: eh_area_tmp
  character(len=30) :: info_message
  CCTK_INT, dimension(1) :: lbnd, ubnd, lsh

! If finding of surface failed do not try to integrate but exit.
  if ( find_surface_status .lt. 0 ) then
    return
  endif

! Store the levelset_counter in a shorter named variable for convenience.
  l = levelset_counter

! Write an info message, to indicate what we are doing.
  call CCTK_INFO ( 'Integrating area' )

  sn = surface_counter - integrate_counter

! Taking into account the sym_factor and the weights, the area is simply
! The sum of the elements of this array.
  int_tmp = sym_factor * weights * da

! Get the index to the area integration array.
  call CCTK_VarIndex ( int_var, 'ehfinder::int_tmp' )
  if ( int_var .lt. 0 ) then
    call CCTK_WARN ( 0, 'Could not get index to grid array int_tmp' )
  end if

! Do a sum reduce over all processors. The result is the area.
  call CCTK_Reduce ( ierr, cctkGH, -1, sum_handle, 1, CCTK_VARIABLE_REAL, &
                     eh_area_tmp, 1, int_var )

! Write an info message reporting the area found.
  write(info_message,'(a15,f10.5)') 'Horizon area = ',eh_area_tmp

  call CCTK_INFO( trim(info_message) )

! Figure out the bounds of the area storage grid array.
  call CCTK_GrouplbndGN ( ierr, cctkGH, 1, lbnd, 'ehfinder::eh_area2' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get lower bounds for area array' )
  end if
  call CCTK_GroupubndGN ( ierr, cctkGH, 1, ubnd, 'ehfinder::eh_area2' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get upper bounds for area array' )
  end if
  call CCTK_GrouplshGN ( ierr, cctkGH, 1, lsh, 'ehfinder::eh_area2' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get local size for area array' )
  end if

! If this processor contains the right part of the area storage grid array
! save the area, otherwise do nothing.
  if ( ( sn .ge. lbnd(1) + 1 ) .and. ( sn .le. ubnd(1) + 1 ) ) then
    eh_area2(sn-lbnd(1),l) = eh_area_tmp
  end if

end subroutine EHFinder_IntegrateArea


subroutine EHFinder_IntegrateCentroid(CCTK_ARGUMENTS)

  use EHFinder_mod

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: int_var, sn, k, l
  character(len=50) :: info_message
  CCTK_INT, dimension(1) :: lbnd, ubnd, lsh
  CCTK_REAL :: centroid_x, centroid_y, centroid_z

! If finding of surface failed do not try to integrate but exit.
  if ( find_surface_status .lt. 0 ) then
    return
  endif

! Store the levelset_counter in a shorter named variable for convenience.
  l = levelset_counter

! Write an info message, to indicate what we are doing.
  call CCTK_INFO ( 'Integrating centroid' )

  sn = surface_counter - integrate_counter

! Calculate the (x,y,z) coordinates of the points on the surface.
  interp_x = center(1) + rsurf * sintheta * cosphi
  interp_y = center(2) + rsurf * sintheta * sinphi
  interp_z = center(3) + rsurf * costheta

! Get the index to the temporary integration array.
  call CCTK_VarIndex ( int_var, 'ehfinder::int_tmp' )
  if ( int_var .lt. 0 ) then
    call CCTK_WARN ( 0, 'Could not get index to grid array int_tmp' )
  end if

! Take into account the symmetry, weights, x-coordinate and area element
! to calculate the integral of x*da over the surface. This gives 
! centroid_x * Area, so later we divide by the area.
  int_tmp = sym_factor * interp_x * weights * da

! Sum up the all elements of int_tmp.
  call CCTK_Reduce ( ierr, cctkGH, -1, sum_handle, 1, CCTK_VARIABLE_REAL, &
                     centroid_x, 1, int_var )

! Take into account the symmetry, weights, y-coordinate and area element
! to calculate the integral of y*da over the surface. This gives
! centroid_y * Area, so later we divide by the area.
  int_tmp = sym_factor * interp_y * weights * da

! Sum up the all elements of int_tmp.
  call CCTK_Reduce ( ierr, cctkGH, -1, sum_handle, 1, CCTK_VARIABLE_REAL, &
                     centroid_y, 1, int_var )

! Take into account the symmetry, weights, z-coordinate and area element
! to calculate the integral of z*da over the surface. This gives
! centroid_z * Area, so later we divide by the area.
  int_tmp = sym_factor * interp_z * weights * da

! Sum up the all elements of int_tmp.
  call CCTK_Reduce ( ierr, cctkGH, -1, sum_handle, 1, CCTK_VARIABLE_REAL, &
                     centroid_z, 1, int_var )
! If this surface has symmetries set the corresponding centroids to zero.
  if ( s_symx ) centroid_x = zero
  if ( s_symy ) centroid_y = zero
  if ( s_symz ) centroid_z = zero

! Get the bounds for the centroid arrays. It should be enough to do
! it just for the x-array, since they are all defined in the same way.
  call CCTK_GrouplbndGN ( ierr, cctkGH, 1, lbnd, 'ehfinder::eh_centroid2_x' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get lower bounds for centroid array' )
  end if
  call CCTK_GroupubndGN ( ierr, cctkGH, 1, ubnd, 'ehfinder::eh_centroid2_x' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get upper bounds for centroid array' )
  end if
  call CCTK_GrouplshGN ( ierr, cctkGH, 1, lsh, 'ehfinder::eh_centroid2_x' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get local size for centroid array' )
  end if

! If we are on the right processor, store the centroid, otherwise do nothing.
  if ( ( sn .ge. lbnd(1) + 1 ) .and. ( sn .le. ubnd(1) + 1 ) ) then
    k = sn - lbnd(1)
    eh_centroid2_x(k,l) = centroid_x / eh_area2(k,l)
    eh_centroid2_y(k,l) = centroid_y / eh_area2(k,l)
    eh_centroid2_z(k,l) = centroid_z / eh_area2(k,l)
  end if

! Write an info message with the calculated centroids.
  write(info_message,'(a19,3(f10.5))') 'Horizon centroid = ', &
                                       eh_centroid2_x(sn,l), &
                                       eh_centroid2_y(sn,l), &
                                       eh_centroid2_z(sn,l)
  call CCTK_INFO( trim(info_message) )

end subroutine EHFinder_IntegrateCentroid


subroutine EHFinder_IntegrateCircumference(CCTK_ARGUMENTS)

  use EHFinder_mod

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: int_var, sn, k, l
  character(len=50) :: info_message
  CCTK_INT, dimension(1) :: lbnd1, ubnd1, lsh1
  CCTK_INT, dimension(2) :: lbnd, lsh, nghost
  CCTK_INT, dimension(4) :: bbox
  CCTK_INT :: ithl, ithr, jphl, jphr, itha, jpha
  CCTK_REAL :: eq_circ_loc, eq_circ, pol_circ_loc, pol_circ

! If finding of surface failed do not try to integrate but exit.
  if ( find_surface_status .lt. 0 ) then
    return
  endif

! Store the levelset_counter in a shorter named variable for convenience.
  l = levelset_counter

  sn = surface_counter - integrate_counter

  ! Find out the lower bounds of the distributed integration grid arrays.
  call CCTK_GrouplbndGN ( ierr, cctkGH, 2, lbnd, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get lower bounds for surface arrays' )
  end if

  ! Find out the local size of the distributed integration grid arrays
  call CCTK_GrouplshGN ( ierr, cctkGH, 2, lsh, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get local size for surface arrays' )
  end if

  ! Find out the bounding box of the distributed integration grid arrays
  call CCTK_GroupbboxGN ( ierr, cctkGH, 4, bbox, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get bounding box for surface arrays' )
  end if

  ! Find out the ghost size of the distributed integration grid arrays
  call CCTK_GroupnghostzonesGN ( ierr, cctkGH, 2, nghost, &
                                       'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get ghost zones for surface arrays' )
  end if
 
! Initialize the lower and upper local index for the theta and phi arrays.
  ithl = 1; ithr = lsh(1)
  jphl = 1; jphr = lsh(2)
  
! If the boundaries are internal, adjust the lower and upper local index
! to take into account the ghost cells.
  if ( bbox(1) .eq. 0 ) ithl = ithl + nghost(1)
  if ( bbox(2) .eq. 0 ) ithr = ithr - nghost(1)
  if ( bbox(3) .eq. 0 ) jphl = jphl + nghost(2)
  if ( bbox(4) .eq. 0 ) jphr = jphr - nghost(2)

! Write and info message about what we are doing.
  call CCTK_INFO ( 'Integrating equatorial circumference' )

! Setup the integration array for the equatorial circumference
! calculation. Note this is still a 2d-array, so we have to
! do the sum only for the correct 1d-slice of the array.
  int_tmp = phi_sym_factor * phiweights * dlphi

! If we are on a processor that contains part of the correct 1-d slice
! sum up the appropriate elemets, otherwise this processor will
! contribute zero.
  if ( ( ithl+lbnd(1) .le. githeta ) .and. ( githeta .le. ithr+lbnd(1) ) ) then
    itha = githeta - lbnd(1)
    eq_circ_loc = sum ( int_tmp(itha,jphl:jphr) )
  else
    eq_circ_loc = zero
  end if

! Then reduce the results over all processors and send the result to
! all processors.
  call CCTK_ReduceLocScalar ( ierr, cctkGH, -1, sum_handle, &
                              eq_circ_loc, eq_circ, CCTK_VARIABLE_REAL )

! Get the upper and lower bounds for the circumference arrays.
  call CCTK_GrouplbndGN ( ierr, cctkGH, 1, lbnd1, 'ehfinder::eh_circ_eq2' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get lower bounds for area array' )
  end if
  call CCTK_GroupubndGN ( ierr, cctkGH, 1, ubnd1, 'ehfinder::eh_circ_eq2' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get upper bounds for area array' )
  end if
  call CCTK_GrouplshGN ( ierr, cctkGH, 1, lsh1, 'ehfinder::eh_circ_eq2' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get local size for area array' )
  end if

! If we are on the correct processor store the result.
  if ( ( sn .ge. lbnd1(1) + 1 ) .and. ( sn .le. ubnd1(1) + 1 ) ) then
    k = sn - lbnd1(1)
    eh_circ_eq2(k,l) = eq_circ
  end if

! Write an info message with the calculated circunference.
  write(info_message,'(a35,f10.5)') 'Horizon equatorial circumference = ', &
                                    eq_circ
  call CCTK_INFO( trim(info_message) )

! Now do the same for the polar circomference.
  call CCTK_INFO ( 'Integrating polar circumference' )

! Setup the integration array for the polar circumference
! calculation. Note this is still a 2d-array, so we have to
! do the sum only for the correct 1d-slice of the array.
  int_tmp = theta_sym_factor * thetaweights * dltheta

! If we are on a processor that contains part of the correct 1-d slice
! sum up the appropriate elemets, otherwise this processor will
! contribute zero.
  if ( ( jphl+lbnd(2) .le. gjphi ) .and. ( gjphi .le. jphr+lbnd(2) ) ) then
    jpha = gjphi - lbnd(2)
    pol_circ_loc = sum ( int_tmp(ithl:ithr,jpha) )
  else
    pol_circ_loc = zero
  end if

! Then reduce the results over all processors and send the result to
! all processors.
  call CCTK_ReduceLocScalar ( ierr, cctkGH, -1, sum_handle, &
                              pol_circ_loc, pol_circ, CCTK_VARIABLE_REAL )


! If we are on the correct processor store the result.
  if ( ( sn .ge. lbnd1(1) + 1 ) .and. ( sn .le. ubnd1(1) + 1 ) ) then
    k = sn - lbnd1(1)
    eh_circ_pol2(k,l) = pol_circ
  end if

! Write an info message with the calculated circumference.
  write(info_message,'(a30,f10.5)') 'Horizon polar circumference = ',pol_circ
  call CCTK_INFO( trim(info_message) )
  
end subroutine EHFinder_IntegrateCircumference


! This routine sets up the weights for the Simpsons rule integration
! over the surface.
subroutine EHFinder_InitWeights(CCTK_ARGUMENTS)

  use EHFinder_mod

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k, im, jm

  CCTK_INT, dimension(4) :: bbox
  CCTK_INT, dimension(2) :: gsh, lsh, lbnd, ubnd, nghost

! Find out the lower bounds of the distributed integration grid arrays.
  call CCTK_GrouplbndGN ( ierr, cctkGH, 2, lbnd, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get lower bounds for surface arrays' )
  end if

! Find out the local size of the distributed integration grid arrays
  call CCTK_GrouplshGN ( ierr, cctkGH, 2, lsh, 'ehfinder::surface_arrays' )
  if ( ierr .lt. 0 ) then
    call CCTK_WARN ( 0, 'cannot get local size for surface arrays' )
  end if

  weights = one

! Initialise the weight grid array for the 2D Simpsons rule integration.
! To do this I need to figure out the global location of the given point.
! There are 3 cases in the one dimensional case. If the point is on the
!  boundary the weight is 1/3. If it is at an even position the weight
! is 4/3 and if it is at an odd position the weight is 2/3. 

  do j = 1, lsh(2)

!   This is first done in the phi direction. Meaning that all points with
!   the same theta coordinate are set to the same weight.
    if ( ( lbnd(2)+j .eq. 1 ) .or. ( lbnd(2)+j .eq. nphi ) ) then
      weights(:,j) = onethird
      phiweights(:,j) = onethird
    else if ( mod(lbnd(2)+j,2) .eq. 0 ) then
      weights(:,j) = fourthirds
      phiweights(:,j) = fourthirds
    else
      weights(:,j) = twothirds
      phiweights(:,j) = twothirds
    end if

!   Then it is done in the theta direction with the one-dimensional
!   weights beeing multiplied.
    do i = 1, lsh(1)
      if ( ( lbnd(1)+i .eq. 1 ) .or. ( lbnd(1)+i .eq. ntheta ) ) then
        weights(i,j) = onethird * weights(i,j)
        thetaweights(i,j) = onethird
      else if ( mod(lbnd(1)+i,2) .eq. 0 ) then
        weights(i,j) = fourthirds * weights(i,j)
        thetaweights(i,j) = fourthirds
      else
        weights(i,j) = twothirds * weights(i,j)
        thetaweights(i,j) = twothirds
      end if
    end do
  end do

! The end result is a 2D array with the weights in the following pattern.

!  1/9   4/9  2/9   4/9  2/9   4/9  1/9
!  4/9  16/9  8/9  16/9  8/9  16/9  4/9
!  2/9   8/9  4/9   8/9  4/9   8/9  2/9
!  4/9  16/9  8/9  16/9  8/9  16/9  4/9
!  2/9   8/9  4/9   8/9  4/9   8/9  2/9
!  4/9  16/9  8/9  16/9  8/9  16/9  4/9
!  1/9   4/9  2/9   4/9  2/9   4/9  1/9
end subroutine EHFinder_InitWeights


! This is the routine where the stored areas (in eh_area2) are copied
! into the trigger variable eh_area.
subroutine EHFinder_CopyArea(CCTK_ARGUMENTS)

  use EHFinder_mod

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

! If finding of surface failed set area to zero.
  if ( find_surface_status .lt. 0 ) then
    eh_area = zero
    return
  else
    call CCTK_INFO('Copying area data')
    eh_area = eh_area2
  endif
end subroutine EHFinder_CopyArea


! This is the routine where the stored centroids (in eh_centroid2_[xyz])
! are copied into the trigger variable eh_centroid_[xyz].
subroutine EHFinder_CopyCentroid(CCTK_ARGUMENTS)

  use EHFinder_mod

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

! If finding of surface failed set centroids to zero.
  if ( find_surface_status .lt. 0 ) then
    eh_centroid_x = zero
    eh_centroid_y = zero
    eh_centroid_z = zero
    return
  else
    call CCTK_INFO('Copying centroid data')
    eh_centroid_x = eh_centroid2_x
    eh_centroid_y = eh_centroid2_y
    eh_centroid_z = eh_centroid2_z
  end if

end subroutine EHFinder_CopyCentroid


! This is the routine where the stored circumferences (in eh_circ_[eq,pol]2)
! are copied into the trigger variable eh_circ_[eq,pol].
subroutine EHFinder_CopyCircumference(CCTK_ARGUMENTS)

  use EHFinder_mod

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  if ( find_surface_status .lt. 0 ) then
    eh_circ_eq = zero
    eh_circ_pol = zero
    return
  else
    call CCTK_INFO('Copying circumference data')
    eh_circ_eq = eh_circ_eq2
    eh_circ_pol = eh_circ_pol2
  end if

end subroutine EHFinder_CopyCircumference