!> @file regul_tools.f90
!! @brief  routines to compute the gradient of a discretized (finite differences) function
!! @author Innocent Souopgui
!! @version 1.0
!<
MODULE regul_tools
  USE general_constant
  USE debug_tools
IMPLICIT NONE

  !> @brief  Method used to compute the gradient
  INTEGER, PARAMETER ::&
    BACKWARD = 17001,&
    FORWARD  = 17002,&
    CENTERED = 17003
  !>default value for constant grid spacing step

  !> @brief  interface for gradient approximation
  INTERFACE gradient
    MODULE PROCEDURE gradient_cs_1d!constant spacing
    MODULE PROCEDURE gradient_vs_1d!variable spacing
    MODULE PROCEDURE gradient_cs_2d!constant spacing
    !MODULE PROCEDURE gradient_vs_2d!variable spacing
    !MODULE PROCEDURE gradient_cs_3d!constant spacing
    !MODULE PROCEDURE gradient_vs_3d!variable spacing
  END INTERFACE gradient

  !> @brief  interface for gradient approximation using centered differences
  INTERFACE gradient_centered
    MODULE PROCEDURE gradient_ccs_1d!constant spacing
    !MODULE PROCEDURE gradient_cvs_1d!variable spacing
    MODULE PROCEDURE gradient_ccs_2d!constant spacing
    !MODULE PROCEDURE gradient_cvs_2d!variable spacing
    !MODULE PROCEDURE gradient_ccs_3d!constant spacing
    !MODULE PROCEDURE gradient_cvs_3d!variable spacing
  END INTERFACE gradient_centered

  !> @brief  interface for gradient approximation using forward differences
  INTERFACE gradient_forward
    MODULE PROCEDURE gradient_fcs_1d!constant spacing
    MODULE PROCEDURE gradient_fvs_1d!variable spacing
    MODULE PROCEDURE gradient_fcs_2d!constant spacing
    !MODULE PROCEDURE gradient_fvs_2d!variable spacing
    !MODULE PROCEDURE gradient_fcs_3d!constant spacing
    !MODULE PROCEDURE gradient_fvs_3d!variable spacing
  END INTERFACE gradient_forward

  !> @brief  interface for gradient approximation using backward differences
  INTERFACE gradient_backward
    MODULE PROCEDURE gradient_bcs_1d!constant spacing
    MODULE PROCEDURE gradient_bvs_1d!variable spacing
    MODULE PROCEDURE gradient_bcs_2d!constant spacing
    !MODULE PROCEDURE gradient_bvs_2d!variable spacing
    !MODULE PROCEDURE gradient_bcs_3d!constant spacing
    !MODULE PROCEDURE gradient_bvs_3d!variable spacing
  END INTERFACE gradient_backward

  !> @brief  interface for geostrophic_wind
  INTERFACE geostrophic_wind
    MODULE PROCEDURE geostrophic_wind_cgrid !>"staggered" Arakawa C-grid
  END INTERFACE geostrophic_wind

  !> @brief  interface for gradient regularization
  !! @details  Due to nonlinearities and the function implementation, the choice has been made to not accept default parameters; This made it easy to write adjoint code
  !<
  INTERFACE grad_regul
    MODULE PROCEDURE grad_regul_cs_1d!constant spacing
    MODULE PROCEDURE grad_regul_cs_1d_default!constant spacing with default value 1.0
    MODULE PROCEDURE grad_regul_vs_1d!variable spacing
    MODULE PROCEDURE grad_regul_cs_2d!constant spacing
    MODULE PROCEDURE grad_regul_cs_v2d!2d arrays are vectorized
    MODULE PROCEDURE grad_regul_cs_2d_default!constant spacing with default value 1.0
    MODULE PROCEDURE grad_regul_cs_v2d_default!2d arrays are vectorized
    !MODULE PROCEDURE grad_regul_vs_2d!variable spacing
    !MODULE PROCEDURE grad_regul_cs_3d!constant spacing
    !MODULE PROCEDURE grad_regul_cs_3d_default!constant spacing with default value 1.0
    !MODULE PROCEDURE grad_regul_vs_3d!variable spacing
  END INTERFACE grad_regul

  INTERFACE tikhonov_regul
    MODULE PROCEDURE tikhonov_regul_1d
    MODULE PROCEDURE tikhonov_regul_2d
  END INTERFACE tikhonov_regul

  INTERFACE geostrophic_regul
    !MODULE PROCEDURE tikhonov_regul_1d
    MODULE PROCEDURE geostrophic_regul_cgrid
  END INTERFACE geostrophic_regul

  !> @brief  interface for square L2 norm
  INTERFACE square_L2_norm
    MODULE PROCEDURE square_L2_norm_1d
    MODULE PROCEDURE square_L2_norm_2d
    !MODULE PROCEDURE square_L2_norm_3d
  END INTERFACE square_L2_norm

