!========================================================================
!
!                          T o m o f a s t - x
!                        -----------------------
!
!              Main authors: Vitaliy Ogarko, Roland Martin,
!                   Jeremie Giraud, Dimitri Komatitsch.
!
! (c) CNRS, France, and University of Western Australia. January 2018
!
! The full text of the license is available in file "LICENSE".
!
!========================================================================

!===============================================================================================
! Unit tests for ECT (forward problem) part.
!
! Author: Vitaliy Ogarko, UWA, CET, Australia, 2015.
!===============================================================================================
module tests_ect

  use global_typedefs
  use ftnunit

  use parameters_ect
  use geometry
  use flag
  use matrix
  use solution
  use conjugate_gradient
  use laplace
  use utils
  use paraview

  implicit none

  private

  public :: test_geometry_all
  public :: test_boundary_conditions_all
  public :: test_analytical_comparison_all

  private :: test_geometry
  private :: test_boundary_conditions
  private :: test_analytical_comparison

  private :: init_params
  private :: set_dimensions_multigrid

  ! TODO: make them local.
  integer :: myrank, nbproc

contains

subroutine test_geometry_all(myrank__,nbproc__)
  integer, intent(in) :: myrank__,nbproc__

  ! Geometry of the cylinder.
  real(kind=CUSTOM_REAL), parameter :: radiusin     = 0.045
  real(kind=CUSTOM_REAL), parameter :: radiusout    = 0.06
  real(kind=CUSTOM_REAL), parameter :: radiusoutout = 0.07
  real(kind=CUSTOM_REAL), parameter :: heicyl       = 0.2

  myrank = myrank__
  nbproc = nbproc__

  ! Minimum problem size without multigrid.
  call test_geometry(12, 1, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(12, 1, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))

  ! Minimum problem size with multigrid 2 levels.
  call test_geometry(24, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(24, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))

  call test_geometry(36, 1, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(36, 1, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_geometry(36, 1, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(36, 1, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))

  ! Minimum problem size with multigird 3 levels.
  call test_geometry(48, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(48, 3, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(48, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))

  call test_geometry(72, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(72, 2, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(72, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_geometry(72, 2, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_geometry(72, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(72, 2, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(72, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))
  call test_geometry(72, 2, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))

  ! Minimum problem size with multigird 4 levels.
  call test_geometry(96, 4, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(96, 4, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(96, 4, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(96, 4, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.02))

  call test_geometry(144, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(144, 3, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(144, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_geometry(144, 3, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_geometry(144, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(144, 3, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(144, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))
  call test_geometry(144, 3, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))

  call test_geometry(288, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(288, 3, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(288, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_geometry(288, 3, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_geometry(288, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(288, 3, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(288, 3, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))
  call test_geometry(288, 3, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))

  call test_geometry(288, 4, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(288, 4, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_geometry(288, 4, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_geometry(288, 4, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_geometry(288, 4, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(288, 4, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_geometry(288, 4, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))
  call test_geometry(288, 4, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))

end subroutine test_geometry_all

!==============================================================================================
subroutine test_boundary_conditions_all(myrank__,nbproc__)
  integer, intent(in) :: myrank__,nbproc__

  ! Geometry of the cylinder.
  real(kind=CUSTOM_REAL), parameter :: radiusin     = 0.045
  real(kind=CUSTOM_REAL), parameter :: radiusout    = 0.06
  real(kind=CUSTOM_REAL), parameter :: radiusoutout = 0.07
  real(kind=CUSTOM_REAL), parameter :: heicyl       = 0.2

  myrank = myrank__
  nbproc = nbproc__

  call test_boundary_conditions(12, 1, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_boundary_conditions(12, 1, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))

  call test_boundary_conditions(24, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_boundary_conditions(24, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))

  call test_boundary_conditions(72, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_boundary_conditions(72, 2, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.))
  call test_boundary_conditions(72, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_boundary_conditions(72, 2, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.))
  call test_boundary_conditions(72, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_boundary_conditions(72, 2, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.01))
  call test_boundary_conditions(72, 2, 0, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))
  call test_boundary_conditions(72, 2, 1, t_sensor(radiusin,radiusout,radiusoutout,heicyl,3.,0.01))

end subroutine test_boundary_conditions_all

!==============================================================================================
subroutine test_analytical_comparison_all(myrank__,nbproc__)
  integer, intent(in) :: myrank__,nbproc__

  ! Geometry of the cylinder.
  real(kind=CUSTOM_REAL), parameter :: radiusin     = 0.045
  real(kind=CUSTOM_REAL), parameter :: radiusout    = 0.06
  real(kind=CUSTOM_REAL), parameter :: radiusoutout = 0.07
  real(kind=CUSTOM_REAL), parameter :: heicyl       = 0.2

  ! Analytical solutions are known only without gaps.
  type (t_sensor), parameter :: sensor = t_sensor(radiusin,radiusout,radiusoutout,heicyl,0.,0.)

  myrank = myrank__
  nbproc = nbproc__

  !call test_analytical_comparison(1, 24, 1, 1000, sensor)
  call test_analytical_comparison(1, 36, 1, 1000, sensor)
  !call test_analytical_comparison(1, 72, 1, 1000, sensor)
  !call test_analytical_comparison(1, 144, 1, 3000, sensor)

  !call test_analytical_comparison(2, 24, 1, 1000, sensor)
  !call test_analytical_comparison(2, 36, 1, 1000, sensor)
  !call test_analytical_comparison(2, 72, 1, 1000, sensor)
  !call test_analytical_comparison(2, 144, 1, 3000, sensor)

  !call test_analytical_comparison(3, 24, 1, 1000, sensor)
  !call test_analytical_comparison(3, 72, 1, 1000, sensor)
  !call test_analytical_comparison(3, 144, 1, 3000, sensor)

  !call test_analytical_comparison(4, 24, 1, 1000, sensor)
  !call test_analytical_comparison(4, 36, 1, 1000, sensor)
  !call test_analytical_comparison(4, 72, 1, 1000, sensor)
  !call test_analytical_comparison(4, 144, 1, 3000, sensor)
  !call test_analytical_comparison(4, 288, 1, 10000, sensor)

end subroutine test_analytical_comparison_all

!==============================================================================================
! Initialize the system parameters for testing functions.
!==============================================================================================
subroutine init_params(size, nbproc, par, nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read, ifixed_elecgeo)

  integer, intent(in) :: size, nbproc, ifixed_elecgeo

  type(t_parameters_ect), intent(out) :: par
  integer, intent(out) :: nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read

  nr_read                   = size
  ntheta_read               = size
  nz_read                   = size
  kguards_read              = size/4
  nzlocal_read              = nz_read/nbproc

  par%dims%nr = nr_read
  par%dims%ntheta = ntheta_read
  par%dims%nz = nz_read
  par%dims%kguards = kguards_read
  par%dims%nzlocal = nzlocal_read

  par%nel = 12
  par%nrings = 1

  par%ifixed_elecgeo = ifixed_elecgeo

end subroutine init_params

!==============================================================================================
! Used to initialize the multigrid dimensions for testing functions.
!==============================================================================================
subroutine set_dimensions_multigrid(ilevel_coarse, nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read, &
                                nr_at_level, ntheta_at_level, nz_at_level, nzlocal_at_level, kguards_at_level)

  integer, intent(in) :: ilevel_coarse

  integer, intent(out) :: nr_at_level(ilevel_coarse)
  integer, intent(out) :: ntheta_at_level(ilevel_coarse)
  integer, intent(out) :: nz_at_level(ilevel_coarse)
  integer, intent(out) :: nzlocal_at_level(ilevel_coarse)
  integer, intent(out) :: kguards_at_level(ilevel_coarse)

  integer :: nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read
  integer :: ilevel
  ! For the multigrid method start from level=1.
  integer, parameter :: ilevel_fine = 1

  do ilevel = ilevel_fine, ilevel_coarse
    nr_at_level(ilevel)      = nr_read / 2**(ilevel-1)
    ntheta_at_level(ilevel)  = ntheta_read / 2**(ilevel-1)
    nz_at_level(ilevel)      = nz_read / 2**(ilevel-1)
    nzlocal_at_level(ilevel) = nzlocal_read / 2**(ilevel-1)
    kguards_at_level(ilevel) = kguards_read / 2**(ilevel-1)
  enddo

end subroutine set_dimensions_multigrid

!==============================================================================================
! Tests of the system geometry.
!==============================================================================================
subroutine test_geometry(size,ilevel_coarse,ifixed_elecgeo,sens)

  integer, intent(in) :: size
  integer, intent(in) :: ilevel_coarse, ifixed_elecgeo
  type(t_sensor), intent(in) :: sens

  type(t_parameters_ect) :: par
  integer :: ilevel
  integer :: nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read
  integer, dimension(:), allocatable :: i1, i2
  type(t_electrode_p), dimension(:), allocatable :: elecs
  type(t_guards), dimension(:), allocatable :: guards
  type(real_p), dimension(:), allocatable :: r, z, dr, dz, theta
  integer, dimension(:), allocatable :: nr_at_level, ntheta_at_level, nz_at_level, nzlocal_at_level, kguards_at_level
  integer, dimension(:), allocatable :: izspace
  integer :: ielectrode

  integer :: nr, ntheta, nz, kguards
  integer :: i, j, k
  real(kind=CUSTOM_REAL) :: z_sum
  integer :: gap_size

  ! For the multigrid method start from level=1.
  integer, parameter :: ilevel_fine = 1
  !--------------------------------------------------------------------------

  !print *, ' size, ilevel_coarse, ifixed_elecgeo, space_electrodes, space_elec_guards = '
  !print *, '     ', size, ilevel_coarse, ifixed_elecgeo, sens%space_electrodes, sens%space_elec_guards

  ! Use nz instead of nzlocal which is not needed for geometry.
  call init_params(size, 1, par, nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read, ifixed_elecgeo)
  par%sens = sens

  !--------------------------------------------------------------------------
  allocate(i1(ilevel_coarse))
  allocate(i2(ilevel_coarse))
  allocate(nr_at_level(ilevel_coarse))
  allocate(ntheta_at_level(ilevel_coarse))
  allocate(nz_at_level(ilevel_coarse))
  allocate(nzlocal_at_level(ilevel_coarse))
  allocate(kguards_at_level(ilevel_coarse))
  allocate(izspace(ilevel_coarse))

  allocate(theta(ilevel_coarse))
  allocate(dr(ilevel_coarse))
  allocate(dz(ilevel_coarse))
  allocate(r(ilevel_coarse))
  allocate(z(ilevel_coarse))
  allocate(elecs(ilevel_coarse))
  allocate(guards(ilevel_coarse))

  ! Use nz instead of nzlocal which is not needed for geometry.
  call set_dimensions_multigrid(ilevel_coarse, nr_read, nz_read, nz_read, ntheta_read, kguards_read, &
                              nr_at_level, ntheta_at_level, nz_at_level, nzlocal_at_level, kguards_at_level)

  do ilevel = ilevel_fine, ilevel_coarse
    nr      = nr_at_level(ilevel)
    ntheta  = ntheta_at_level(ilevel)
    nz      = nz_at_level(ilevel)

    allocate(theta(ilevel)%p(0:ntheta+1))
    allocate(dr(ilevel)%p(0:2*nr+1))
    allocate(dz(ilevel)%p(0:nz+1))
    allocate(r(ilevel)%p(0:2*nr+1))
    allocate(z(ilevel)%p(0:nz+1))
    allocate(elecs(ilevel)%p(par%nel))
  enddo

  do ilevel = ilevel_fine, ilevel_coarse
    ! (!!!) The function being tested.
    call set_geometry(ilevel,par,nr_at_level(ilevel),ntheta_at_level(ilevel),nz_at_level(ilevel),&
                      r(ilevel)%p,dr(ilevel)%p,theta(ilevel)%p,dz(ilevel)%p,&
                      z(ilevel)%p,izspace(ilevel),kguards_at_level(ilevel),&
                      i1(ilevel),i2(ilevel),elecs(ilevel)%p,guards(ilevel))
  enddo

  ! Tests.
  do ilevel = ilevel_fine, ilevel_coarse
    nr      = nr_at_level(ilevel)
    ntheta  = ntheta_at_level(ilevel)
    nz      = nz_at_level(ilevel)
    kguards = kguards_at_level(ilevel)

    !------------------------------------------------------------------------------------------
    ! Tests of heights.
    !------------------------------------------------------------------------------------------

    ! The height is monotonically increasing.
    do k=1,nz+1
      call assert_true(z(ilevel)%p(k-1) < z(ilevel)%p(k), "z(k) value is increasing with k.")
    enddo

    ! Assume that the electrode bottom is at the kguards+1, and the electrode top is at the 3*kguards.

    ! z(k) at the electrode bottom is equal to the 1/4 cylinder height.
    call assert_comparable_real(z(ilevel)%p(kguards+1), 0.25_CUSTOM_REAL*sens%heicyl, tol, &
                                "z(k) at the electrode bottom is equal to the 1/4 cylinder height.")

    ! z(k) at the electrode top is equal to the 3/4 cylinder height.
    call assert_comparable_real(z(ilevel)%p(3*kguards), 0.75_CUSTOM_REAL*sens%heicyl, tol, &
                                "z(k) at the electrode top is equal to the 3/4 cylinder height.")

    if (izspace(ilevel) /= 0) then
      ! Correct z(k) at the top of the lower guard.
      call assert_comparable_real(z(ilevel)%p(kguards+1-izspace(ilevel)-1), &
                                  0.25_CUSTOM_REAL*sens%heicyl-sens%space_elec_guards, tol, &
                                  "Correct z(k) at the top of the lower guard.")

      ! Correct z(k) at the bottom of the upper guard.
      call assert_comparable_real(z(ilevel)%p(3*kguards+izspace(ilevel)+1), &
                                  0.75_CUSTOM_REAL*sens%heicyl+sens%space_elec_guards, tol, &
                                  "Correct z(k) at the bottom of the upper guard.")
    endif

    ! TODO: Add the test that if we have z-gaps on 1st level than we should have them on all levels???

    ! z(k) at k=0 is equal to zero.
    call assert_comparable_real(z(ilevel)%p(0), 0._CUSTOM_REAL, tol, "z(k) at k=0 is equal to zero.")

    ! z(k) at k=nz+1 is equal to the cylinder height.
    call assert_comparable_real(z(ilevel)%p(nz+1), sens%heicyl, tol, "z(k) at k=nz+1 is equal to the cylinder height.")

    ! Integral of dz is equal to the cylinder height.
    z_sum = 0._CUSTOM_REAL
    do k=1,nz+1
      z_sum = z_sum + dz(ilevel)%p(k)

      ! Correct dz(k) = z(k) - z(k-1).
      call assert_comparable_real(z(ilevel)%p(k), z(ilevel)%p(k-1)+dz(ilevel)%p(k), tol, "Correct dz(k).")
    enddo
    call assert_comparable_real(z_sum, sens%heicyl, tol, "Integral of dz is equal to the cylinder height.")

    !------------------------------------------------------------------------------------------
    ! Tests of radii.
    !------------------------------------------------------------------------------------------

    ! The radius is monotonically increasing.
    do i=1,2*nr+1
      call assert_true(r(ilevel)%p(i-1) < r(ilevel)%p(i), "r(i) value is increasing with i.")
    enddo

    ! Radii at i1, i2, and 2*nr+1 correspond to radiusin, radiusout, and radiusoutout.
    call assert_comparable_real(r(ilevel)%p(2*i1(ilevel)-1), sens%radiusin, tol, "Radius at i=i1 is radiusin.")
    call assert_comparable_real(r(ilevel)%p(2*i2(ilevel)-1), sens%radiusout, tol, "Radius at i=i2 is radiusout.")
    call assert_comparable_real(r(ilevel)%p(2*(nr+1)-1), sens%radiusoutout, tol, "Radius at i=nr+1 is radiusoutout.")

    ! Tests for a new radii Mapping #3: cell index i --> radius index 2i-1,
    ! with ghost points i=0 and i=nr+1 separated by 2dr from regular points i=1 and i=nr.
    call assert_comparable_real(2._CUSTOM_REAL*r(ilevel)%p(0), r(ilevel)%p(1), tol, &
                                "Correct radius index mapping near the axis (0 and 1).")

    call assert_comparable_real(3._CUSTOM_REAL*r(ilevel)%p(0), r(ilevel)%p(2), tol, &
                                "Correct radius index mapping near the axis (0 and 2).")

    call assert_comparable_real(2._CUSTOM_REAL*r(ilevel)%p(1), r(ilevel)%p(3), tol, &
                                "Correct radius index mapping near the axis (1 and 3).")

    call assert_comparable_real(dr(ilevel)%p(0), r(ilevel)%p(0), tol, "Correct dr(0).")

    !------------------------------------------------------------------------------------------
    ! Tests of angles.
    !------------------------------------------------------------------------------------------

    ! The angle is monotonically decreasing.
    do j=1,ntheta+1
      call assert_true(theta(ilevel)%p(j-1) > theta(ilevel)%p(j), "theta(j) value is decreasing with j.")
    enddo

    ! Correct theta values at the angle = 0 and -2Pi.
    call assert_comparable_real(theta(ilevel)%p(1), 0._CUSTOM_REAL, tol, "Correct theta(1) value.")
    call assert_comparable_real(theta(ilevel)%p(ntheta+1), -2._CUSTOM_REAL*PI, tol, "Correct theta(ntheta+1) value.")

    ! Correct periodic boundary conditions in theta.
    call assert_comparable_real(theta(ilevel)%p(0), theta(ilevel)%p(ntheta)+2._CUSTOM_REAL*PI, tol, &
                                "Correct periodic boundary conditions in theta 0.")

    call assert_comparable_real(theta(ilevel)%p(1), theta(ilevel)%p(ntheta+1)+2._CUSTOM_REAL*PI, tol, &
                                "Correct periodic boundary conditions in theta 1.")

    ! (***)
    ! Note that we can only satisfy the below tests for a system with gaps,
    ! so technically multigrid cannot be applied to systems without gaps.
    if (ilevel > 1 .and. nint(sens%space_electrodes) > 0) then
      do ielectrode=1,par%nel
        ! The min angle at the tips of the electrodes is the same at every level.
        call assert_comparable_real(theta(ilevel)%p(elecs(ilevel)%p(ielectrode)%ithetamin), &
                                    theta(ilevel-1)%p(elecs(ilevel-1)%p(ielectrode)%ithetamin), tol, &
                                    "The min angle at the tips of the electrodes is the same at every level.")

        ! The max angle at the tips of the electrodes is the same at every level.
        call assert_comparable_real(theta(ilevel)%p(elecs(ilevel)%p(ielectrode)%ithetamax), &
                                    theta(ilevel-1)%p(elecs(ilevel-1)%p(ielectrode)%ithetamax), tol, &
                                    "The max angle at the tips of the electrodes is the same at every level.")
      enddo
    endif

    ! I. The checks between electrodes, except a pair 12 and 1:

    do ielectrode=2,par%nel
      ! The same number of points at every electrode.
      call assert_equal_int(elecs(ilevel)%p(ielectrode)%ithetamax-elecs(ilevel)%p(ielectrode)%ithetamin, &
                            elecs(ilevel)%p(ielectrode-1)%ithetamax-elecs(ilevel)%p(ielectrode-1)%ithetamin, &
                            "The same number of points at every electrode.")

      ! Correct angle of gaps between electrodes.
      if (nint(sens%space_electrodes) > 0) then
        call assert_comparable_real(theta(ilevel)%p(elecs(ilevel)%p(ielectrode)%ithetamin)- &
                                    theta(ilevel)%p(elecs(ilevel)%p(ielectrode-1)%ithetamax), &
                                    -sens%space_electrodes*PI/180._CUSTOM_REAL, &
                                    tol, "Correct angle of gaps between electrodes.")
      endif

      gap_size = elecs(ilevel)%p(ielectrode)%ithetamin-elecs(ilevel)%p(ielectrode-1)%ithetamax
      if (nint(sens%space_electrodes) > 0) then
        ! The gaps between electrodes are present.
        call assert_true(gap_size > 1, "The gaps between electrodes: at least one point on the gap.")
      else
        ! The gaps between electrodes are absent.
        ! Commented this test since we actually have gaps in this case, i.e.,
        ! when electrode grid points are 1-3, 4-6, 7-9 (for grid) 36^3, there is a gap between points 3 and 4.
        !call assert_equal_int(gap_size, 0, "The gaps between electrodes are absent.")
      endif
    enddo

    ! II. The rest checks between electrode pair 12 and 1:

    if (nint(sens%space_electrodes) > 0) then
      ! Correct angle of gaps between electrodes.
      call assert_comparable_real(theta(ilevel)%p(elecs(ilevel)%p(1)%ithetamin)- &
                                  theta(ilevel)%p(elecs(ilevel)%p(12)%ithetamax), &
                                  -sens%space_electrodes*PI/180._CUSTOM_REAL+2._CUSTOM_REAL*PI, &
                                  tol, "Correct angle of gaps between electrodes (1 and 12).")
    endif

  enddo ! End Tests.

  !----------------------------------------------------------------------------------
  ! Deallocate all the arrays
  !----------------------------------------------------------------------------------

  do ilevel=ilevel_fine, ilevel_coarse
    deallocate(theta(ilevel)%p)
    deallocate(dr(ilevel)%p)
    deallocate(dz(ilevel)%p)
    deallocate(r(ilevel)%p)
    deallocate(z(ilevel)%p)
    deallocate(elecs(ilevel)%p)
  enddo

  ! deallocate all pointer arrays
  deallocate(i1)
  deallocate(i2)
  deallocate(nr_at_level)
  deallocate(ntheta_at_level)
  deallocate(nz_at_level)
  deallocate(nzlocal_at_level)
  deallocate(kguards_at_level)

  deallocate(izspace)
  deallocate(theta)
  deallocate(dr)
  deallocate(dz)
  deallocate(r)
  deallocate(z)
  deallocate(elecs)
  deallocate(guards)

end subroutine test_geometry

!==============================================================================================
! Tests of the boundary conditions and right hand side.
!==============================================================================================
subroutine test_boundary_conditions(size, ilevel_coarse, ifixed_elecgeo, sens)

  integer, intent(in) :: size
  integer, intent(in) :: ilevel_coarse, ifixed_elecgeo
  type(t_sensor), intent(in) :: sens

  type(t_parameters_ect) :: par
  integer :: ilevel
  integer :: nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read

  integer, dimension(:), allocatable :: i1, i2
  type(t_electrode_p), dimension(:), allocatable :: elecs
  type(t_guards), dimension(:), allocatable :: guards
  type(real_p), dimension(:), allocatable :: r, z, dr, dz, theta
  integer, dimension(:), allocatable :: nr_at_level, ntheta_at_level, nz_at_level, kguards_at_level
  integer, dimension(:), allocatable :: nzlocal_at_level
  type(real3_p), dimension(:), allocatable :: val, phi, x2
  type(int3_p), dimension(:), allocatable :: flag
  integer, dimension(:), allocatable :: izspace
  integer :: ielectrode

  integer :: nr, ntheta, nz, nzlocal
  integer :: j, k, k1

  ! For the multigrid method start from level=1.
  integer, parameter :: ilevel_fine = 1
  !--------------------------------------------------------------------------

  !print *, ' size, ilevel_coarse, ifixed_elecgeo, space_electrodes, space_elec_guards = '
  !print *, '     ', size, ilevel_coarse, ifixed_elecgeo, sens%space_electrodes, sens%space_elec_guards

  call init_params(size, nbproc, par, nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read, ifixed_elecgeo)
  par%sens = sens

  !--------------------------------------------------------------------------
  allocate(i1(ilevel_coarse))
  allocate(i2(ilevel_coarse))
  allocate(nr_at_level(ilevel_coarse))
  allocate(ntheta_at_level(ilevel_coarse))
  allocate(nz_at_level(ilevel_coarse))
  allocate(nzlocal_at_level(ilevel_coarse))
  allocate(kguards_at_level(ilevel_coarse))
  allocate(izspace(ilevel_coarse))

  allocate(theta(ilevel_coarse))
  allocate(dr(ilevel_coarse))
  allocate(dz(ilevel_coarse))
  allocate(r(ilevel_coarse))
  allocate(z(ilevel_coarse))
  allocate(elecs(ilevel_coarse))
  allocate(guards(ilevel_coarse))
  allocate(flag(ilevel_coarse))
  allocate(val(ilevel_coarse))
  allocate(phi(ilevel_coarse))
  allocate(x2(ilevel_coarse))

  call set_dimensions_multigrid(ilevel_coarse, nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read, &
                    nr_at_level, ntheta_at_level, nz_at_level, nzlocal_at_level, kguards_at_level)

  do ilevel = ilevel_fine, ilevel_coarse
    nr      = nr_at_level(ilevel)
    ntheta  = ntheta_at_level(ilevel)
    nz      = nz_at_level(ilevel)
    nzlocal = nzlocal_at_level(ilevel)

    allocate(theta(ilevel)%p(0:ntheta+1))
    allocate(dr(ilevel)%p(0:2*nr+1))
    allocate(dz(ilevel)%p(0:nz+1))
    allocate(r(ilevel)%p(0:2*nr+1))
    allocate(z(ilevel)%p(0:nz+1))
    allocate(elecs(ilevel)%p(par%nel))
    allocate(flag(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
    allocate(val(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
    allocate(phi(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
    allocate(x2(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
  enddo

  ! The tests depend on the geometry() function.
  do ilevel = ilevel_fine, ilevel_coarse
    call set_geometry(ilevel,par,nr_at_level(ilevel),ntheta_at_level(ilevel),nz_at_level(ilevel),&
                      r(ilevel)%p,dr(ilevel)%p,theta(ilevel)%p,dz(ilevel)%p,&
                      z(ilevel)%p,izspace(ilevel),kguards_at_level(ilevel),&
                      i1(ilevel),i2(ilevel),elecs(ilevel)%p,guards(ilevel))
  enddo

  !----------------------------------------------------------------------------------
  ! TESTS of flag_init_outer_bc() function: depends on geometry()
  !----------------------------------------------------------------------------------

  do ilevel = ilevel_fine, ilevel_coarse
    call flag_init_bc(flag(ilevel)%p,nr_at_level(ilevel),ntheta_at_level(ilevel), &
                      nzlocal_at_level(ilevel),i1(ilevel),i2(ilevel),par%nel, &
                      elecs(ilevel)%p,guards(ilevel),myrank,nbproc)
  enddo

  ! Tests.
  do ilevel = ilevel_fine, ilevel_coarse
    nr      = nr_at_level(ilevel)
    ntheta  = ntheta_at_level(ilevel)
    nzlocal = nzlocal_at_level(ilevel)

    ! Check the BC's at electrodes.
    do k=0,nzlocal+1
      k1=myrank*nzlocal+k

      do ielectrode=1,par%nel
        do j=elecs(ilevel)%p(ielectrode)%ithetamin,elecs(ilevel)%p(ielectrode)%ithetamax
          ! Skip the guards.
          if (k1 >= elecs(ilevel)%p(ielectrode)%izmin .and. k1 <= elecs(ilevel)%p(ielectrode)%izmax) then
            call assert_equal_int(flag(ilevel)%p(i2(ilevel),j,k), 1, "Correct BC's flag(i,j,k) at electrodes.")
          endif
        enddo
      enddo
    enddo

  enddo ! End Tests.

  !----------------------------------------------------------------------------------
  ! TESTS of solution_init() function: depends on geometry() and flag_init_outer_bc()
  !----------------------------------------------------------------------------------

  do ielectrode=1,par%nel
    nr      = nr_at_level(ilevel_fine)
    ntheta  = ntheta_at_level(ilevel_fine)
    nzlocal = nzlocal_at_level(ilevel_fine)

    ! (!!!) The function being tested.
    ! It is called only on the fine level!
    call solution_init(phi(ilevel_fine)%p,val(ilevel_fine)%p,flag(ilevel_fine)%p,&
                       x2(ilevel_fine)%p,par%dims,&
                       myrank,i2(ilevel_fine),elecs(ilevel_fine)%p(ielectrode))

    ! The solution is set to zero everywhere at the outermost cylinder i=nr+1.
    do k=0,nzlocal+1
      do j=0,ntheta+1
        call assert_comparable_real(val(ilevel_fine)%p(nr+1,j,k), 0._CUSTOM_REAL, tol, &
                                    "The solution is set to zero everywhere at the outermost cylinder.")
      enddo
    enddo

    ! The solution is set to unity everywhere at the electrode.
    do k=0,nzlocal+1
      k1=myrank*nzlocal+k

      do j=elecs(ilevel_fine)%p(ielectrode)%ithetamin,elecs(ilevel_fine)%p(ielectrode)%ithetamax
        ! Skip the guards.
        if (k1 >= elecs(ilevel_fine)%p(ielectrode)%izmin .and. k1 <= elecs(ilevel_fine)%p(ielectrode)%izmax) then
          call assert_comparable_real(val(ilevel_fine)%p(i2(ilevel_fine),j,k), 1._CUSTOM_REAL, tol, &
                                      "The solution is set to unity everywhere at the electrode.")
        endif
      enddo
    enddo

    ! The solution is set to zero everywhere at the guards.
    do k=0,nzlocal+1
      k1=myrank*nzlocal+k

      if (k1 <= guards(ilevel_fine)%lower_izmax .and. k1 >= guards(ilevel_fine)%upper_izmin) then
        do j=0,ntheta+1
          call assert_comparable_real(val(ilevel_fine)%p(i2(ilevel_fine),j,k), 0._CUSTOM_REAL, tol, &
                                      "The solution is set to zero everywhere at the guards.")
        enddo
      endif
    enddo

  enddo

  !----------------------------------------------------------------------------------
  ! Deallocate all the arrays
  !----------------------------------------------------------------------------------

  do ilevel=ilevel_fine, ilevel_coarse
    deallocate(theta(ilevel)%p)
    deallocate(dr(ilevel)%p)
    deallocate(dz(ilevel)%p)
    deallocate(r(ilevel)%p)
    deallocate(z(ilevel)%p)
    deallocate(elecs(ilevel)%p)
    deallocate(flag(ilevel)%p)
    deallocate(val(ilevel)%p)
    deallocate(phi(ilevel)%p)
    deallocate(x2(ilevel)%p)
  enddo

  ! deallocate all pointer arrays
  deallocate(i1)
  deallocate(i2)
  deallocate(nr_at_level)
  deallocate(ntheta_at_level)
  deallocate(nz_at_level)
  deallocate(nzlocal_at_level)
  deallocate(kguards_at_level)

  deallocate(izspace)
  deallocate(theta)
  deallocate(dr)
  deallocate(dz)
  deallocate(r)
  deallocate(z)
  deallocate(elecs)
  deallocate(guards)
  deallocate(flag)
  deallocate(val)
  deallocate(phi)
  deallocate(x2)

end subroutine test_boundary_conditions

!==============================================================================================
! Compare the solution to analytical ones for the Laplace equation in cylinder with BC's:
! (1) u=1 on the side wall, and u=0 on the top and bottom walls [M. A. Pinsky, Example 3.5.1],
! (2) u=1 on the top wall, and u=0 on the bottom and side walls [M. A. Pinsky, Example 3.5.2].
!==============================================================================================
subroutine test_analytical_comparison(bc_type, size, ilevel_coarse, itmax, sens)

  ! The type boundary conditions -- to test different analytical solutions.
  integer, intent(in) :: bc_type

  integer, intent(in) :: size
  integer, intent(in) :: ilevel_coarse, itmax
  type(t_sensor), intent(in) :: sens

  type(t_parameters_ect) :: par
  type(t_dimensions), allocatable :: dims_at_level(:)
  integer :: ilevel
  integer :: nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read

  integer, dimension(:), allocatable :: i1, i2
  type(t_electrode_p), dimension(:), allocatable :: elecs
  type(t_guards), dimension(:), allocatable :: guards
  type(real_p), dimension(:), allocatable :: r, z, dr, dz, theta
  integer, dimension(:), allocatable :: nr_at_level, ntheta_at_level, nz_at_level, kguards_at_level
  integer, dimension(:), allocatable :: nzlocal_at_level
  type(real3_p), dimension(:), allocatable :: xgrid, ygrid, zgrid
  type(real3_p), dimension(:), allocatable :: val, phi, x2, permit
  type(int3_p), dimension(:), allocatable :: flag
  integer, dimension(:), allocatable :: izspace
  real(kind=CUSTOM_REAL) permit_isolated_tube, permit_air
  type(real4_p), dimension(:), allocatable :: a
  type(real3_p), dimension(:), allocatable :: b_RHS
  integer :: iter_pcg, ifixed_elecgeo
  type (t_pcg_auxarrays) :: pcg_auxarrays
  ! Analytical solution.
  real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: asol

  integer :: nr, ntheta, nz, nzlocal
  integer :: i, j, k, imax, kmax
  integer :: ierr
  !character(len=40) :: name

  ! For the multigrid method start from level=1.
  integer, parameter :: ilevel_fine = 1

  ! Frequency of printing information during iterations.
  integer, parameter :: output_frequency = 20
  !--------------------------------------------------------------------------

  !print *, ' bc_type, size, ilevel_coarse, itmax = '
  !print *, '     ', bc_type, size, ilevel_coarse, itmax

  ! No electrodes in analytical solutions.
  ifixed_elecgeo = 0

  ! RM RM added this 2 March 2015
  par%iprecond = 1
  par%omega1 = 0.8_CUSTOM_REAL

  call init_params(size, nbproc, par, nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read, ifixed_elecgeo)
  par%sens = sens

  !--------------------------------------------------------------------------
  allocate(i1(ilevel_coarse))
  allocate(i2(ilevel_coarse))
  allocate(nr_at_level(ilevel_coarse))
  allocate(ntheta_at_level(ilevel_coarse))
  allocate(nz_at_level(ilevel_coarse))
  allocate(nzlocal_at_level(ilevel_coarse))
  allocate(dims_at_level(ilevel_coarse))
  allocate(kguards_at_level(ilevel_coarse))
  allocate(izspace(ilevel_coarse))

  allocate(theta(ilevel_coarse))
  allocate(dr(ilevel_coarse))
  allocate(dz(ilevel_coarse))
  allocate(r(ilevel_coarse))
  allocate(z(ilevel_coarse))
  allocate(xgrid(ilevel_coarse))
  allocate(ygrid(ilevel_coarse))
  allocate(zgrid(ilevel_coarse))
  allocate(elecs(ilevel_coarse))
  allocate(guards(ilevel_coarse))
  allocate(flag(ilevel_coarse))
  allocate(val(ilevel_coarse))
  allocate(phi(ilevel_coarse))
  allocate(x2(ilevel_coarse))
  allocate(permit(ilevel_coarse))
  allocate(a(ilevel_coarse))
  allocate(b_RHS(ilevel_coarse))

  call set_dimensions_multigrid(ilevel_coarse, nr_read, nz_read, nzlocal_read, ntheta_read, kguards_read, &
                                nr_at_level, ntheta_at_level, nz_at_level, nzlocal_at_level, kguards_at_level)

  do ilevel = ilevel_fine, ilevel_coarse
    nr      = nr_at_level(ilevel)
    ntheta  = ntheta_at_level(ilevel)
    nz      = nz_at_level(ilevel)
    nzlocal = nzlocal_at_level(ilevel)

    ! TODO: keep only dims_at_level (remove nr_at_level, ...).
    dims_at_level(ilevel)%nr = nr
    dims_at_level(ilevel)%ntheta = ntheta
    dims_at_level(ilevel)%nz = nz
    dims_at_level(ilevel)%nzlocal = nzlocal

    allocate(theta(ilevel)%p(0:ntheta+1))
    allocate(dr(ilevel)%p(0:2*nr+1))
    allocate(dz(ilevel)%p(0:nz+1))
    allocate(r(ilevel)%p(0:2*nr+1))
    allocate(z(ilevel)%p(0:nz+1))
    allocate(xgrid(ilevel)%p(0:nr+1,0:ntheta+1,0:nz+1))
    allocate(ygrid(ilevel)%p(0:nr+1,0:ntheta+1,0:nz+1))
    allocate(zgrid(ilevel)%p(0:nr+1,0:ntheta+1,0:nz+1))
    allocate(elecs(ilevel)%p(par%nel))
    allocate(flag(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
    allocate(val(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
    allocate(phi(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
    allocate(x2(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
    allocate(permit(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
    allocate(a(ilevel)%p(1:nr,1:ntheta,1:nzlocal,7))
    allocate(b_RHS(ilevel)%p(0:nr+1,0:ntheta+1,0:nzlocal+1))
  enddo

  allocate(pcg_auxarrays%p(0:nr_read+1,0:ntheta_read+1,0:nzlocal_read+1))
  allocate(pcg_auxarrays%r(0:nr_read+1,0:ntheta_read+1,0:nzlocal_read+1))
  allocate(pcg_auxarrays%inv_diagA(1:nr_read,1:ntheta_read,1:nzlocal_read))
  allocate(pcg_auxarrays%z(0:nr_read+1,0:ntheta_read+1,0:nzlocal_read+1))
  allocate(pcg_auxarrays%tmp(0:nr_read+1,0:ntheta_read+1,0:nzlocal_read+1))

  allocate(asol(0:nr_read+1,0:ntheta_read+1,0:nz_read+1))
  !----------------------------------------------------------------------------------

  do ilevel = ilevel_fine, ilevel_coarse
    call set_geometry(ilevel,par,nr_at_level(ilevel),ntheta_at_level(ilevel),nz_at_level(ilevel),&
                      r(ilevel)%p,dr(ilevel)%p,theta(ilevel)%p,dz(ilevel)%p,&
                      z(ilevel)%p,izspace(ilevel),kguards_at_level(ilevel),&
                      i1(ilevel),i2(ilevel),elecs(ilevel)%p,guards(ilevel))

    ! TODO: initialize xgrid,ygrid,zgrid
  enddo

  permit_air = 1._CUSTOM_REAL
  permit_isolated_tube = 1._CUSTOM_REAL

  do ilevel=ilevel_fine, ilevel_coarse
    nr      = nr_at_level(ilevel)
    ntheta  = ntheta_at_level(ilevel)
    nz      = nz_at_level(ilevel)

    ! Set permittivity everywhere to constant.
    permit(ilevel)%p(:,:,:) = permit_air

    ! The position of the side wall.
    imax = nr+1

    ! The position of the top wall.
    kmax = nz+1

    ! Set Dirichlet BCs flag.
    flag(ilevel)%p(:,:,:) = 0

    do k=0,nz+1
      do j=0,ntheta+1
        do i=0,nr+1
          ! Side wall.
          if (i == imax) flag(ilevel)%p(i,j,k) = 1
          ! Bottom wall.
          if (k == 0) flag(ilevel)%p(i,j,k) = 1
          ! Top wall.
          if (k == kmax) flag(ilevel)%p(i,j,k) = 1
        enddo
      enddo
    enddo
  enddo

  ! (+) Set boundary conditions (through the right-hand-side of Ax=b_RHS) --------
  b_RHS(ilevel_fine)%p(:,:,:) = 0._CUSTOM_REAL

  if (bc_type == 1) then
    do k=1,kmax-1
      do j=0,ntheta_read+1
        ! Side wall excluding first and last points (bottom and top walls).
        b_RHS(ilevel_fine)%p(imax,j,k) = 1._CUSTOM_REAL
      enddo
    enddo
  else if (bc_type == 2) then
    do j=0,ntheta_read+1
      do i=0,imax-1
        ! Top wall excluding last point (side wall).
        b_RHS(ilevel_fine)%p(i,j,kmax) = 1._CUSTOM_REAL
      enddo
    enddo
  else if (bc_type == 3) then
    do k=(kmax-1)/4+1,3*(kmax-1)/4
      do j=0,ntheta_read+1
        ! Side wall excluding guards.
        b_RHS(ilevel_fine)%p(imax,j,k) = 1._CUSTOM_REAL
      enddo
    enddo
  else if (bc_type == 4) then
    do k=1,kmax-1
      do j=0,ntheta_read+1
        ! Gradually side walls.
        ! f(x)=4x(1-x), f(0)=f(1)=0, f(1/2)=1, f'(1/2)=0.
        b_RHS(ilevel_fine)%p(imax,j,k) = &
                  4._CUSTOM_REAL*dble(k)/dble(kmax)*(1._CUSTOM_REAL - dble(k)/dble(kmax))
      enddo
    enddo
  else
    print *, "Unknown boundary conditions type!"
    stop
  endif
  ! (-) Set boundary conditions ------------------------------------------------------------

  ! Initialize matrix.
  do ilevel = ilevel_fine, ilevel_coarse
    call matrix_init(a(ilevel)%p, flag(ilevel)%p, permit(ilevel)%p, permit_isolated_tube, permit_air, r(ilevel)%p, &
                     theta(ilevel)%p, dz(ilevel)%p, dims_at_level(ilevel), i1(ilevel), i2(ilevel), myrank)
  enddo

  ! Smoother.
  do k=1,nzlocal_read
    do j=1,ntheta_read
      do i=1,nr_read
        pcg_auxarrays%inv_diagA(i,j,k)=1._CUSTOM_REAL/a(ilevel_fine)%p(i,j,k,3)
      enddo
    enddo
  enddo

  ! Initial guess.
  x2(ilevel_fine)%p(:,:,:) = b_RHS(ilevel_fine)%p(:,:,:)

  ! Solve the system numerically.
  call solver_pcg(a(ilevel_fine)%p,b_RHS(ilevel_fine)%p,x2(ilevel_fine)%p,NORM_L2,par%iprecond,par%omega1,&
                  1.e-12_CUSTOM_REAL,itmax,iter_pcg,output_frequency,.false.,&
                  nr_at_level(ilevel_fine),ntheta_at_level(ilevel_fine),nzlocal_at_level(ilevel_fine),&
                  ierr,myrank,nbproc,pcg_auxarrays)

  ! Enforce periodic boundary conditions.
  call enforce_pb(nr_read, ntheta_read, nzlocal_read, x2(ilevel_fine)%p)

  ! Find analytical solution.
  if (bc_type == 1) then
    call solution1(nr_read,ntheta_read,nz_read,r(ilevel_fine)%p,z(ilevel_fine)%p,asol,imax,kmax,1)
  else if (bc_type == 2) then
    call solution2(nr_read,ntheta_read,nz_read,r(ilevel_fine)%p,z(ilevel_fine)%p,asol,imax,kmax)
  else if (bc_type == 3) then
    call solution1(nr_read,ntheta_read,nz_read,r(ilevel_fine)%p,z(ilevel_fine)%p,asol,imax,kmax,2)
  else if (bc_type == 4) then
    call solution1(nr_read,ntheta_read,nz_read,r(ilevel_fine)%p,z(ilevel_fine)%p,asol,imax,kmax,3)
  endif

  !------------------------------------------------------------------------------------------------
  nr      = nr_at_level(ilevel_fine)
  ntheta  = ntheta_at_level(ilevel_fine)
  nz      = nz_at_level(ilevel_fine)

!  path_output = "output_tests/"
!
!  write (name, '("phi3d_half_nz",i3.3,"_numerical.vtk")') nz
!  call visualisation_paraview(name, myrank, nr, ntheta, nz, &
!        x2(ilevel_fine)%p, xgrid(ilevel_fine)%p, ygrid(ilevel_fine)%p, zgrid(ilevel_fine)%p, &
!        0, imax, ntheta/2+1, ntheta+1, 0, kmax, 1, ntheta/4, 1, 'POINT_DATA')
!
!  write (name, '("phi3d_half_nz",i3.3,"_analytical.vtk")') nz
!  call visualisation_paraview(name, myrank, nr, ntheta, nz, &
!        asol, xgrid(ilevel_fine)%p, ygrid(ilevel_fine)%p, zgrid(ilevel_fine)%p, &
!        0, imax, ntheta/2+1, ntheta+1, 0, kmax, 1, ntheta/4, 1, 'POINT_DATA')

  ! Calculate the error.
  do k=0,kmax
    do j=0,ntheta_read+1
      do i=0,imax
        if (i == 0) then
          asol(i,j,k) = 0._CUSTOM_REAL
        endif

        ! !! TEMPORARY
!        if (flag(ilevel_fine)%p(i,j,k) == 1) then
!          asol(i,j,k) = 0._CUSTOM_REAL
!        endif

        ! The relative error.
        if (asol(i,j,k) /= 0._CUSTOM_REAL) then
          asol(i,j,k) = abs((asol(i,j,k) - x2(ilevel_fine)%p(i,j,k)) / asol(i,j,k))

          ! Assert the error is small.
          call assert_true(asol(i,j,k) < 5.d-2, "Large error in test_analytical_comparison.")
        endif
      enddo
    enddo
  enddo

!  write (name, '("phi3d_half_nz",i3.3,"_error.vtk")') nz
!  call visualisation_paraview(name, myrank, nr, ntheta, nz, &
!        asol, xgrid(ilevel_fine)%p, ygrid(ilevel_fine)%p, zgrid(ilevel_fine)%p, &
!        0, imax, ntheta/2+1, ntheta+1, 0, kmax, 1, ntheta/4, 1, 'POINT_DATA')

  !----------------------------------------------------------------------------------
  ! Deallocate all the arrays
  !----------------------------------------------------------------------------------

  do ilevel=ilevel_fine, ilevel_coarse
    deallocate(theta(ilevel)%p)
    deallocate(dr(ilevel)%p)
    deallocate(dz(ilevel)%p)
    deallocate(r(ilevel)%p)
    deallocate(z(ilevel)%p)
    deallocate(xgrid(ilevel)%p)
    deallocate(ygrid(ilevel)%p)
    deallocate(zgrid(ilevel)%p)
    deallocate(elecs(ilevel)%p)
    deallocate(flag(ilevel)%p)
    deallocate(val(ilevel)%p)
    deallocate(phi(ilevel)%p)
    deallocate(x2(ilevel)%p)
    deallocate(permit(ilevel)%p)
    deallocate(a(ilevel)%p)
    deallocate(b_RHS(ilevel)%p)
  enddo

  ! deallocate all pointer arrays
  deallocate(i1)
  deallocate(i2)
  deallocate(nr_at_level)
  deallocate(ntheta_at_level)
  deallocate(nz_at_level)
  deallocate(nzlocal_at_level)
  deallocate(kguards_at_level)

  deallocate(izspace)
  deallocate(theta)
  deallocate(dr)
  deallocate(dz)
  deallocate(r)
  deallocate(z)
  deallocate(xgrid)
  deallocate(ygrid)
  deallocate(zgrid)
  deallocate(elecs)
  deallocate(guards)
  deallocate(flag)
  deallocate(val)
  deallocate(phi)
  deallocate(x2)
  deallocate(permit)
  deallocate(a)
  deallocate(b_RHS)

  deallocate(asol)

end subroutine test_analytical_comparison

end module tests_ect


      subroutine add_tension(amat, wten, hx, tens, tensv, fpoly, n, nb,
     1   ioff, nmat)
      use vspline
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer n, nb, ioff, nmat
      real(rprec) tens, tensv, fpoly
      real(rprec), dimension(nmat,*) :: amat
      real(rprec), dimension(nmat) :: wten
      real(rprec), dimension(n) :: hx
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: k, i, koff
      real(rprec), dimension(n) :: wten0, tenshx, work
      real(rprec) :: delta_x, tension
C-----------------------------------------------

!
!       THIS SUBROUTINE ADDS THE TENSION TERM WTEN*(DEL(K) - DEL(K-1))
!       TO THE REST OF THE CHI-SQ AMAT, WHERE DEL(K) = (G(K+1)-G(K))/H(K)
!       AND G(K) IS THE SECOND DERIVATIVE AT THE K-TH KNOT
!
!       IOFF ALLOWS FOR ADDING TENSION SEPARATELY TO IOTA (IOFF=0)
!       AND PRESSURE (IOFF=NIOTA) SPLINES
!
!       tens:   spline tension (optionally, at the 1st pt only;see note)
!       tensv:  vbl spline tension for n-1th point (see note)
!       fpoly:  vbl spline tension form factor (note: if tens1<>tens2
!               then tension(i-th point) = tens+(tensv-tens)*(i/n-1))**fpoly)

!
!       BOUNDS CHECKING
!
      if (n + ioff > nmat) stop '(n+ioff>nmat)'
      if (fpoly < 0.) stop '(fpoly<0)'
      if (n < 1) stop '(n < 1)'

!
!       COMPUTE TENSION COEFFICIENTS
!

      delta_x = sum(hx(:n-1))
      tension = 0.5*(delta_x/(n))**3
      if (fpoly.eq.0. .or. tens.eq.tensv) then
         tenshx(:n-1) = tens
      else
         do i = 1, n - 1
            tenshx(i) = tens + (tensv - tens)*(real(i - 1,rprec)/
     1         (n - 1))**fpoly
         end do
      endif

      do i = 1,n-1
        tenshx(i) = tension * tenshx(i) / hx(i)
        work(i) = hx(i)*(wten(i+ioff) + wten(i+ioff+1))
      enddo
      do i = 2,n-1
        wten0(i) = 0.5 * ( work(i) + work(i-1) )/(hx(i) + hx(i-1))
      enddo
      wten0(1) = wten0(2)
      wten0(n) = wten(n+ioff)
!
!       COMPUTE, FOR K = 1,N, B(K,L)*JACOBIAN(L,I) = W(K,I),
!       WHERE JACOBIAN = D[G]/D[F] and B is TRIDIAGONAL
!       SEE EQN(27) IN PHYS.PLASMAS 1, p 2277.
!
      do k = 1, n
         koff = k + ioff
         work(:n-1) = 0
!       SET UP COEFFICIENTS IN [G(K+1)-G(K)]/h(k) - [G(K)-G(K-1)]/h(k-1)
         if (k .eq. 1) then
            work(2) = tenshx(1)*wten0(2)
            work(1) = -work(2)
         else if (k .eq. n) then
            work(n-1) = tenshx(n-1)*wten0(n-1)
         else
            work(k-1) = tenshx(k-1)*wten0(k-1)
            work(k) = -(tenshx(k)+tenshx(k-1))*wten0(k)
            work(k+1) = tenshx(k)*wten0(k+1)
         endif
         if (nb .eq. natur) work(1) = 0
         work(n) = 0
!
!       COMPUTE work(j) = work(i)*Jacobian(i,j) and add to amat(k,j)
!
         call jacprod (work, hx, n, nb)
         amat(koff,1+ioff:n+ioff) = amat(koff,1+ioff:n+ioff) + work(:n)
      end do

      end subroutine add_tension

      subroutine getspline(amat, splnots, hk, delse, hs, indexs, isort,
     1   ndata0, nots)
      use vsvd0
      use vparams, only: zero
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer ndata0, nots
      real(rprec) hs
      integer, dimension(ndata0) :: indexs, isort
      real(rprec), dimension(nots,ndata0) :: amat
      real(rprec), dimension(nots) :: splnots, hk
      real(rprec), dimension(ndata0) :: delse
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer, dimension(nots) :: nk
      integer :: i, js, ia, k, k1, ib, j, nb
      real(rprec), dimension(ndata0) :: w, w1, u, u1, snodes
      real(rprec), dimension(nots,ndata0) :: bmat
C-----------------------------------------------

!
!       ON EXIT, AMAT = AMAT + BMAT, WHERE BMAT IS THE 2nd
!       DERIVATIVE COEFFICIENT MATRIX ARRAY, MULTIPLIED BY JACOBIAN
!       AND AMAT (ON RHS) WAS FUNCTION COEFFICIENT MATRIX ARRAY
!

!
!       SORT KNOT POSITIONS IN ASCENDING ORDER IN S-SPACE
!       USE SQRT(S) KNOT POSITIONS FOR IMPROVED RESOLUTION
!       NOTE: SNODES(I) IS THE VALUE OF SQRT(S) CORRESPONDING TO
!       THE MESH VALUES CORRESPONDING TO DELSE, INDEXS (COMPUTED OUTSIDE
!       THIS PROGRAM)
!

      do i = 1, ndata0
         js = indexs(i)
         snodes(i) = sqrt(hs*((js - 1) + delse(i)))
!        if (snodes(i) .le. zero) snodes(i) = epstan
      end do

!     Avoid roundoff error in SPLININT
      if( snodes(ndata0) .gt. splnots(nots) )
     1    snodes(ndata0) = splnots(nots)

      call sort_data (snodes, isort, ndata0)

!
!       COMPUTE MATRIX COEFFICIENTS RELATING SPLINE AT SPLNOTS
!       TO REAL-SPACE FUNCTION AT SORTED MESH POINTS RMESH
!
      amat(:nots,:ndata0) = zero
      bmat(:nots,:ndata0) = zero

!
!       SETUP SPLINE PARAMETERS AT EACH TIME STEP, SINCE SNODES
!       MAY BE CHANGING DYNAMICALLY IN S-SPACE
!
      call setup_int(splnots,snodes,hk,w,w1,u,u1,nk,nots,ndata0)

      ia = 1
      do k = 1, nots - 1
         if (nk(k) .gt. 0) then
            k1 = k + 1
            ib = ia + nk(k) - 1
            amat(k,ia:ib) = amat(k,ia:ib) + w(ia:ib)
            bmat(k,ia:ib) = bmat(k,ia:ib) + u(ia:ib)
            amat(k1,ia:ib) = amat(k1,ia:ib) + w1(ia:ib)
            bmat(k1,ia:ib) = bmat(k1,ia:ib) + u1(ia:ib)
            ia = ib + 1
         endif
      end do

      if (ib .ne. ndata0) stop 'ib!=ndat'
      nb = ideriv

      do j = 1, ndata0
         bmat(nots,j) = 0.
         call jacprod (bmat(1,j), hk, nots, nb)
         amat(:nots,j) = amat(:nots,j) + bmat(:nots,j)
      end do

      end subroutine getspline

      subroutine gety2(y, y2, h, nots, nb)
      use vspline
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer nots, nb
      real(rprec), dimension(*) :: y, y2, h
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer jmax
      real(rprec), dimension(nots) :: aspline, bspline, dspline
C-----------------------------------------------

      jspmin(1) = 2
      if (nb .eq. ideriv) jspmin(1) = 1
      jmax = nots - 1
      aspline(1) = h(1)
      dspline(1) = 2.0*h(1)
      y2(1) = 0.
      y2(nots) = 0.
      if (nb .eq. ideriv) y2(1) = 6.0*(y(2)-y(1))/h(1)
      aspline(2:jmax) = h(2:jmax)
      bspline(2:jmax) = h(:jmax-1)
      dspline(2:jmax) = 2.0*(h(2:jmax)+h(:jmax-1))
      y2(2:jmax) = 6.0*((y(3:jmax+1)-y(2:jmax))/h(2:jmax)
     1   -(y(2:jmax)-y(:jmax-1))/h(:jmax-1))

      call tridslv(aspline,dspline,bspline,y2,jspmin,jmax,0,nots,1)

      end subroutine gety2

      subroutine initspline(amat, splnot, h, weight, nots)
      use vspline
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer nots
      real(rprec), dimension(nots,nots) :: amat
      real(rprec), dimension(*) :: splnot, h, weight
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer i
      real(rprec) :: eps
C-----------------------------------------------

      if (nots .lt. 3) stop 'nots<3'
      eps = 1.0/(splnot(nots)-splnot(1))

      amat = 0.
      do i = 1, nots
         amat(i,i) = weight(i)
      end do

      do i = 1, nots - 1
         h(i) = splnot(i+1) - splnot(i)
         if (eps*h(i) .le. 1.e-8_dp) stop 'h(i)<1.e-8'
      end do

      end subroutine initspline

      subroutine jacprod(c, h, nots, nb)
      use vspline
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer nots, nb, jmax
      real(rprec), dimension(*) :: c, h
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      real(rprec), dimension(nots) ::
     1   aspline, bspline, dspline, dum1
C-----------------------------------------------

!
!       THIS ROUTINE COMPUTES THE INNER PRODUCT COUT(I) = CIN(J)*JACOBIAN(J,I)
!       WHERE JACOBIAN(J,I) = D[G(J)]/D[F(I)]
!       HERE, G(J) ARE SECOND-DERIVATIVE KNOTS, F(I) FUNCTION KNOTS
!
!       COMPUTE COEFFICIENT ARRAY ELEMENTS A*X(I+1) + D*X(I) + B*X(I-1)
!       (TO BE SAFE, RECOMPUTE EACH TIME, SINCE IOTA, P SPLINES MAY
!        DIFFER FROM CALL TO CALL)
!
      aspline(1) = h(1)
      dspline(1) = 2.0*h(1)
      aspline(2:nots-1) = h(2:nots-1)
      bspline(2:nots-1) = h(:nots-2)
      dspline(2:nots-1) = 2.0*(h(2:nots-1)+h(:nots-2))

      jspmin(1) = 2
      if (nb .eq. ideriv) jspmin(1) = 1
      jmax = nots - 1
      call tridslv(aspline,dspline,bspline,c,jspmin,jmax,0,nots,1)
      dum1(1) = 6.0*(c(2)-c(1))/h(1)
      dum1(2:nots) = 6.0*(c(:nots-1)-c(2:nots))/h(:nots-1)
      c(2:nots-1) = dum1(2:nots-1) - dum1(3:nots)
      c(1) = dum1(1)
      c(nots) = dum1(nots)

      end subroutine jacprod

      subroutine set_dual(data, hi, yi, yi2, hp, yp, yp2, wten, alsq,
     1   niota, npres, nots)
      use vspline
      use vparams, only: zero
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer niota, npres, nots
      real(rprec), dimension(nots) :: data
      real(rprec), dimension(niota) :: hi, yi, yi2
      real(rprec), dimension(npres) :: hp, yp, yp2
      real(rprec), dimension(nots) :: wten
      real(rprec), dimension(nots,nots) :: alsq
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer nb, ioff
C-----------------------------------------------
!
!       ADD TENSION TO DIAGONAL BLOCKS
!
      nb = ideriv
      ioff = 0
      call add_tension (alsq, wten, hi, tensi, tensi2, fpolyi, niota, nb
     1   , ioff, nots)
      call add_tension (alsq, wten, hp, tensp, zero, zero, npres, nb,
     1   niota, nots)

!
!       FREEZE EDGE PRESSURE IF NO PRESSURE SPECIED
!       COMPUTE SOLUTION FOR SPLINES
!
      call solver (alsq, data, nots)
      yi(:niota) = data(:niota)
      yp(:npres) = data(1+niota:npres+niota)

!
!       COMPUTE SECOND DERIVATIVES
!
      call gety2 (yi, yi2, hi, niota, nb)
      call gety2 (yp, yp2, hp, npres, nb)

      end subroutine set_dual

      subroutine setspline(x,weight,y,h,yfit,y2,wten,tens,nots,nb)
      use vspline
      use vparams, only: zero
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer nots, nb
      real(rprec) tens
      real(rprec), dimension(*) :: x, weight
      real(rprec), dimension(nots) :: y
      real(rprec), dimension(*) :: h
      real(rprec), dimension(nots) :: yfit
      real(rprec), dimension(*) :: y2, wten
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: ioff, istat
      real(rprec) :: alsq(nots,nots)
C-----------------------------------------------
!
!       x:        independent coordinate array
!       y:        dependent y(x) array
!       yfit:     fitted values (under tension) to y array
!       h:        x(i+1) - x(i) array
!       y2:       y'' array used for splines
!       wten:        weight array for tension (changed on exit)
!       alsq:        matrix elements for least squares fit (from s-integrations)
!       nots:        number of independent coordinates (knots)
!       nb:        = NATUR, use natural boundary condition at left knot
!                  = IDERIV, use derivative (dy/dx =0) boundary condition at left knot

!
!       IT IS ASSUMED THAT X,Y,WTEN ARE ALL SORTED (ON X(I) < X(I+1))
!

!
!       INITIALIZE ALSQ TO ZERO, COMPUTE H ELEMENTS
!
      call initspline (alsq, x, h, weight, nots)

!
!       SET UP SPLINE MATRIX ASPLINE AND NON-DIMENSIONLIZE TENSION
!
      ioff = 0
      call add_tension (alsq, wten, h, tens, zero, zero, nots, nb,
     1   ioff, nots)

!
!       SOLVE FOR COEFFICIENTS
!
      yfit(:nots) = y(:nots)
      call solver (alsq, yfit, nots)
!
!       OBTAIN Y'' COEFFICIENTS AND STORE IN Y2
!
      call gety2 (yfit, y2, h, nots, nb)

      end subroutine setspline

      subroutine setup_int(xknots,smesh,hx,w,w1,u,u1,nk,nots,nmesh)
      use kind_spec
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer nots, nmesh
      integer, dimension(nots) :: nk
      real(rprec), dimension(nots) :: xknots
      real(rprec), dimension(nmesh) :: smesh
      real(rprec), dimension(nots) :: hx
      real(rprec), dimension(nmesh) :: w, w1, u, u1
C-----------------------------------------------
C   L o c a l   P a r a m e t e r s
C-----------------------------------------------
      real(rprec), parameter :: epstan = 1.d-10
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: ksp1, k, i, k1
      real(rprec) :: smesh1, hk6
C-----------------------------------------------
!
!       FOR THE SPLINED FUNCTIONS CORRESPONDING TO XKNOTS (PRESSURE,
!       IOTA), THIS ROUTINE COMPUTES THE A AND B MATRIX ELEMENTS
!       (STORED IN W,U,W1,U1) WHICH ARE NEEDED TO EVALUATE THE FUNCTIONS
!       IN REAL-SPACE IN TERMS OF THEIR (VARIABLE) SPLINE KNOT VALUES.
!       THIS 'UNDOES' WHAT SPLINT ROUTINE DOES. LET Y(I) DENOTE THE
!       FUNCTION AT THE POINT SMESH(I) SUCH THAT
!
!                   XKNOTS(K) < SMESH(I) <= XKNOTS(K)
!
!       THEN,  Y(I) = W(I)*YK  + U(I)*GK  + W1(I)*YK1   + U1(I)*GK1
!
!       WHERE YK, GK ARE THE SPLINE AND 2ND DERIVATIVES AT KNOT K
!             YK1,GK1 ARE THE SAME AT KNOT K+1
!
      ksp1 = nots - 1
      smesh1 = smesh(1)
      if (smesh1 .le. xknots(1)) smesh(1) = xknots(1) + epstan

      nk = 0

      k = 1
      do i = 1, nmesh
  140    continue
         k1 = k + 1
!
!       XKNOTS = SQRT(HS*(JS-1)) DEFINED IN STARK,PRESSURE ROUTINE
!       (THIS CORRESPONDS TO APPROXIMATELY EQUAL SPACING ALONG MIDPLANE)
!
         if (smesh(i).gt.xknots(k) .and. smesh(i).le.xknots(k1)) then
            nk(k) = nk(k) + 1
            hk6 = hx(k)*hx(k)/6.0
            w1(i) = (smesh(i)-xknots(k))/hx(k)
            if (w1(i)<(-epstan) .or. w1(i)>1.0+epstan) stop 'w1(i)'
            w(i) = 1.0 - w1(i)
            u(i) = hk6*w(i)*(w(i)*w(i)-1.0)
            u1(i) = hk6*w1(i)*(w1(i)*w1(i)-1.0)
         else
            k = k + 1
            if (k .gt. ksp1) stop 'K>KSP1'
            go to 140
         endif
      end do

      smesh(1) = smesh1

      end subroutine setup_int

      subroutine sort_data (x, index_array, n)
      use kind_spec
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
c-----------------------------------------------
      integer n
      integer, dimension(n) :: index_array
      real(rprec), dimension(n) :: x
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: i, j
      integer, dimension(1) :: isamax
      real(rprec), dimension(n) :: dumx
C-----------------------------------------------
!
!       RETURNS INDEX(I) ARRAY, SO THAT X(INDEX(I)) IS SORTED, I=1,N
!       RETURNS Xin(INDEX(I)) = Xout(I)
!

      do i = n, 1, -1
         isamax = maxloc(abs(x))
         j = isamax(1)
         dumx(i) = x(j)
         x(j) = 0.
         index_array(i) = j
      end do

      x = dumx

      end subroutine sort_data

      subroutine splinint(grn, cm, jacob, h, u, u1, w, w1, nk, nots,
     1   ifunc, nmesh)
      use vparams
      use vsvd
      use vspline
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer nots, ifunc, nmesh
      integer, dimension(*) :: nk
      real(rprec), dimension(nmesh) :: grn, cm
      real(rprec), dimension(nots) :: jacob, h
      real(rprec), dimension(nmesh) :: u, u1, w, w1
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: j, k, nb, ia, ib, k1, ksp1, nmesh1
      real(rprec), dimension(nmesh) :: func
      real(rprec), dimension(nots) :: af, bs
C-----------------------------------------------

!
!       COMPUTES af,bs FACTORS IN
!       (ifunc=INTFUN)     Int[ GRN(X) * F(X) ds ]      or
!       (ifunc=INTDER)     Int[ GRN(X) * {d(CmF)/ds} ds ]
!                 =   af(k)*f(k) + bs(k)*f''(k)
!       WHERE f(k),f''(k) ARE SPLINE COEFFICIENTS OF F(X)
!
!       NOTE: FOR ifunc = INTDER, the OHS factor in CmF cancels
!             THE HS factor in the Integral.
!             FOR ifunc = INTFUN, GRN is assumed to be pre-multiplied
!             OUTSIDE this routine by HS factor
!       ALSO, COMPUTES af(k) + (SUM on i)bs(i)*J(i,k) = jacob(k),
!       WHERE J(i,k) = d[g(i)]/d[f(k)], g = f''
!
!       nk(k): Number of smesh-pts in k-th spline interval
!       xknots(k) < smesh <= xknots(k+1),   k = 1,nots-1
!
!       NOTE: The ifunc=INTDER case is done by integrating by parts,
!             so that the half-point integration (GRN at half mesh pts)
!             becomes a full-point integration in Cm*F.
!
      nb = ideriv           !Pressure, iota derivatives vanish at origin
      ksp1 = nots - 1
      nmesh1 = nmesh - 1

      if (ifunc .eq. intder) then
!
!       Integrate by parts (in s), func(1) and func(nmesh) are 'surface terms'
!
         func(1) = -cm(1)*grn(2)
         func(2:nmesh1) = cm(2:nmesh1)*(grn(2:nmesh1)-grn(3:nmesh1+1))
         func(nmesh) = cm(nmesh)*grn(nmesh)
      else
         func = grn
      endif

      af(:nots) = zero
      bs(:nots) = zero

      ia = 1
      do k = 1, ksp1
         if (nk(k) .ne. 0) then
            k1 = k + 1
            ib = ia + nk(k) - 1
            do j = ia,ib
              af(k)  = af(k)  + func(j)*w(j)
              bs(k)  = bs(k)  + func(j)*u(j)
              af(k1) = af(k1) + func(j)*w1(j)
              bs(k1) = bs(k1) + func(j)*u1(j)
            enddo
            ia = ib + 1
         endif
      end do

      if (ib .ne. nmesh) stop 'ib!=nmesh'
      if (nb .eq. natur) bs(1) = 0.           !Natural boundary conditions
      bs(nots) = 0.
      call jacprod (bs, h, nots, nb)         !Returns bs(i)=bs(j)*J(j,i)
      jacob(:nots) = af(:nots) + bs(:nots)

      end subroutine splinint

      subroutine splint(xa, ya, y2a, n, x, y, yp, ndim)
      use kind_spec
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer n, ndim
      real(rprec), dimension(*) :: xa, ya, y2a, x, y, yp
C-----------------------------------------------
C   L o c a l   P a r a m e t e r s
C-----------------------------------------------
      real(rprec), parameter :: zero = 0, c1o6 = 1._dp/6._dp
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: klo, khi, i, k
      real(rprec) :: h, a, a2, b, b2, h2, y26lo, y26hi, deriv
C-----------------------------------------------
!
!       SPLINE INTERPOLATION ROUTINE (Numerical Recipes, pg. 89)
!       XA: ordered array of length N of ordinates at which function YA=F(XA)
!           is tabulated
!       YA: array of length N , = F(XA)
!       Y2A: array of second derivatives at XA points
!       computed from call to SPLINE
!       X : value at which Y = F(X) is to be computed from splines
!       YP = dY/dX at X
!       NDIM: dimension of X, Y, YP arrays

      deriv = yp(1)
      klo = 1
      khi = n
      do i = 1, ndim
         do while(khi - klo .gt. 1)
            k = (khi + klo)/2
            if (xa(k) .gt. x(i)) then
               khi = k
            else
               klo = k
            endif
         end do

         h = xa(khi) - xa(klo)
         a = xa(khi) - x(i)
         b = x(i) - xa(klo)
         h2 = h*h
         a2 = a*a
         b2 = b*b
         y26lo = c1o6*y2a(klo)
         y26hi = c1o6*y2a(khi)
         y(i) = (a*(ya(klo)+(a2-h2)*y26lo)+b*(ya(khi)+(b2-h2)*y26hi))/h
         if (deriv .ne. zero) yp(i) = (ya(khi)-ya(klo)+y26hi*(3.0*b2-h2)
     1      -y26lo*(3.0*a2-h2))/h
         if (i.lt.ndim .and. x(i+1).gt.x(i)) then
            khi = n
         else
            klo = 1
         endif
      end do

      end subroutine splint

      function splints (x)
      use vspline
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      real(rprec) x
C-----------------------------------------------
C   L o c a l   P a r a m e t e r s
C-----------------------------------------------
      real(rprec), parameter :: c1o6 = 1._dp/6._dp
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: klo, khi, k
      real(rprec) :: h, a, a2, b, b2, h2, y26lo, y26hi, yx, splints
C-----------------------------------------------

      klo = 1
      khi = isnodes

    1 continue
      if (khi - klo .gt. 1) then
         k = (khi + klo)/2
         if (sknots(k) .gt. x) then
            khi = k
         else
            klo = k
         endif
         go to 1
      endif

      h = sknots(khi) - sknots(klo)
      a = sknots(khi) - x
      b = x - sknots(klo)
      h2 = h*h
      a2 = a*a
      b2 = b*b
      y26lo = c1o6*y2stark(klo)
      y26hi = c1o6*y2stark(khi)
      yx = (a*(ystark(klo)+(a2-h2)*y26lo)+b*(ystark(khi)+(b2-h2)*y26hi))
     1   /h
      splints = yx

      end function splints

      function splintx(x)
      use vparams
      use vsvd
      use csplinx
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      real(rprec) x
C-----------------------------------------------
C   L o c a l   P a r a m e t e r s
C-----------------------------------------------
      real(rprec), parameter :: c1o6 = 1._dp/6._dp
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: klo, khi, k
      real(rprec) :: h, a, b, h2, a2, b2, y26lo, y26hi, qmidx0,
     1   splintx
C-----------------------------------------------

       call setspline (rmidx, wmidx, qmidx, hmidx, ymidx, y2midx,
     1    tenmidx, tenmidx(1), nptsx, natur)

      klo = 1
      khi = nptsx

    1 continue
      if (khi - klo .gt. 1) then
         k = (khi + klo)/2
         if (rmidx(k) .gt. x) then
            khi = k
         else
            klo = k
         endif
         go to 1
      endif

      h = rmidx(khi) - rmidx(klo)
      if( h.eq.zero )then
        splintx = zero
        return
      end if
      a = rmidx(khi) - x
      b = x - rmidx(klo)
      h2 = h*h
      a2 = a*a
      b2 = b*b
      y26lo = c1o6*y2midx(klo)
      y26hi = c1o6*y2midx(khi)
      qmidx0 = (a*(ymidx(klo)+(a2-h2)*y26lo)+b*(ymidx(khi)+
     1   (b2-h2)*y26hi))/h
      splintx = qmidx0

      end function splintx