CONTAINS

  !>simple function used to set the discretization step
  FUNCTION disc_step(rd_dx) RESULT(rl_dx)
    REAL(KIND=cp), OPTIONAL, INTENT(IN) :: rd_dx !! dxspace step
    !local variables
    REAL(KIND=cp) :: rl_dx
    IF( PRESENT(rd_dx) )THEN
      rl_dx = rd_dx
    ELSE
      rl_dx = 1.0_cp
    END IF
  END FUNCTION disc_step

  !> @brief  Computes the square of the L2 norm of a discretized scalar function of one variable
  !! @param [in] rda_f function whose the L2 norm is requested
  !<
  FUNCTION square_L2_norm_1d(rda_f) RESULT(rl_l2)
    REAL(KIND=cp), DIMENSION(:),   INTENT(IN)  :: rda_f!!scalar field
    REAL(KIND=cp) :: rl_l2

    rl_l2 = 0.5_cp*SUM(rda_f**2)
  END FUNCTION square_L2_norm_1d

  !> @brief  Computes the square of the L2 norm of a discretized scalar function of two variables
  !! @param [in] rda_f function whose the L2 norm is requested
  !<
  FUNCTION square_L2_norm_2d(rda_f) RESULT(rl_l2)
    REAL(KIND=cp), DIMENSION(:, :),   INTENT(IN)  :: rda_f!!scalar field
    REAL(KIND=cp) :: rl_l2

    rl_l2 = 0.5_cp*SUM(rda_f**2)
  END FUNCTION square_L2_norm_2d

  !> @brief  Computes the gradient of a scalar function of one variable, constant spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_df gradient
  !! @param [in] rd_dx optional, discretization step
  !! @param [in] method method used for computation
  !! @details  If the discretization step is not given, it is assumed to be 1.0
  !<
  SUBROUTINE gradient_cs_1d(rda_f, rda_df, method, rd_dx)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN)  :: rda_f !!scalar vector fieldwhich gradient is to be computed
    REAL(KIND=cp), DIMENSION(:), INTENT(OUT) :: rda_df!!gradient
    INTEGER,                     INTENT(IN)  :: method
    REAL(KIND=cp), OPTIONAL,     INTENT(IN)  :: rd_dx !! dxspace step
    !local variables
    REAL(KIND=cp) :: rl_dx

    rl_dx = disc_step(rd_dx)
    SELECT CASE (method)
      CASE(BACKWARD)
        CALL gradient_bcs_1d(rda_f, rda_df, rl_dx)
      CASE(FORWARD)
        CALL gradient_fcs_1d(rda_f, rda_df, rl_dx)
      CASE(CENTERED)
        CALL gradient_ccs_1d(rda_f, rda_df, rl_dx)
    END SELECT
  END SUBROUTINE gradient_cs_1d

  !> @brief  Computes the gradient of a scalar function of two variables, constant spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_fx gradient along the first direction
  !! @param [out] rda_fy gradient along the second direction
  !! @param [in] rd_dx discretization step in the first direction
  !! @param [in] rd_dy discretization step in the second direction
  !! @param [in] method method used for computation
  !! @details  If the discretization steps are not given, they are assumed to be 1.0
  !<
  SUBROUTINE gradient_cs_2d(rda_f, rda_fx, rda_fy, method, rd_dx, rd_dy)
    REAL(KIND=cp), DIMENSION(:, :), INTENT(IN)  :: rda_f!!scalar vector field which gradient is to be computed
    REAL(KIND=cp), DIMENSION(:, :), INTENT(OUT) :: rda_fx, rda_fy!!x (resp. y) component of the gradient
    INTEGER,  INTENT(IN)  :: method
    REAL(KIND=cp), OPTIONAL,        INTENT(IN)  :: rd_dx, rd_dy!! x(resp. y) space step
    !local variables
    REAL(KIND=cp)                               :: rl_dx, rl_dy!! x(resp. y) space step

    rl_dx = disc_step(rd_dx)
    rl_dy = disc_step(rd_dy)
    SELECT CASE (method)
      CASE(BACKWARD)
        CALL gradient_bcs_2d(rda_f, rda_fx, rda_fy, rl_dx, rl_dy)
      CASE(FORWARD)
        CALL gradient_fcs_2d(rda_f, rda_fx, rda_fy, rl_dx, rl_dy)
      CASE(CENTERED)
        CALL gradient_ccs_2d(rda_f, rda_fx, rda_fy, rl_dx, rl_dy)
    END SELECT
  END SUBROUTINE gradient_cs_2d

  !> @brief  Computes the gradient of a scalar function of one variable, variable spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_df gradient
  !! @param [in] rda_x discretization step in the first direction
  !! @param [in] method method used for computation
  !<
  SUBROUTINE gradient_vs_1d(rda_f, rda_df, method, rda_x)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN)  :: rda_f, rda_x
    REAL(KIND=cp), DIMENSION(:), INTENT(OUT) :: rda_df
    INTEGER,                     INTENT(IN)  :: method

    SELECT CASE (method)
      CASE(BACKWARD)
        CALL gradient_bvs_1d(rda_f, rda_df, rda_x)
      CASE(FORWARD)
        CALL gradient_fvs_1d(rda_f, rda_df, rda_x)
      CASE(CENTERED)
        CALL stop_program('In gradient_vs_1d: the centered approximation is not yet implemented for variable spacing grid')
        !CALL gradient_cvs_1d(rda_f, rda_df, rda_x)
    END SELECT
  END SUBROUTINE gradient_vs_1d

  !> @brief  Computes the gradient of a scalar function of one variable, centered differences, constant spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_df gradient
  !! @param [in] rd_dx discretization step
  !! @details  gradient of a scalar fields, center diferences on the interior and decentered difference on the boundaries
  !<
  SUBROUTINE gradient_ccs_1d(rda_f, rda_df, rd_dx)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN)  :: rda_f !!scalar vector fieldwhich gradient is to be computed
    REAL(KIND=cp), DIMENSION(:), INTENT(OUT) :: rda_df!!gradient
    REAL(KIND=cp),               INTENT(IN)  :: rd_dx !! dxspace step
    INTEGER :: n

    n = SIZE(rda_f)
    rda_df(2:n-1) = ( rda_f(3:n) - rda_f(1:n-2) )/(2*rd_dx)!interior point, centered diff
    rda_df(1    ) = ( rda_f(2  ) - rda_f(1    ) )/rd_dx!left boundary, forward difference
    rda_df(n    ) = ( rda_f(n  ) - rda_f(n - 1) )/rd_dx!right boundary, backward difference
  END SUBROUTINE gradient_ccs_1d

  !> @brief  Computes the gradient of a scalar function of two variables, centered differences, constant spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_fx gradient along the first direction
  !! @param [out] rda_fy gradient along the second direction
  !! @param [in] rd_dx discretization step in the first direction
  !! @param [in] rd_dy discretization step in the second direction
  !! @details  gradient of a scalar fields, center diferences on the interior and decentered difference on the boundaries
  !<
  SUBROUTINE gradient_ccs_2d(rda_f, rda_fx, rda_fy, rd_dx, rd_dy)
    REAL(KIND=cp), DIMENSION(:, :), INTENT(IN)  :: rda_f!!scalar vector fieldwhich gradient is to be computed
    REAL(KIND=cp), DIMENSION(:, :), INTENT(OUT) :: rda_fx, rda_fy!!x (resp. y) component of the gradient
    REAL(KIND=cp),                  INTENT(IN)  :: rd_dx, rd_dy!! x(resp. y) space step
    INTEGER :: nx, ny

    nx = SIZE(rda_f, 1)
    ny = SIZE(rda_f, 2)
    !x component
    rda_fx(2:nx-1, :) = ( rda_f(3:nx, :) - rda_f(1:nx-2, :) )/(2*rd_dx)!x : interior point, centered diff
    rda_fx(1     , :) = ( rda_f(2   , :) - rda_f(1     , :) )/rd_dx!left boundary, forward difference
    rda_fx(nx    , :) = ( rda_f(nx  , :) - rda_f(nx - 1, :) )/rd_dx!right boundary, backward difference
    !y component
    rda_fy(:, 2:ny-1) = ( rda_f(:, 3:ny) - rda_f(:, 1:ny-2) )/(2*rd_dy)!y : interior point, centered diff
    rda_fy(:, 1     ) = ( rda_f(:, 2   ) - rda_f(:, 1     ) )/rd_dy!bottom boundary, forward difference
    rda_fy(:, ny    ) = ( rda_f(:, ny  ) - rda_f(:, ny - 1) )/rd_dy!upper boundary, backward difference
  END SUBROUTINE gradient_ccs_2d

  !> @brief  Computes the gradient of a scalar function of one variable, forward differences, constant spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_df gradient
  !! @param [in] rd_dx discretization step in the first direction
  !<
  SUBROUTINE gradient_fcs_1d(rda_f, rda_df, rd_dx)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN)  :: rda_f !!scalar function which gradient is required
    REAL(KIND=cp), DIMENSION(:), INTENT(OUT) :: rda_df!!gradient
    REAL(KIND=cp),               INTENT(IN)  :: rd_dx !! x(resp. y) space step
    INTEGER :: n

    n = SIZE(rda_f)
    rda_df(1:n-1) = ( rda_f(2:n) - rda_f(1:n-1) )/rd_dx!x : interior point, forward diff
    rda_df(n    ) = ( rda_f(n  ) - rda_f(n - 1) )/rd_dx!right boundary, backward difference
  END SUBROUTINE gradient_fcs_1d

  !> @brief  Computes the gradient of a scalar function of one variable, forward differences, variable spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_df gradient
  !! @param [in] rda_x discretization step in the first direction
  !<
  SUBROUTINE gradient_fvs_1d(rda_f, rda_df, rda_x)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN)  :: rda_f, rda_x
    REAL(KIND=cp), DIMENSION(:), INTENT(OUT) :: rda_df
    INTEGER :: n

    n = SIZE(rda_f)
    rda_df(1:n-1) = ( rda_f(2:n) - rda_f(1:n-1) )/( rda_x(2:n)-rda_x(1:n-1) )!x : interior point, forward diff
    rda_df(n    ) = ( rda_f(n  ) - rda_f(n - 1) )/( rda_x(n  )-rda_x(n-1  ) )!right bound, back diff
  END SUBROUTINE gradient_fvs_1d

  !> @brief  Computes the gradient of a scalar function of two variables, forward differences, constant spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_fx gradient along the first direction
  !! @param [out] rda_fy gradient along the second direction
  !! @param [in] rd_dx discretization step in the first direction
  !! @param [in] rd_dy discretization step in the second direction
  !<
  SUBROUTINE gradient_fcs_2d(rda_f, rda_fx, rda_fy, rd_dx, rd_dy)
    REAL(KIND=cp), DIMENSION(:, :),   INTENT(IN)  :: rda_f!!scalar vector field which gradient is to be computed
    REAL(KIND=cp), DIMENSION(:, :),   INTENT(OUT) :: rda_fx, rda_fy!!x (resp. y) component of the gradient
    REAL(KIND=cp),                    INTENT(IN)  :: rd_dx, rd_dy!! x(resp. y) space step
    INTEGER :: nx, ny

    nx = SIZE(rda_f, 1)
    ny = SIZE(rda_f, 2)
    !x component
    rda_fx(1:nx-1, :) = ( rda_f(2:nx, :) - rda_f(1:nx-1, :) )/rd_dx!x : forward difference
    rda_fx(nx    , :) = ( rda_f(nx  , :) - rda_f(nx - 1, :) )/rd_dx!right boundary, backward difference
    !y component
    rda_fy(:, 1:ny-1) = ( rda_f(:, 2:ny) - rda_f(:, 1:ny-1) )/rd_dy!y : interior point, forward diff
    rda_fy(:, ny    ) = ( rda_f(:, ny  ) - rda_f(:, ny - 1) )/rd_dy!upper boundary, backward difference
  END SUBROUTINE gradient_fcs_2d

  !> @brief  Computes the gradient of a scalar function of one variable, backward differences, constant spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_df gradient
  !! @param [in] rd_dx discretization step in the first direction
  !<
  SUBROUTINE gradient_bcs_1d(rda_f, rda_df, rd_dx)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN)  :: rda_f !!scalar function which gradient is required
    REAL(KIND=cp), DIMENSION(:), INTENT(OUT) :: rda_df!!gradient
    REAL(KIND=cp),               INTENT(IN)  :: rd_dx !! x(resp. y) space step
    INTEGER :: n

    n = SIZE(rda_f)
    rda_df(1  ) = ( rda_f(2  ) - rda_f(1    ) )/rd_dx!left boundary, forward difference
    rda_df(2:n) = ( rda_f(2:n) - rda_f(1:n-1) )/rd_dx!x : interior point, forward diff
  END SUBROUTINE gradient_bcs_1d

  !> @brief  Computes the gradient of a scalar function of one variable, backward differences, variable spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_df gradient
  !! @param [in] rda_x discretization points
  !<
  SUBROUTINE gradient_bvs_1d(rda_f, rda_df, rda_x)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN)  :: rda_f, rda_x
    REAL(KIND=cp), DIMENSION(:), INTENT(OUT) :: rda_df
    INTEGER :: n

    n = SIZE(rda_f)
    rda_df(1  ) = ( rda_f(2  ) - rda_f(1    ) )/( rda_x(2  )-rda_x(1    ) )!left bound, forward diff
    rda_df(2:n) = ( rda_f(2:n) - rda_f(1:n-1) )/( rda_x(2:n)-rda_x(1:n-1) )!x : interior point, forward diff
  END SUBROUTINE gradient_bvs_1d

  !> @brief  Computes the gradient of a scalar function of two variables, backward differences, constant spacing grid
  !! @param [in] rda_f function whose the gradient is required
  !! @param [out] rda_fx gradient along the first direction
  !! @param [out] rda_fy gradient along the second direction
  !! @param [in] rd_dx discretization step in the first direction
  !! @param [in] rd_dy discretization step in the second direction
  !<
  SUBROUTINE gradient_bcs_2d(rda_f, rda_fx, rda_fy, rd_dx, rd_dy)
    REAL(KIND=cp), DIMENSION(:, :),   INTENT(IN)  :: rda_f!!scalar vector field which gradient is to be computed
    REAL(KIND=cp), DIMENSION(:, :),   INTENT(OUT) :: rda_fx, rda_fy!!x (resp. y) component of the gradient
    REAL(KIND=cp),                    INTENT(IN)  :: rd_dx, rd_dy!! x(resp. y) space step
    INTEGER :: nx, ny

    nx = SIZE(rda_f, 1)
    ny = SIZE(rda_f, 2)
    !x component
    rda_fx(1   , :) = ( rda_f(2   , :) - rda_f(1     , :) )/rd_dx!left boundary, forward difference
    rda_fx(2:nx, :) = ( rda_f(2:nx, :) - rda_f(1:nx-1, :) )/rd_dx!x : backward difference
    !y component
    rda_fy(:, 1   ) = ( rda_f(:, 2   ) - rda_f(:, 1     ) )/rd_dy!bottom boundary, forward difference
    rda_fy(:, 2:ny) = ( rda_f(:, 2:ny) - rda_f(:, 1:ny-1) )/rd_dy!y : interior point, backward diff
  END SUBROUTINE gradient_bcs_2d

  !geostrophic equilibrium tools

  !> @brief  Computes the theoretical wind that results from an exact balance between the Coriolis effect and the pressure gradient force
  !! @param [in] rda_h surface elevation or pressure
  !! @param [out] rda_u u component of the wind
  !! @param [out] rda_v v component of the wind
  !! @param [in] rd_dx space step in x direction
  !! @param [in] rd_dy space step in y direction
  !! @param [in] rd_g gravitational parameter
  !! @param [in] rda_fu Coriolis parameter at u location (fu varies only in the y direction)
  !! @param [in] rda_fv Coriolis parameter at v location (fv varies only in the y direction)
  !! @details
  !! The "staggered" Arakawa C-grid is assumed,
  !! it is supposeed that velocity components are not stored
  !! for faces that coincide with the boundary. So that
  !! the array h has 1 more element in the x direction (first index)
  !! than v, and 1 more element in the y direction (second index) than u.
  !! Decentered difference is used for the approximation of the gradient.
  !! Since each variable is stored at its own location,
  !! linear interpolation is used to approximate h at each point.
  !! call as CALL geostrophic_wind_cgrid(rda_h, rda_u, rda_v, td_gp%dx, td_gp%dy, td_sw%r_g, rga_fu, rga_fv)
  !<
  SUBROUTINE geostrophic_wind_cgrid(rda_h, rda_u, rda_v, rd_dx, rd_dy, rd_g, rda_fu, rda_fv)
    REAL(KIND=cp), DIMENSION(:,:), INTENT(IN)  :: rda_h
    REAL(KIND=cp), DIMENSION(:,:), INTENT(OUT) :: rda_u
    REAL(KIND=cp), DIMENSION(:,:), INTENT(OUT) :: rda_v
    REAL(KIND=cp), DIMENSION(:)  , INTENT(IN)  :: rda_fu, rda_fv
    REAL(KIND=cp), INTENT(IN) :: rd_dx, rd_dy, rd_g
    !Local variables
    INTEGER :: i0, im, j0, jm, ibi, ibj

    i0 = 1
    im = SIZE(rda_h, 1)
    j0 = 1
    jm = SIZE(rda_h, 2)
    DO ibj = 1, jm-1
      rda_u(:, ibj) = -rd_g/rda_fu(ibj) * (&
        ( rda_h(i0:im-1,ibj+1)+rda_h(i0+1:im,ibj+1) ) - (  rda_h(i0:im-1,ibj)+rda_h(i0+1:im,ibj) )&
      ) / (2.0_cp*rd_dy)
      !note, the factor 2 is used for the interpolation or average
    END DO
    !left differences for the to top row
    ibj = jm
    rda_u(:, ibj) = -rd_g/rda_fu(ibj) * (&
      ( rda_h(i0:im-1,ibj)+rda_h(i0+1:im,ibj) ) - (  rda_h(i0:im-1,ibj-1)+rda_h(i0+1:im,ibj-1) )&
    ) / (2.0_cp*rd_dy)

    DO ibi = 1, im-1
      rda_v(ibi,:) = rd_g/rda_fv * (&
        ( rda_h(ibi+1,j0:jm-1)+rda_h(ibi+1,j0+1:jm) )&
        - ( rda_h(ibi,j0:jm-1)+rda_h(ibi,j0+1:jm) )&
      ) / (2.0_cp*rd_dx)
    END DO
    !left differences for the to top row
    ibi = im
    rda_v(ibi,:) = rd_g/rda_fv * (&
      ( rda_h(ibi,j0:jm-1)+rda_h(ibi,j0+1:jm) ) - ( rda_h(ibi-1,j0:jm-1)+rda_h(ibi-1,j0+1:jm) )&
    ) / (2.0_cp*rd_dx)
  END SUBROUTINE geostrophic_wind_cgrid

  !> @brief  Computes the gradient regularization term associated with a scalar function of one variable
  !! @param [in] rda_f function whose the the gradient regularization term is required
  !! @param [in] method method used for computation
  !! @param [in] rd_dx discretization step
  !! @details  constant spacing grid
  !<
  FUNCTION grad_regul_cs_1d(rda_f, method, rd_dx) RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN) :: rda_f
    INTEGER,                     INTENT(IN) :: method
    REAL(KIND=cp),               INTENT(IN) :: rd_dx
    !local variables
    REAL(KIND=cp), DIMENSION( SIZE(rda_f) ) :: rla_fx!!gradient
    REAL(KIND=cp)                           :: rl_reg !! Regularization term

    CALL gradient(rda_f, rla_fx, method, rd_dx)
    rl_reg = square_L2_norm(rla_fx)
  END FUNCTION grad_regul_cs_1d

  !> @brief  Computes the gradient regularization term associated with a scalar function of one variable
  !! @param [in] rda_f function whose the the gradient regularization term is required
  !! @param [in] method method used for computation
  !! @details  constant spacing grid with default value 1.0
  !<
  FUNCTION grad_regul_cs_1d_default(rda_f, method) RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN) :: rda_f
    INTEGER,                     INTENT(IN) :: method
    !local variables
    !REAL(KIND=cp), DIMENSION( SIZE(rda_f) ) :: rla_fx!!gradient
    REAL(KIND=cp)                           :: rl_reg, rl_dx !! Regularization term

    rl_dx  = disc_step()
    rl_reg = grad_regul_cs_1d(rda_f, method, rl_dx)
  END FUNCTION grad_regul_cs_1d_default

  !> @brief  Computes the gradient regularization term associated with a scalar function of one variable
  !! @param [in] rda_f function whose the the gradient regularization term is required
  !! @param [in] method method used for computation
  !! @param [in] rda_x discretization points
  !! @details  variable spacing grid
  !<
  FUNCTION grad_regul_vs_1d(rda_f, method, rda_x) RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN) :: rda_f, rda_x
    INTEGER,                     INTENT(IN) :: method
    !local variables
    REAL(KIND=cp), DIMENSION( SIZE(rda_f) ) :: rla_fx!!gradient
    REAL(KIND=cp)                           :: rl_reg !! Regularization term

    CALL gradient(rda_f, rla_fx, method, rda_x)
    rl_reg = square_L2_norm(rla_fx)
  END FUNCTION grad_regul_vs_1d

  !> @brief  Computes the gradient regularization term associated with a scalar function of two variables
  !! @param [in] rda_f function whose the the gradient regularization term is required
  !! @param [in] method method used for computation
  !! @param [in] rd_dx discretization step in the first direction
  !! @param [in] rd_dy discretization step in the second direction
  !! @details  constant spacing grid
  !<
  FUNCTION grad_regul_cs_2d(rda_f, method, rd_dx, rd_dy) RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:, :), INTENT(IN) :: rda_f
    INTEGER,                     INTENT(IN)    :: method
    REAL(KIND=cp),               INTENT(IN)    :: rd_dx, rd_dy
    !local variables
    REAL(KIND=cp), DIMENSION( SIZE(rda_f,1), SIZE(rda_f,2) )    :: rla_fx, rla_fy!!gradient
    REAL(KIND=cp)                              :: rl_reg, rl_regx, rl_regy !! Regularization term

    CALL gradient(rda_f, rla_fx, rla_fy, method, rd_dx, rd_dy)
    rl_regx = square_L2_norm(rla_fx)
    rl_regy = square_L2_norm(rla_fy)
    rl_reg  = rl_regx + rl_regy
  END FUNCTION grad_regul_cs_2d

  !> @brief  Computes the gradient regularization term associated with a scalar function of two variables
  !! \see grad_regul_cs_2d
  !! @details  the difference is that the arrays parameters are vectorized
  !<
  FUNCTION grad_regul_cs_v2d(rda_f, id_nx, id_ny, method, rd_dx, rd_dy) RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN) :: rda_f
    INTEGER,                     INTENT(IN) :: method, id_nx, id_ny
    REAL(KIND=cp),               INTENT(IN) :: rd_dx, rd_dy
    !local variables
    REAL(KIND=cp), DIMENSION(id_nx, id_ny)  :: rla_f
    REAL(KIND=cp)                           :: rl_reg !! Regularization term

    rla_f  = RESHAPE(rda_f, (/id_nx, id_ny/) )
    rl_reg = grad_regul_cs_2d(rla_f, method, rd_dx, rd_dy)
  END FUNCTION grad_regul_cs_v2d

  !> @brief  Computes the gradient regularization term associated with a scalar function of two variables
  !! @param [in] rda_f function whose the the gradient regularization term is required
  !! @param [in] method method used for computation
  !! @details  constant spacing grid with default value 1.0
  !<
  FUNCTION grad_regul_cs_2d_default(rda_f, method) RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:, :), INTENT(IN) :: rda_f
    INTEGER,                        INTENT(IN) :: method
    !local variables
    REAL(KIND=cp)                           :: rl_dx, rl_dy
    REAL(KIND=cp)                           :: rl_reg !! Regularization term

    rl_dx  = disc_step()
    rl_dy  = disc_step()
    rl_reg = grad_regul_cs_2d(rda_f, method, rl_dx, rl_dy)
  END FUNCTION grad_regul_cs_2d_default

  !> @brief  Computes the gradient regularization term associated with a scalar function of two variables
  !! \see grad_regul_cs_2d_default
  !! @details  the difference is that the arrays parameters are vectorized
  !<
  FUNCTION grad_regul_cs_v2d_default(rda_f, id_nx, id_ny, method) RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN) :: rda_f
    INTEGER,                     INTENT(IN) :: method, id_nx, id_ny
    !local variables
    REAL(KIND=cp), DIMENSION(id_nx, id_ny)  :: rla_f
    REAL(KIND=cp)                  :: rl_dx, rl_dy
    REAL(KIND=cp)                  :: rl_reg !! Regularization term

    rl_dx  = disc_step()
    rl_dy  = disc_step()
    rla_f  = RESHAPE(rda_f, (/id_nx, id_ny/) )
    rl_reg = grad_regul_cs_2d(rla_f, method, rl_dx, rl_dy)
  END FUNCTION grad_regul_cs_v2d_default

  !> @brief  Compute the Tikhonov regularization term
  !! @param [in] rda_f variable on which the regularization is computed
  !! @param [in] rda_bf background estimation of rda_f
  !<
  FUNCTION tikhonov_regul_1d(rda_f, rda_bf) RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:), INTENT(IN) :: rda_f
    REAL(KIND=cp), DIMENSION(:), OPTIONAL, INTENT(IN) :: rda_bf
    !local variables
    REAL(KIND=cp)                  :: rl_reg !! Regularization term
    REAL(KIND=cp), DIMENSION(SIZE(rda_f,1)) :: rla_f

    IF( PRESENT(rda_bf) )THEN
      rla_f = rda_f - rda_bf
    ELSE
      rla_f = rda_f
    END IF
    rl_reg = square_L2_norm(rla_f)
  END FUNCTION tikhonov_regul_1d

  !> @brief  Compute the Tikhonov regularization term
  !! @param [in] rda_f variable on which the regularization is computed
  !! @param [in] rda_bf background estimation of rda_f
  !<
  FUNCTION tikhonov_regul_2d(rda_f, rda_bf) RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:,:), INTENT(IN) :: rda_f
    REAL(KIND=cp), DIMENSION(:,:), OPTIONAL, INTENT(IN) :: rda_bf
    !local variables
    REAL(KIND=cp)                  :: rl_reg !! Regularization term
    REAL(KIND=cp), DIMENSION(SIZE(rda_f,1),SIZE(rda_f,2)) :: rla_f

    IF( PRESENT(rda_bf) )THEN
      rla_f = rda_f - rda_bf
    ELSE
      rla_f = rda_f
    END IF
    rl_reg = square_L2_norm(rla_f)
  END FUNCTION tikhonov_regul_2d

  !> @brief  Computes the regulaisation term that measures the distance between the estimated wind and the geostrophic wind
  !! @param [in] rda_h surface elevation or pressure
  !! @param [out] rda_u u component of the wind
  !! @param [out] rda_v v component of the wind
  !! @param [in] rd_dx space step in x direction
  !! @param [in] rd_dy space step in y direction
  !! @param [in] rd_g gravitational parameter
  !! @param [in] rda_fu Coriolis parameter at u location (fu varies only in the y direction)
  !! @param [in] rda_fv Coriolis parameter at v location (fv varies only in the y direction)
  !! The "staggered" Arakawa C-grid is assumed
  !! call as geostrophic_regul(rda_h, rda_u, rda_v, td_gp%dx, td_gp%dy, td_sw%r_g, rga_fu, rga_fv)
  !<
  FUNCTION geostrophic_regul_cgrid(rda_h, rda_u, rda_v, rd_dx, rd_dy, rd_g, rda_fu, rda_fv)RESULT(rl_reg)
    REAL(KIND=cp), DIMENSION(:,:), INTENT(IN) :: rda_h, rda_u, rda_v
    REAL(KIND=cp), DIMENSION(:)  , INTENT(IN)  :: rda_fu, rda_fv
    REAL(KIND=cp), INTENT(IN) :: rd_dx, rd_dy, rd_g
    !local variables
    REAL(KIND=cp) :: rl_reg, rl_regu, rl_regv !! Regularization term
    REAL(KIND=cp), DIMENSION(SIZE(rda_u,1),SIZE(rda_u,2)) :: rla_gu, rla_du
    REAL(KIND=cp), DIMENSION(SIZE(rda_v,1),SIZE(rda_v,2)) :: rla_gv, rla_dv

    CALL geostrophic_wind_cgrid(rda_h, rla_gu, rla_gv, rd_dx, rd_dy, rd_g, rda_fu, rda_fv)
    rla_du = rda_u - rla_gu
    rl_regu = square_L2_norm(rla_du)
    rla_dv = rda_v - rla_gv
    rl_regv = square_L2_norm(rla_dv)
    rl_reg = rl_regu + rl_regv
  END FUNCTION geostrophic_regul_cgrid

END MODULE regul_tools


c-------------------------------

      subroutine hfmm2d_s_c_p_vec(nd,eps,zk,ns,sources,
     1            charge,pot,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge
cf2py  intent(out) pot,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      complex *16 charge(nd,ns)

      complex *16 pot(nd,ns)

c
cc     temporary variables
c
      complex *16 dipstr(nd)
      real *8 dipvec(nd,2)
      integer nt
      real *8 targ(2)
      complex *16 pottarg(nd,1)
      complex *16 grad(nd,2),gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 0

      ifpgh = 1
      ifpghtarg = 0

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_s_c_g_vec(nd,eps,zk,ns,sources,
     1            charge,pot,grad,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge
cf2py  intent(out) pot,grad,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      complex *16 charge(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns)

c
cc     temporary variables
c
      complex *16 dipstr(nd)
      real *8 dipvec(nd,2)
      integer nt
      real *8 targ(2)
      complex *16 pottarg(nd,1)
      complex *16 gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 0

      ifpgh = 2
      ifpghtarg = 0

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_s_c_h_vec(nd,eps,zk,ns,sources,
     1            charge,pot,grad,hess,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge
cf2py  intent(out) pot,grad,hess,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c   hess(nd,3,ns)    : hessian at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      complex *16 charge(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns),hess(nd,3,ns)

c
cc     temporary variables
c
      complex *16 dipstr(nd)
      real *8 dipvec(nd,2)
      integer nt
      real *8 targ(2)
      complex *16 pottarg(nd,1)
      complex *16 gradtarg(nd,2)
      complex *16 hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 0

      ifpgh = 3
      ifpghtarg = 0

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_s_d_p_vec(nd,eps,zk,ns,sources,
     1            dipstr,dipvec,pot,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec
cf2py  intent(out) pot,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(nd,2,ns)
      complex *16 dipstr(nd,ns)

      complex *16 pot(nd,ns)

c
cc     temporary variables
c
      complex *16 charge(nd)
      integer nt
      real *8 targ(2)
      complex *16 pottarg(nd,1)
      complex *16 grad(nd,2),gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 0
      ifdipole = 1

      ifpgh = 1
      ifpghtarg = 0

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_s_d_g_vec(nd,eps,zk,ns,sources,
     1            dipstr,dipvec,pot,grad,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec
cf2py  intent(out) pot,grad,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(nd,2,ns)
      complex *16 dipstr(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns)

c
cc     temporary variables
c
      complex *16 charge(nd)
      integer nt
      real *8 targ(2)
      complex *16 pottarg(nd,1)
      complex *16 gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 0
      ifdipole = 1

      ifpgh = 2
      ifpghtarg = 0

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_s_d_h_vec(nd,eps,zk,ns,sources,
     1            dipstr,dipvec,pot,grad,hess,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec
cf2py  intent(out) pot,grad,hess,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c   hess(nd,3,ns)    : hessian at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(nd,2,ns)
      complex *16 dipstr(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns),hess(nd,3,ns)

c
cc     temporary variables
c
      complex *16 charge(nd)
      integer nt
      real *8 targ(2)
      complex *16 pottarg(nd,1)
      complex *16 gradtarg(nd,2)
      complex *16 hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 0
      ifdipole = 1

      ifpgh = 3
      ifpghtarg = 0

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_s_cd_p_vec(nd,eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,charge
cf2py  intent(out) pot,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(nd,2,ns)
      complex *16 charge(nd,ns),dipstr(nd,ns)

      complex *16 pot(nd,ns)

c
cc     temporary variables
c
      integer nt
      real *8 targ(2)
      complex *16 pottarg(nd,1)
      complex *16 grad(nd,2),gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 1

      ifpgh = 1
      ifpghtarg = 0

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_s_cd_g_vec(nd,eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,grad,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,charge
cf2py  intent(out) pot,grad,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(nd,2,ns)
      complex *16 charge(nd,ns),dipstr(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns)

c
cc     temporary variables
c
      integer nt
      real *8 targ(2)
      complex *16 pottarg(nd,1)
      complex *16 gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 1

      ifpgh = 2
      ifpghtarg = 0

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_s_cd_h_vec(nd,eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,grad,hess,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,charge
cf2py  intent(out) pot,grad,hess,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c   hess(nd,3,ns)    : hessian at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(nd,2,ns)
      complex *16 charge(nd,ns),dipstr(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns),hess(nd,3,ns)

c
cc     temporary variables
c
      integer nt
      real *8 targ(2)
      complex *16 pottarg(nd,1)
      complex *16 gradtarg(nd,2)
      complex *16 hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 1

      ifpgh = 3
      ifpghtarg = 0

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_t_c_p_vec(nd,eps,zk,ns,sources,
     1            charge,nt,targ,pottarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nd,nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(nd,ns)

      complex *16 pottarg(nd,nt)

c
cc     temporary variables
c
      complex *16 dipstr(nd)
      real *8 dipvec(nd,2)
      complex *16 pot(nd)
      complex *16 grad(nd,2),gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 0

      ifpgh = 0
      ifpghtarg = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_t_c_g_vec(nd,eps,zk,ns,sources,
     1            charge,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pottarg,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(nd,ns)

      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt)

c
cc     temporary variables
c
      complex *16 dipstr(nd)
      real *8 dipvec(nd,2)
      complex *16 pot(nd,1)
      complex *16 grad(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 0

      ifpgh = 0
      ifpghtarg = 2

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_t_c_h_vec(nd,eps,zk,ns,sources,
     1            charge,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pottarg,gradtarg,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c   hesstarg(nd,3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(nd,ns)

      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt),hesstarg(nd,3,nt)

c
cc     temporary variables
c
      complex *16 dipstr(nd)
      real *8 dipvec(nd,2)
      complex *16 pot(nd,1)
      complex *16 grad(nd,2)
      complex *16 hess(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 0

      ifpgh = 0
      ifpghtarg = 3

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_t_d_p_vec(nd,eps,zk,ns,sources,
     1            dipstr,dipvec,nt,targ,pottarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nd,nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 dipstr(nd,ns)

      complex *16 pottarg(nd,nt)

c
cc     temporary variables
c
      complex *16 charge(nd)
      complex *16 pot(nd,1)
      complex *16 grad(nd,2),gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 0
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_t_d_g_vec(nd,eps,zk,ns,sources,
     1            dipstr,dipvec,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 dipstr(nd,ns)

      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt)

c
cc     temporary variables
c
      complex *16 charge(nd)
      complex *16 pot(nd,1)
      complex *16 grad(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 0
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 2

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_t_d_h_vec(nd,eps,zk,ns,sources,
     1            dipstr,dipvec,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,gradtarg,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c   hesstarg(nd,3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 dipstr(nd,ns)

      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt),hesstarg(nd,3,nt)

c
cc     temporary variables
c
      complex *16 charge(nd)
      complex *16 pot(nd,1)
      complex *16 grad(nd,2)
      complex *16 hess(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 0
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 3

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_t_cd_p_vec(nd,eps,zk,ns,sources,charge,
     1            dipstr,dipvec,nt,targ,pottarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nd,nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 charge(nd,ns),dipstr(nd,ns)

      complex *16 pottarg(nd,nt)

c
cc     temporary variables
c
      complex *16 pot(nd,1)
      complex *16 grad(nd,2),gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_t_cd_g_vec(nd,eps,zk,ns,sources,charge,
     1            dipstr,dipvec,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 charge(nd,ns),dipstr(nd,ns)

      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt)

c
cc     temporary variables
c
      complex *16 pot(nd,1)
      complex *16 grad(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 2

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_t_cd_h_vec(nd,eps,zk,ns,sources,charge,
     1            dipstr,dipvec,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,gradtarg,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c   hesstarg(nd,3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 charge(nd,ns),dipstr(nd,ns)

      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt),hesstarg(nd,3,nt)

c
cc     temporary variables
c
      complex *16 pot(nd,1)
      complex *16 grad(nd,1)
      complex *16 hess(nd,1)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 3

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_st_c_p_vec(nd,eps,zk,ns,sources,
     1            charge,pot,nt,targ,pottarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pot,pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   pottarg(nd,nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(nd,ns)

      complex *16 pot(nd,ns)
      complex *16 pottarg(nd,nt)

c
cc     temporary variables
c
      complex *16 dipstr(nd)
      real *8 dipvec(nd,2)
      complex *16 grad(nd,2),gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 0

      ifpgh = 1
      ifpghtarg = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_st_c_g_vec(nd,eps,zk,ns,sources,
     1            charge,pot,grad,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns)
      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt)

c
cc     temporary variables
c
      complex *16 dipstr(nd)
      real *8 dipvec(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 0

      ifpgh = 2
      ifpghtarg = 2

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_st_c_h_vec(nd,eps,zk,ns,sources,
     1            charge,pot,grad,hess,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,hess,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c   hess(nd,3,ns)    : hessian at the source locations
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c   hesstarg(nd,3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns),hess(nd,3,ns)
      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt),hesstarg(nd,3,nt)

c
cc     temporary variables
c
      complex *16 dipstr(nd)
      real *8 dipvec(nd,2)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 0

      ifpgh = 3
      ifpghtarg = 3

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_st_d_p_vec(nd,eps,zk,ns,sources,
     1            dipstr,dipvec,pot,nt,targ,pottarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   pottarg(nd,nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 dipstr(nd,ns)

      complex *16 pot(nd,ns)
      complex *16 pottarg(nd,nt)

c
cc     temporary variables
c
      complex *16 charge(nd)
      complex *16 grad(nd,2),gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 0
      ifdipole = 1

      ifpgh = 1
      ifpghtarg = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_st_d_g_vec(nd,eps,zk,ns,sources,
     1            dipstr,dipvec,pot,grad,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 dipstr(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns)
      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt)

c
cc     temporary variables
c
      complex *16 charge(nd)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 0
      ifdipole = 1

      ifpgh = 2
      ifpghtarg = 2

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_st_d_h_vec(nd,eps,zk,ns,sources,
     1            dipstr,dipvec,pot,grad,hess,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,hess,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c   hess(nd,3,ns)    : hessian at the source locations
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c   hesstarg(nd,3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 dipstr(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns),hess(nd,3,ns)
      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt),hesstarg(nd,3,nt)

c
cc     temporary variables
c
      complex *16 charge(nd)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 0
      ifdipole = 1

      ifpgh = 3
      ifpghtarg = 3

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_st_cd_p_vec(nd,eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,nt,targ,pottarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   pottarg(nd,nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 charge(nd,ns),dipstr(nd,ns)

      complex *16 pot(nd,ns)
      complex *16 pottarg(nd,nt)

c
cc     temporary variables
c
      complex *16 grad(nd,2),gradtarg(nd,2)
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 1

      ifpgh = 1
      ifpghtarg = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_st_cd_g_vec(nd,eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,grad,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 charge(nd,ns),dipstr(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns)
      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt)

c
cc     temporary variables
c
      complex *16 hess(nd,3),hesstarg(nd,3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 1

      ifpgh = 2
      ifpghtarg = 2

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_st_cd_h_vec(nd,eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,grad,hess,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps,nd
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,hess,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   nd            : number of expansions
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(nd,ns)    : charge strengths
c   dipstr(nd,ns)    : dipole strengths
c   dipvec(nd,2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(nd,ns)       : potential at the source locations
c   grad(nd,2,ns)    : gradients at the source locations
c   hess(nd,3,ns)    : hessian at the source locations
c   pottarg(nd,nt)   : potential at the target locations
c   gradtarg(nd,2,nt): gradient at the target locations
c   hesstarg(nd,3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      integer nd
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(nd,2,ns)
      complex *16 charge(nd,ns),dipstr(nd,ns)

      complex *16 pot(nd,ns),grad(nd,2,ns),hess(nd,3,ns)
      complex *16 pottarg(nd,nt),gradtarg(nd,2,nt),hesstarg(nd,3,nt)

c
cc     temporary variables
c
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      ifcharge = 1
      ifdipole = 1

      ifpgh = 3
      ifpghtarg = 3

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------


program io_plane_test

  use decomp_2d
  use decomp_2d_io

  implicit none

  integer, parameter :: nx=17, ny=13, nz=11
  integer, parameter :: p_row=4, p_col=3

  real(mytype), dimension(nx,ny,nz) :: data1
  real(mytype), allocatable, dimension(:,:,:) :: u1, u2, u3

  real(mytype), allocatable, dimension(:,:,:) :: work

  integer :: i,j,k, m, ierror, iol

  call MPI_INIT(ierror)
  call decomp_2d_init(nx,ny,nz,p_row,p_col)

  ! ***** global data *****
  m = 1
  do k=1,nz
     do j=1,ny
        do i=1,nx
           data1(i,j,k) = real(m,mytype)
           m = m+1
        end do
     end do
  end do

  allocate(u1(xstart(1):xend(1), xstart(2):xend(2), xstart(3):xend(3)))
  allocate(u2(ystart(1):yend(1), ystart(2):yend(2), ystart(3):yend(3)))
  allocate(u3(zstart(1):zend(1), zstart(2):zend(2), zstart(3):zend(3)))

  ! original X-pensil based data
  do k=xstart(3),xend(3)
    do j=xstart(2),xend(2)
      do i=xstart(1),xend(1)
        u1(i,j,k) = data1(i,j,k)
      end do
    end do
  end do
  call decomp_2d_write_plane(1,u1,1,nx/2,'x_pencil-x_plane.dat')
  call decomp_2d_write_plane(1,u1,2,ny/2,'x_pencil-y_plane.dat')
  call decomp_2d_write_plane(1,u1,3,nz/2,'x_pencil-z_plane.dat')

  ! Y-pencil data
  call transpose_x_to_y(u1,u2)
  call decomp_2d_write_plane(2,u2,1,nx/2,'y_pencil-x_plane.dat')
  call decomp_2d_write_plane(2,u2,2,ny/2,'y_pencil-y_plane.dat')
  call decomp_2d_write_plane(2,u2,3,nz/2,'y_pencil-z_plane.dat')

  ! Z-pencil data
  call transpose_y_to_z(u2,u3)
  call decomp_2d_write_plane(3,u3,1,nx/2,'z_pencil-x_plane.dat')
  call decomp_2d_write_plane(3,u3,2,ny/2,'z_pencil-y_plane.dat')
  call decomp_2d_write_plane(3,u3,3,nz/2,'z_pencil-z_plane.dat')

  ! Attemp to read the files
  if (nrank==0) then
     inquire(iolength=iol) data1(1,1,1)

     ! X-plane
     allocate(work(1,ny,nz))
     open(10, FILE='x_pencil-x_plane.dat', FORM='unformatted', &
          ACCESS='DIRECT', RECL=iol)
     m=1
     do k=1,nz
        do j=1,ny
           read(10,rec=m) work(1,j,k)
           m=m+1
        end do
     end do
     write(*,*) ' '
     write(*,'(15I5)') int(work)
     close(10)
     deallocate(work)

     ! Y-plane
     allocate(work(nx,1,nz))
     open(10, FILE='x_pencil-y_plane.dat', FORM='unformatted', &
          ACCESS='DIRECT', RECL=iol)
     m=1
     do k=1,nz
        do i=1,nx
           read(10,rec=m) work(i,1,k)
           m=m+1
        end do
     end do
     write(*,*) ' '
     write(*,'(15I5)') int(work)
     close(10)
     deallocate(work)

     ! Z-plane
     allocate(work(nx,ny,1))
     open(10, FILE='x_pencil-z_plane.dat', FORM='unformatted', &
          ACCESS='DIRECT', RECL=iol)
     m=1
     do j=1,ny
        do i=1,nx
           read(10,rec=m) work(i,j,1)
           m=m+1
        end do
     end do
     write(*,*) ' '
     write(*,'(15I5)') int(work)
     close(10)
     deallocate(work)

  end if

  call decomp_2d_finalize
  call MPI_FINALIZE(ierror)
  deallocate(u1,u2,u3)

end program io_plane_test


module generation_rate_t_interface
  !! Describe the gas-liberation from the burning propellant
  use constants, only : dp
  implicit none

  private

  type, public :: generation_rate_t
    !! Encapsulate the propellant mass and energy liberation
    private
    real(dp) mdotgen_ ! mass liberation
    real(dp) edotgen_ ! energy liberation
  contains
    procedure :: mdotgen
    procedure :: edotgen
  end type

  interface generation_rate_t !! Generic interface for user-defined structure constructors
    module procedure calmdotgen
  end interface

  interface

    pure module function calmdotgen(rhos, r, surf, cp, Tflame) result(new_generation_rate)
      !! Result is a new generation_rate_t objected
      implicit none
      real(dp), intent(in) :: rhos, r, surf, cp, Tflame
      type(generation_rate_t) new_generation_rate
    end function

    pure module function mdotgen(this)
      !! Result is the generated mass value from this generation_rate_t object
      implicit none
      class(generation_rate_t), intent(in) :: this
      real(dp) mdotgen
    end function

    pure module function edotgen(this)
      !! Result is the generated energy value from this generation_rate_t object
      implicit none
      class(generation_rate_t), intent(in) :: this
      real(dp) edotgen
    end function

  end interface

end module generation_rate_t_interface


! ************************************************************
!
!  This example shows how to create a chunked dataset.  The
!  program first writes integers in a hyperslab selection to
!  a chunked dataset with dataspace dimensions of DIM0xDIM1
!  and chunk size of CHUNK0xCHUNK1, then closes the file.
!  Next, it reopens the file, reads back the data, and
!  outputs it to the screen.  Finally it reads the data again
!  using a different hyperslab selection, and outputs
!  the result to the screen.
!
!  This file is intended for use with HDF5 Library verion 1.8
!
! ************************************************************

PROGRAM main

  USE HDF5

  IMPLICIT NONE

  CHARACTER(LEN=18), PARAMETER :: filename = "h5ex_d_chunk.h5"
  CHARACTER(LEN=3) , PARAMETER :: dataset  = "DS1"
  INTEGER          , PARAMETER :: dim0     = 6
  INTEGER          , PARAMETER :: dim1     = 8
  INTEGER          , PARAMETER :: chunk0   = 4
  INTEGER          , PARAMETER :: chunk1   = 4

  INTEGER :: hdferr
  INTEGER :: layout
  INTEGER(HID_T)  :: file, space, dset, dcpl ! Handles
  INTEGER(HSIZE_T), DIMENSION(1:2)   :: dims = (/dim0, dim1/), chunk = (/chunk0,chunk1/)
  INTEGER(HSIZE_T), DIMENSION(1:2)   :: start, stride, count, block

  INTEGER, DIMENSION(1:dim0, 1:dim1) :: wdata, & ! Write buffer
                                        rdata    ! Read buffer
  INTEGER :: i, j
  !
  ! Initialize FORTRAN interface.
  !
  CALL h5open_f(hdferr)
  ! Initialize data to "1", to make it easier to see the selections.
  !
  wdata = 1
  !
  ! Print the data to the screen.
  !
  WRITE(*, '(/,"Original Data:")')
  DO i=1, dim0
     WRITE(*,'(" [")', ADVANCE='NO')
     WRITE(*,'(80i3)', ADVANCE='NO') wdata(i,:)
     WRITE(*,'(" ]")')
  ENDDO
  !
  ! Create a new file using the default properties.
  !
  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, hdferr)
  !
  ! Create dataspace.  Setting maximum size to be the current size.
  !
  CALL h5screate_simple_f(2, dims, space, hdferr)
  !
  ! Create the dataset creation property list, and set the chunk
  ! size.
  !
  CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl, hdferr)
  CALL h5pset_chunk_f(dcpl, 2, chunk, hdferr)
  !
  ! Create the chunked dataset.
  !
  CALL h5dcreate_f(file, dataset, H5T_STD_I32LE, space, dset, hdferr, dcpl)
  !
  ! Define and select the first part of the hyperslab selection.
  !
  start = 0
  stride = 3
  count(1:2) = (/2,3/)
  block = 2
  CALL h5sselect_hyperslab_f (space, H5S_SELECT_SET_F, start, count, &
       hdferr, stride, block)
  !
  ! Define and select the second part of the hyperslab selection,
  ! which is subtracted from the first selection by the use of
  ! H5S_SELECT_NOTB
  !
  block = 1
  CALL h5sselect_hyperslab_f (space, H5S_SELECT_NOTB_F, start, count, &
       hdferr, stride, block)
  !
  ! Write the data to the dataset.
  !
  CALL h5dwrite_f(dset, H5T_NATIVE_INTEGER, wdata, dims, hdferr, file_space_id=space)
  !
  ! Close and release resources.
  !
  CALL h5pclose_f(dcpl , hdferr)
  CALL h5dclose_f(dset , hdferr)
  CALL h5sclose_f(space, hdferr)
  CALL h5fclose_f(file , hdferr)
  !
  ! Now we begin the read section of this example.
  !
  !
  ! Open file and dataset using the default properties.
  !
  CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, hdferr)
  CALL h5dopen_f (file, dataset, dset, hdferr)
  !
  ! Retrieve the dataset creation property list, and print the
  ! storage layout.
  !
  CALL h5dget_create_plist_f(dset, dcpl, hdferr)
  CALL h5pget_layout_f(dcpl, layout, hdferr)
  WRITE(*,'(/,"Storage layout for ", A," is: ")', ADVANCE='NO') dataset
  IF(layout.EQ.H5D_COMPACT_F)THEN
     WRITE(*,'("H5D_COMPACT_F",/)')
  ELSE IF (layout.EQ.H5D_CONTIGUOUS_F)THEN
     WRITE(*,'("H5D_CONTIGUOUS_F",/)')
  ELSE IF (layout.EQ.H5D_CHUNKED_F)THEN
     WRITE(*,'("H5D_CHUNKED",/)')
  ENDIF
  !
  ! Read the data using the default properties.
  !
  CALL h5dread_f(dset, H5T_NATIVE_INTEGER, rdata, dims, hdferr)
  !
  ! Output the data to the screen.
  !
  WRITE(*, '("Data as written to disk by hyberslabs:")')
  DO i=1, dim0
     WRITE(*,'(" [")', ADVANCE='NO')
     WRITE(*,'(80i3)', ADVANCE='NO') rdata(i,:)
     WRITE(*,'(" ]")')
  ENDDO
  !
  ! Initialize the read array.
  !
  rdata = 0
  !
  ! Define and select the hyperslab to use for reading.
  !
  CALL h5dget_space_f(dset, space, hdferr)
  start(1:2) = (/0,1/)
  stride = 4
  count = 2
  block(1:2) = (/2,3/)

  CALL h5sselect_hyperslab_f (space, H5S_SELECT_SET_F, start, count, &
       hdferr, stride, block)
  !
  ! Read the data using the previously defined hyperslab.
  !
  CALL h5dread_f(dset, H5T_NATIVE_INTEGER, rdata, dims, hdferr, file_space_id=space)
  !
  ! Output the data to the screen.
  !
  WRITE(*, '(/,"Data as read from disk by hyperslab:")')
  DO i=1, dim0
     WRITE(*,'(" [")', ADVANCE='NO')
     WRITE(*,'(80i3)', ADVANCE='NO') rdata(i,:)
     WRITE(*,'(" ]")')
  ENDDO
  !
  ! Close and release resources.
  !
  CALL h5pclose_f(dcpl , hdferr)
  CALL h5dclose_f(dset , hdferr)
  CALL h5sclose_f(space, hdferr)
  CALL h5fclose_f(file , hdferr)

END PROGRAM main


module general_interval_t_mod
  use ISO_FORTRAN_ENV, only : REAL64

  type :: general_interval_t
    real (REAL64), dimension (2) :: endpoints
    logical,       dimension (2) :: are_closed
  end type general_interval_t

end module general_interval_t_mod


! Program to test the MERGE intrinsic
program intrinsic_merge
   integer, dimension(3) :: a, b
   integer i

   a = (/-1, 2, 3/)

   i = 5
   if (merge (-1, 1, i .gt. 3) .ne. -1) call abort
   i = 1
   if (merge (-1, 1, i .ge. 3) .ne. 1) call abort

   b = merge(a, 0, a .ge. 0)
   if (any (b .ne. (/0, 2, 3/))) call abort
end program


        subroutine idd_sffti(l,ind,n,wsave)
c
c       initializes wsave for using routine idd_sfft.
c
c       input:
c       l -- number of pairs of entries in the output of idd_sfft
c            to compute
c       ind -- indices of the pairs of entries in the output
c              of idd_sfft to compute; the indices must be chosen
c              in the range from 1 to n/2
c       n -- length of the vector to be transformed
c
c       output:
c       wsave -- array needed by routine idd_sfft for processing
c                (the present routine does not use the last n elements
c                 of wsave, but routine idd_sfft does)
c
        implicit none
        integer l,ind(l),n
        complex*16 wsave(2*l+15+4*n)
c
c
        if(l .eq. 1) call idd_sffti1(ind,n,wsave)
        if(l .gt. 1) call idd_sffti2(l,ind,n,wsave)
c
c
        return
        end
c
c
c
c


!
! Copyright (C) 2001-2003 PWSCF group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
subroutine interpolate (v, vs, iflag)
  !
  !     This subroutine interpolates :
  !     from the smooth mesh (vs) to a  thicker mesh (v)  (iflag>0)
  !        vs is unchanged on output
  !     from the  thick mesh (v ) to a smoother mesh (vs) (iflag<=0)
  !        v  is unchanged on output
  !     V and Vs are real and in real space . V and Vs may coincide
  !
  USE kinds, ONLY: DP
  USE gvect,  ONLY: nl, nlm
  USE gvecs,ONLY: ngms, nls, nlsm, doublegrid
  USE fft_base,      ONLY : dfftp, dffts
  USE fft_interfaces,ONLY : fwfft, invfft
  !
  implicit none
  real(DP) :: v (dfftp%nnr), vs (dffts%nnr)
  ! function on thick mesh
  ! function on smooth mesh

  complex(DP), allocatable :: aux (:), auxs (:)
  ! work array on thick mesh
  ! work array on smooth mesh

  integer :: iflag
  ! gives the direction of the interpolation

  integer :: ig, ir

  call start_clock ('interpolate')
  if (iflag <= 0) then
     !
     !    from thick to smooth
     !
     if (doublegrid) then
        allocate (aux( dfftp%nnr))
        allocate (auxs(dffts%nnr))
        aux (:) = v (:)
        CALL fwfft ('Dense', aux, dfftp)
        auxs (:) = (0.d0, 0.d0)
        do ig = 1, ngms
           auxs (nls (ig) ) = aux (nl (ig) )
        enddo
        CALL invfft ('Smooth', auxs, dffts)
        vs (:) = auxs (:)
        deallocate (auxs)
        deallocate (aux)
     else
        do ir = 1, dfftp%nnr
           vs (ir) = v (ir)
        enddo
     endif
  else
     !
     !   from smooth to thick
     !
     if (doublegrid) then
        allocate (aux( dfftp%nnr))
        allocate (auxs(dffts%nnr))
        auxs (:) = vs (:)
        CALL fwfft ('Smooth', auxs, dffts)
        aux (:) = (0.d0, 0.d0)
        do ig = 1, ngms
           aux (nl (ig) ) = auxs (nls (ig) )
        enddo
        CALL invfft ('Dense', aux, dfftp)
        v (:) = aux (:)
        deallocate (auxs)
        deallocate (aux)
     else
        do ir = 1, dfftp%nnr
           v (ir) = vs (ir)
        enddo
     endif
  endif
  call stop_clock ('interpolate')
  return
end subroutine interpolate
!
subroutine cinterpolate (v, vs, iflag)
  !
  !     This subroutine interpolates :
  !     from the smooth mesh (vs) to a  thicker mesh (v)  (iflag>0)
  !        vs is unchanged on output
  !     from the  thick mesh (v ) to a smoother mesh (vs) (iflag<=0)
  !        v  is unchanged on output
  !     V and Vs are complex and in real space . V and Vs may coincide
  !
  USE kinds, ONLY: DP
  USE gvect,  ONLY: nl, nlm
  USE gvecs,ONLY: ngms, nls, nlsm, doublegrid
!!$  USE control_flags, ONLY: gamma_only
  USE fft_base,      ONLY : dfftp, dffts
  USE fft_interfaces,ONLY : fwfft, invfft
  !
  IMPLICIT NONE
  complex(DP) :: v (dfftp%nnr), vs (dffts%nnr)
  ! function on thick mesh
  ! function on smooth mesh

  integer :: iflag
  ! gives the direction of the interpolation

  complex(DP), allocatable :: aux (:), auxs (:)
  ! work array on thick mesh
  ! work array on smooth mesh

  integer :: ig

!!$  if (gamma_only) call errore ('cinterpolate','not allowed', 1)
  call start_clock ('cinterpolate')
  if (iflag <= 0) then
     !
     !    from thick to smooth
     !
     if (doublegrid) then
        allocate (aux ( dfftp%nnr))
        aux (:) = v(:)
        CALL fwfft ('Dense', aux, dfftp)
        vs (:) = (0.d0, 0.d0)
        do ig = 1, ngms
           vs (nls (ig) ) = aux (nl (ig) )
        enddo
        CALL invfft ('Smooth', vs, dffts)
        deallocate (aux)
     else
        call zcopy (dfftp%nnr, v, 1, vs, 1)
     endif
  else
     !
     !   from smooth to thick
     !
     if (doublegrid) then
        allocate (auxs (dffts%nnr))
        auxs (:) = vs(:)
        CALL fwfft ('Smooth', auxs, dffts)
        v (:) = (0.d0, 0.d0)
        do ig = 1, ngms
           v (nl (ig) ) = auxs (nls (ig) )
        enddo
        CALL invfft ('Dense', v, dfftp)
        deallocate (auxs)
     else
        call zcopy (dfftp%nnr, vs, 1, v, 1)
     endif
  endif
  call stop_clock ('cinterpolate')
  return
end subroutine cinterpolate


SUBROUTINE BMG3_SymStd_SETUP_TAUSCH(&
     NOG,&
     DimX, DimY, Dimz, DimXfine, DimYfine, DimZfine,&
     NProcI, NProcJ, NProcK &
     ) BIND(C, NAME='BMG3_SymStd_SETUP_Tausch')

  use ModInterface
  IMPLICIT NONE

  integer(C_INT), VALUE :: NOG, NProcI, NProcJ, NProcK
  INTEGER(len_t) :: DimX(NProcI,NOG), DimY(NProcJ,NOG), DimZ(NProcK,NOG)
  INTEGER(len_t) :: DimXfine(NProcI), DimYfine(NProcJ), DimZfine(NProcK)

  integer(len_t) :: I, J, K, iGs, jGs, kGs
  integer N

  DO I=1, NProcI
     DimX(I,NOG) = DimXfine(I)
  END DO

  DO J=1, NProcJ
     DimY(J,NOG) = DimYfine(J)
  END DO

  do k=1,nprock
     dimz(k,nog) = dimzfine(k)
  enddo

  DO N=NOG-1, 1, -1

     iGs = 1

     DO I=1, NProcI

        if (mod(iGs,2).eq.1) then
           DimX(I,N) = (DimX(I,N+1)+1)/2
        else
           IF (mod(DimX(I,N+1),2).eq.1) THEN
              DimX(I,N) = (DimX(I,N+1)-1)/2
           ELSE
              DimX(I,N) = (DimX(I,N+1)+1)/2
           ENDIF
        endif

        iGs = iGs + DimX(I,N+1)

     END DO

     jGs = 1

     DO J=1, NProcJ

        if (mod(jGs,2).eq.1) then
           DimY(J,N) = (DimY(J,N+1)+1)/2
        else
           IF (mod(DimY(J,N+1),2).eq.1) THEN
              DimY(J,N) = (DimY(J,N+1)-1)/2
           ELSE
              DimY(J,N) = (DimY(J,N+1)+1)/2
           ENDIF
        endif

        jGs = jGs + DimY(J,N+1)

     END DO

     kgs = 1

     do k=1,nprock

        if (mod(kgs,2) .eq. 1) then
           dimz(k,n) = (dimz(k,n+1)+1) / 2
        else
           if (mod(dimz(k,n+1),2) .eq. 1) then
              dimz(k,n) = (dimz(k,n+1)-1)/2
           else
              dimz(k,n) = (dimz(k,n+1)+1)/2
           endif
        endif

        kgs = kgs + dimz(k,n+1)
     enddo

  END DO

end SUBROUTINE BMG3_SymStd_SETUP_TAUSCH


!/*-----------------------------------------------------------------------------
! *  main  --  reads option values, reads a snapshot, and launches the
! *            integrator
! *-----------------------------------------------------------------------------
! */

program lmac
	use numz
	use dim
	use face, only:read_options,get_snapshot,evolve
	implicit none
    logical flag

    real(b8)  dt_param        ! control parameter to determine time step size
    real(b8)  dt_dia          ! time interval between diagnostics output
    real(b8)  dt_out          ! time interval between output of snapshots
    real(b8)  dt_tot          ! duration of the integration
    logical  init_out         ! if true: snapshot output with start at t = 0
                              !          with an echo of the input snapshot
    logical  x_flag           ! if true: extra debugging diagnostics output
    logical  read_flag
    integer n
    real(b8) t
    real(b8),allocatable :: mass(:),pos(:,:),vel(:,:)

	dt_param = 0.03_b8
	dt_dia = 1.0_b8
	dt_out = 1.0_b8
	dt_tot = 10.0_b8
	init_out = .false.

	x_flag = .false.
    read_flag=.true.
    call read_options(read_flag, dt_param, dt_dia, dt_out, &
                      dt_tot, init_out, x_flag)
                             ! halt criterion detected by read_options()
    if (read_flag .eqv. .false.)stop

    read(*,*)n             ! N, number of particles in the N-body system

    read(*,*)t             ! time

    allocate(mass(0:n-1))             ! masses for all particles
    allocate(pos(0:n-1,0:NDIM-1))     ! positions for all particles
    allocate(vel(0:n-1,0:NDIM-1))     ! velocities for all particles

    call get_snapshot(mass, pos, vel, n)

    call evolve(mass, pos, vel, n, t, dt_param, dt_dia, &
                dt_out, dt_tot, init_out, x_flag)

    deallocate(mass)
    deallocate(pos)
    deallocate(vel)
end program


C
C**************************  FXVDDM ************************************
C
C  calculate second derivative of moisture content with respect to
C  pressure head using extended van Genuchten characteristic equation.
C  for the extended van Genuchten equation this gives the derivative of
C  the overall storage coefficient with respect to pressure head.
C
C***********************************************************************
C
      DOUBLE PRECISION FUNCTION FXVDDM(PSI,POR,INOD)
C
      IMPLICIT NONE
      INCLUDE 'CATHY.H'
      INTEGER  INOD
      REAL*8   BETA,B1,B1R
      REAL*8   PSI,POR
      INCLUDE 'SOILCHAR.H'
C
      IF (PSI .LT. VGPNOT(INOD)) THEN
         BETA=(PSI/VGPSAT(INOD))**VGN(INOD)
         B1=BETA+1.0D0
         B1R=1.0D0/B1
         FXVDDM=VGN1(INOD)*(POR-VGRMC(INOD))*(BETA/PSI)*(1.0D0/PSI)*
     1              ((1.0D0 + VGN(INOD)*(BETA - 1.0D0))/
     2              (B1**VGM(INOD)))*B1R*B1R
      ELSE
         FXVDDM=0.0D0
      END IF
C
      RETURN
      END


C
C $Id: e0fnsp.f,v 1.5 2008-07-27 00:17:08 haley Exp $
C
C                Copyright (C)  2000
C        University Corporation for Atmospheric Research
C                All Rights Reserved
C
C The use of this Software is governed by a License Agreement.
C
      REAL FUNCTION E0FNSP (ECCNTS)
C
C This function computes the constant E0.
C
      IMPLICIT REAL (A-Z)
      DATA QUART,ONE,ONEQ,THREE,SIXT /0.25E0,1.0E0,1.25E0,3.0E0,16.0E0/
C
      E0FNSP = ONE - QUART * ECCNTS * (ONE + ECCNTS / SIXT *
     .         (THREE + ONEQ * ECCNTS))
C
      RETURN
      END