!> @file
!!    Modulefile for the definition of the basic structures
!!
!! @author
!!    G. Fisicaro, L. Genovese (September 2015)<br/>
!!    Copyright (C) 2002-2017 BigDFT group<br/>
!!    This file is distributed under the terms of the
!!    GNU General Public License, see ~/COPYING file
!!    or http://www.gnu.org/copyleft/gpl.txt .
!!    For the list of contributors, see ~/AUTHORS

!> Define the fortran types and the related routines to handle it.
module PStypes
  use f_enums
  use wrapper_MPI
  use PSbase
  use psolver_environment, only: cavity_data,cavity_default
  use dynamic_memory
  use f_input_file, only: ATTRS
  use box
  use dictionaries
  use workarrays

  implicit none

  private

  character(len=*), parameter, public :: KERNEL_VARIABLES= 'kernel'
  character(len=*), parameter, public :: SCREENING       = 'screening'
  character(len=*), parameter, public :: ISF_ORDER       = 'isf_order'
  character(len=*), parameter, public :: STRESS_TENSOR   = 'stress_tensor'
  character(len=*), parameter, public :: ENVIRONMENT_VARIABLES   = 'environment'
  character(len=*), parameter, public :: CAVITY_KEY      = 'cavity'
  character(len=*), parameter, public :: EPSILON_KEY     = 'epsilon'
  character(len=*), parameter, public :: EDENSMAXMIN     = 'edensmaxmin'
  character(len=*), parameter, public :: DELTA_KEY       = 'delta'
  character(len=*), parameter, public :: FACT_RIGID      = 'fact_rigid'
  character(len=*), parameter, public :: CAVITATION      = 'cavitation'
  character(len=*), parameter, public :: GAMMAS_KEY      = 'gammaS'
  character(len=*), parameter, public :: ALPHAS_KEY      = 'alphaS'
  character(len=*), parameter, public :: BETAV_KEY       = 'betaV'
  character(len=*), parameter, public :: GPS_ALGORITHM   = 'gps_algorithm'
  character(len=*), parameter, public :: RADII_SET       = 'radii_set'
  character(len=*), parameter, public :: ATOMIC_RADII    = 'atomic_radii'
  character(len=*), parameter, public :: PI_ETA  = 'pi_eta'
  character(len=*), parameter, public :: INPUT_GUESS     = 'input_guess'
  character(len=*), parameter, public :: FD_ORDER= 'fd_order'
  character(len=*), parameter, public :: ITERMAX = 'itermax'
  character(len=*), parameter, public :: MINRES  = 'minres'
  character(len=*), parameter, public :: PB_METHOD       = 'pb_method'
  character(len=*), parameter, public :: PB_MINRES       = 'pb_minres'
  character(len=*), parameter, public :: PB_ITERMAX      = 'pb_itermax'
  character(len=*), parameter, public :: PB_INPUT_GUESS  = 'pb_input_guess'
  character(len=*), parameter, public :: PB_ETA  = 'pb_eta'
  character(len=*), parameter, public :: SETUP_VARIABLES = 'setup'
  character(len=*), parameter, public :: ACCEL   = 'accel'
  character(len=*), parameter, public :: KEEP_GPU_MEMORY = 'keep_gpu_memory'
  character(len=*), parameter, public :: USE_GPU_DIRECT  = 'use_gpu_direct'
  character(len=*), parameter, public :: TASKGROUP_SIZE_KEY      = 'taskgroup_size'
  character(len=*), parameter, public :: GLOBAL_DATA     = 'global_data'
  character(len=*), parameter, public :: VERBOSITY       = 'verbose'
  character(len=*), parameter, public :: OUTPUT  = 'output'
  character(len=*), parameter, public :: DICT_COMPLETED  = '__dict_has_been_checked__'//ATTRS

  integer, parameter, public :: RADII_PAULING_ID = 1
  integer, parameter, public :: RADII_BONDI_ID = 2
  integer, parameter, public :: RADII_UFF_ID = 3


  !> Defines the internal information for application of the FFT between the kernel and the density
  type, public :: FFT_metadata
     integer :: m1,m2,m3 !<original real dimension, with m2 in z direction and and m3 in y direction
     integer :: n1,n2,n3 !<dimension of the FFT operation, taking into account the zero padding if needed
     integer :: md1,md2,md3 !< Dimension of the real unpadded space,
     !!md2 is further enlarged to be a multiple of number of processes
     integer :: nd1,nd2,nd3 !<fourier dimensions for which the kernel is injective,
     !!                formally 1/8 of the fourier grid. Here the dimension nd3 is
     !!                enlarged to be a multiple of nproc
     integer :: istart,iend,n3p !<start, endpoints and number of planes of the given processor
     real(dp) :: scal !<factor to rescale the solver such that the FFT is unitary, divided by 4pi

     integer, dimension(:), pointer :: counts    !< Array needed to gather the information of the Poisson solver
     integer, dimension(:), pointer :: displs    !< Array needed to gather the information of the Poisson solver
  end type FFT_metadata


  !> Define the work arrays needed for the treatment of the generalized (nonvacuum) or
  !! standard (vacuum) Poisson Equation. Not all of them are allocated, the actual memory usage
  !! depends on the treatment.
  type, public :: PS_workarrays
     !>work array needed to store the zero-padded part of the
     !!density and the potential. Cannot be used as-is, it must be
     !!copied back into a distributed array with the
     !!finalize_hartree_results routine.
     real(dp), dimension(:,:,:), pointer :: zf
  end type PS_workarrays


  !> Datatype defining the mode for the running of the electrostatic solver
  type, public :: PSolver_options
     !> @copydoc poisson_solver::doc::datacode
     character(len=1) :: datacode
     !> integer variable setting the verbosity, from silent (0) to high
     integer :: verbosity_level
     !> allocates once and for all GPU buffer (true), or on the fly (false)
     logical :: keepGPUmemory
     !> if .true., and the cavity is set to 'sccs' attribute, then the epsilon is updated according to rhov
     logical :: update_cavity
     !> if .true. calculate the stress tensor components.
     logical :: calculate_strten
     !> Use the input guess procedure for the solution of the generalized Poisson equation (PCG or SC).
     !! This value is ignored in the case of a vacuum solver
     logical :: use_input_guess
     !> For an implicit solvation run, trigger the energy calculation to the only electrostatic contribution.
     !! If .true., the code only calculates the electrostatic contribution
     !! and the non electrostatic terms to the total solvation energy (cavitation,
     !! repulsion and dispersion) are neglected.
     logical :: only_electrostatic
     !> extract the polarization charge and the dielectric function, to be used for plotting purposes
     logical :: cavity_info
     !> Use the input guess procedure for the solution in the case of the Poisson Boltzmann Equation.
     !! This option is ignored in the case of a neutral solution
     logical :: use_pb_input_guess
     !> Total integral on the supercell of the final potential on output
     !! clearly meaningful only for Fully periodic BC, ignored in the other cases.
     !> Prepare the information in the rigid cavity case which is needed
     !! to calculate the forces (nabla2pot times epsilon minus one)
     logical :: final_call
     real(gp) :: potential_integral
  end type PSolver_options

  !> Define the energy terms for the Poisson and Generalized poisson operator applications
  type, public :: PSolver_energies
     !> hartree energy, defined as the @f$\int \rho(\mathbf{r}) V(\mathbf{r}) \mathrm d r @f$, with @f$\rho@f$ being the
     !! input density and @f$V@f$ the potential defined by this density
     !! in the case when rho_ion is passed, the electrostatic contribution is only filled
     real(gp) :: hartree
     !> electrostatic energy, defined as the hartree energy but with @f$\rho@f$ and @f$V@f$ coming from @f$\rho + \rho_{ion}@f$
     !! the hartree energy can be obtained by subtraction with the potential energy terms
     real(gp) :: elec
     !> Energetic term coming from the @f$\int \rho V_extra@f$, in the case of a @f$\rho@f$-dependent cavity.
     !! Clearly this term is calculated only if the potential is corrected. When the cavity is fixed, the eVextra is zero.
     real(gp) :: eVextra
     !> Nonelectrostatic contribution, function of the cavity surface and volume (only for implicit solvation).
     real(gp) :: cavitation
     !> stress tensor, to be calculated when calculate_strten is .true.
     real(gp), dimension(6) :: strten
  end type PSolver_energies

  public :: grid_dump_layout, create_rho_distribution
  public :: nullify_work_arrays, fft_metadata_null, free_FFT_metadata
  public :: new_F_grid, new_W_grid, new_S_grid, new_P_grid
  public :: PSolver_energies_null, nullify_FFT_metadata
  public :: build_cavity_from_rho, epsilon_inner_cavity
  public :: PSolver_options_null,PS_input_dict
  public :: to_fft_grid, from_fft_grid

  !To specify properly to doxygen (test)
  public :: free_PS_workarrays


contains


  pure function PSolver_energies_null() result(e)
    implicit none
    type(PSolver_energies) :: e
    e%hartree    =0.0_gp
    e%elec       =0.0_gp
    e%eVextra    =0.0_gp
    e%cavitation =0.0_gp
    e%strten     =0.0_gp
  end function PSolver_energies_null

  pure function PSolver_options_null() result(o)
    implicit none
    type(PSolver_options) :: o

    o%datacode           ='X'
    o%verbosity_level    =0
    o%keepGPUmemory      = .true.
    o%update_cavity      =.false.
    o%calculate_strten   =.false.
    o%use_input_guess    =.false.
    o%use_pb_input_guess =.false.
    o%cavity_info        =.false.
    o%only_electrostatic =.true.
    o%final_call         =.false.
    o%potential_integral =0.0_gp
   end function PSolver_options_null

  pure function FFT_metadata_null() result(d)
    implicit none
    type(FFT_metadata) :: d
    call nullify_FFT_metadata(d)
  end function FFT_metadata_null

  pure subroutine nullify_FFT_metadata(d)
    implicit none
    type(FFT_metadata), intent(out) :: d
    d%m1=0
    d%m2=0
    d%m3=0
    d%n1=0
    d%n2=0
    d%n3=0
    d%md1=0
    d%md2=0
    d%md3=0
    d%nd1=0
    d%nd2=0
    d%nd3=0
    d%istart=0
    d%iend=0
    d%n3p=0
    d%scal=0.0_dp

    nullify(d%counts)
    nullify(d%displs)
  end subroutine nullify_FFT_metadata

  subroutine grid_dump_layout(g, nproc, nlimd, nlimk)
    use yaml_output
    use yaml_strings
    implicit none
    type(FFT_metadata), intent(in) :: g
    integer, intent(in) :: nproc, nlimd, nlimk

    integer :: jproc, jhd, jzd, npd, jfd, jhk, jzk, npk, jfk

    call yaml_mapping_open('Memory Requirements per MPI task')
    call yaml_map('Density (MB)',8.0_gp*real(g%md1*g%md3,gp)&
         *real(g%md2/nproc,gp)/(1024.0_gp**2),fmt='(f8.2)')
    call yaml_map('Kernel (MB)',8.0_gp*real(g%nd1*g%nd3,gp)&
         *real(g%nd2/nproc,gp)/(1024.0_gp**2),fmt='(f8.2)')
    call yaml_map('Full Grid Arrays (MB)',&
         8.0_gp*real(g%m1*g%m3,gp)*real(g%m2,gp)/(1024.0_gp**2),fmt='(f8.2)')
    !print the load balancing of the different dimensions on screen
    if (nproc > 1) then
       call yaml_mapping_open('Load Balancing of calculations')
       jhd=10000
       jzd=10000
       npd=0
       load_balancing: do jproc=0,nproc-1
          !print *,'jproc,jfull=',jproc,jproc*md2/nproc,(jproc+1)*md2/nproc
          if ((jproc+1)*g%md2/nproc <= nlimd) then
             jfd=jproc
          else if (jproc*g%md2/nproc <= nlimd) then
             jhd=jproc
             npd=nint(real(nlimd-(jproc)*g%md2/nproc,kind=8)&
                  /real(g%md2/nproc,kind=8)*100.d0)
          else
             jzd=jproc
             exit load_balancing
          end if
       end do load_balancing
       call yaml_mapping_open('Density')
       call yaml_map('MPI tasks 0-'//jfd**'(i5)','100%')
       if (jfd < nproc-1) &
            call yaml_map('MPI task '//jhd**'(i5)',npd**'(i5)'+'%')
       if (jhd < nproc-1) &
            call yaml_map('MPI tasks'//jhd**'(i5)'+'-'+&
            (nproc-1)**'(i3)','0%')
       call yaml_mapping_close()
       jhk=10000
       jzk=10000
       npk=0
       ! if (geocode /= 'P') then
       load_balancingk: do jproc=0,nproc-1
          !print *,'jproc,jfull=',jproc,jproc*nd3/nproc,(jproc+1)*nd3/nproc
          if ((jproc+1)*g%nd3/nproc <= nlimk) then
             jfk=jproc
          else if (jproc*g%nd3/nproc <= nlimk) then
             jhk=jproc
             npk=nint(real(nlimk-(jproc)*g%nd3/nproc,&
                  kind=8)/real(g%nd3/nproc,kind=8)*100.d0)
          else
             jzk=jproc
             exit load_balancingk
          end if
       end do load_balancingk
       call yaml_mapping_open('Kernel')
       call yaml_map('MPI tasks 0-'//trim(yaml_toa(jfk,fmt='(i5)')),'100%')
       !           print *,'here,npk',npk
       if (jfk < nproc-1) &
            call yaml_map('MPI task'//trim(yaml_toa(jhk,fmt='(i5)')),trim(yaml_toa(npk,fmt='(i5)'))//'%')
       if (jhk < nproc-1) &
            call yaml_map('MPI tasks'//trim(yaml_toa(jhk,fmt='(i5)'))+'-'+&
            yaml_toa(nproc-1,fmt='(i3)'),'0%')
       call yaml_mapping_close()
       call yaml_map('Complete LB per task','1/3 LB_density + 2/3 LB_kernel')
       call yaml_mapping_close()
    end if
    call yaml_mapping_close() !memory
  end subroutine grid_dump_layout

  subroutine create_rho_distribution(g, iproc, nproc)
    use dynamic_memory
    implicit none
    type(FFT_metadata), intent(inout) :: g
    integer, intent(in) :: iproc, nproc

    integer :: istart, jend, jproc

    !here the FFT_metadata routine can be filled
    g%istart = iproc * (g%md2 / nproc)
    g%iend = min((iproc+1) * g%md2 / nproc, g%m2)
    if (g%istart <= g%m2-1) then
       g%n3p = g%iend - g%istart
    else
       g%n3p = 0
    end if
    !allocate and set the distributions for the Poisson Solver
    g%counts = f_malloc_ptr([0.to.nproc-1], id='counts')
    g%displs = f_malloc_ptr([0.to.nproc-1], id='displs')
    do jproc = 0, nproc-1
       istart = min(jproc*(g%md2 / nproc), g%m2-1)
       jend = max(min(g%md2 / nproc, g%m2-&
            g%md2/nproc*jproc), 0)
       g%counts(jproc) = g%m1 * g%m3 * jend
       g%displs(jproc) = g%m1 * g%m3 * istart
    end do
  end subroutine create_rho_distribution

  pure subroutine nullify_work_arrays(w)
    use f_utils, only: f_zero
    implicit none
    type(PS_workarrays), intent(out) :: w
    nullify(w%zf)
  end subroutine nullify_work_arrays

  subroutine free_PS_workarrays(w)
    use dynamic_memory
    implicit none
    type(PS_workarrays), intent(inout) :: w
    call f_free_ptr(w%zf)
  end subroutine free_PS_workarrays

  subroutine free_FFT_metadata(g)
    use dynamic_memory
    implicit none
    type(FFT_metadata), intent(inout) :: g

    call f_free_ptr(g%counts)
    call f_free_ptr(g%displs)
  end subroutine free_FFT_metadata

  !>routine to fill the input variables of the kernel
  subroutine PS_input_dict(dict,dict_minimal)
    use dictionaries
    use f_input_file
    use yaml_parse
    implicit none
    !>input dictionary, a copy of the user input, to be filled
    !!with all the variables on exit
    type(dictionary), pointer :: dict
    type(dictionary), pointer, optional :: dict_minimal
    !local variables
    !integer(f_integer) :: params_size
    !integer(kind = 8) :: cbuf_add !< address of c buffer
    !character, dimension(:), allocatable :: params
    type(dictionary), pointer :: parameters
    type(dictionary), pointer :: parsed_parameters
    type(dictionary), pointer :: profiles
    type(dictionary), pointer :: nested,asis
    external :: get_ps_inputvars

    call f_routine(id='PS_input_dict')

    nullify(parameters,parsed_parameters,profiles)

!!$    !alternative filling of parameters from hard-coded source file
!!$    call getpsinputdefsize(params_size)
!!$    !allocate array
!!$    params=f_malloc_str(1,params_size,id='params')
!!$    !fill it and parse dictionary
!!$    call getpsinputdef(params)
!!$    call yaml_parse_from_char_array(parsed_parameters,params)
!!$    call f_free_str(1,params)

    !new filing method, uses database parsing
    call yaml_parse_database(parsed_parameters,get_ps_inputvars)
    !for each of the documents in the input variables specifications
    parameters=>parsed_parameters//0
    profiles => parsed_parameters//1


    call input_file_complete(parameters,dict,imports=profiles)

    if (present(dict_minimal)) then
       nullify(nested,asis)
       call input_file_minimal(parameters,dict,dict_minimal,nested,asis)
    end if

    if (associated(parsed_parameters)) then
       call dict_free(parsed_parameters)
       nullify(parameters)
       nullify(profiles)
    else
       call dict_free(parameters)
    end if

    !write in the dictionary that it has been completed
    call set(dict//DICT_COMPLETED,.true.)

    call f_release_routine()

  end subroutine PS_input_dict

  subroutine build_cavity_from_rho(method,rho,nabla2_rho,delta_rho,cc_rho,mesh,grid,diel,cavity,&
       depsdrho,dsurfdrho)
    use psolver_environment
    use workarrays
    implicit none
    type(cell), intent(in) :: mesh
    type(FFT_metadata), intent(in) :: grid
    type(cavity_data), intent(in) :: cavity
    type(f_enumerator), intent(in) :: method
    real(dp), dimension(mesh%ndims(1),mesh%ndims(2)*grid%n3p), intent(in) :: rho,nabla2_rho,delta_rho,cc_rho
    type(dielectric_arrays), intent(inout) :: diel
    !> functional derivative of the sc epsilon with respect to
    !! the electronic density, in distributed memory
    real(dp), dimension(mesh%ndims(1),mesh%ndims(2)*grid%n3p), intent(out) :: depsdrho
    !> functional derivative of the surface integral with respect to
    !! the electronic density, in distributed memory
    real(dp), dimension(mesh%ndims(1),mesh%ndims(2)*grid%n3p), intent(out) :: dsurfdrho
    !local variables
    real(dp), parameter :: innervalue = 0.9d0 !to be defined differently
    integer :: n01,n02,n03,i3s,i1,i2,i3,i23
    real(dp) :: rh,d2,d,dd,de,epsm1,epsv

    diel%IntSur=0.d0
    diel%IntVol=0.d0

    n01=mesh%ndims(1)
    n02=mesh%ndims(2)
    n03=mesh%ndims(3)
    !starting point in third direction
    i3s=grid%istart+1
    epsm1=(cavity%epsilon0-vacuum_eps)
    !now fill the pkernel arrays according the the chosen method
    select case(trim(toa(method)))
    case('PCG')
       !in PCG we only need corr, oneosqrtepsilon
       i23=1
       do i3=i3s,i3s+grid%n3p-1!kernel%ndims(3)
          !do i3=1,n03
          do i2=1,n02
             do i1=1,n01
                call dielectric_PCG_set_at(diel, i1, i23, innervalue, cavity, &
                     & rho(i1, i23), delta_rho(i1, i23), nabla2_rho(i1,i23), cc_rho(i1, i23), &
                     & epsv, depsdrho(i1, i23), dsurfdrho(i1, i23))
                diel%eps(i1, i23) = epsv
                dsurfdrho(i1,i23)=dsurfdrho(i1,i23)/epsm1
                !evaluate surfaces and volume integrals
                diel%IntSur=diel%IntSur - depsdrho(i1, i23)*sqrt(nabla2_rho(i1, i23))
                diel%IntVol=diel%IntVol + (cavity%epsilon0-eps(rho(i1, i23),cavity))
             end do
             i23=i23+1
          end do
       end do
    case('PI')
       !for PI we need  dlogeps,oneoeps
       !first oneovereps
       i23=1
       do i3=i3s,i3s+grid%n3p-1!kernel%ndims(3)
          do i2=1,n02
             do i1=1,n01
                if (diel%epsinnersccs(i1,i23).gt.innervalue) then ! Check for inner sccs cavity value to fix as vacuum
                   diel%eps(i1,i23)=1.d0 !eps(i1,i2,i3)
                   diel%oneoeps(i1,i23)=1.d0 !oneoeps(i1,i2,i3)
                   depsdrho(i1,i23)=0.d0
                   dsurfdrho(i1,i23)=0.d0
                else
                   rh=rho(i1,i23)
                   d2=nabla2_rho(i1,i23)
                   d=sqrt(d2)
                   dd = delta_rho(i1,i23)
                   de=epsprime(rh,cavity)
                   depsdrho(i1,i23)=de
                   diel%eps(i1,i23)=eps(rh,cavity)
                   diel%oneoeps(i1,i23)=oneoeps(rh,cavity)
                   dsurfdrho(i1,i23)=-surf_term(rh,d2,dd,cc_rho(i1,i23),cavity)/epsm1

                   !evaluate surfaces and volume integrals
                   diel%IntSur=diel%IntSur - de*d
                   diel%IntVol=diel%IntVol + (cavity%epsilon0-eps(rh,cavity))
                end if
             end do
             i23=i23+1
          end do
       end do
    end select

    !IntSur=IntSur*product(mesh%hgrids)/epsm1
    !IntVol=IntVol*product(mesh%hgrids)/epsm1
    diel%IntSur=diel%IntSur*mesh%volume_element/epsm1
    diel%IntVol=diel%IntVol*mesh%volume_element/epsm1


  end subroutine build_cavity_from_rho


!!!  !> calculates the inner cavity vector epsinnersccs for sccs run
!!!  !! given a set of centres. Based on error function.
!!!  !! Need the radius of the cavit and its smoothness
!!!  subroutine epsinnersccs_rigid_cavity_error_multiatoms_bc(geocode,ndims,hgrids,natreal,rxyzreal,radiireal,delta,eps)
!!!    use f_utils
!!!    use numerics, only : Bohr_Ang
!!!    use module_base, only: bigdft_mpi
!!!    use f_enums
!!!    use yaml_output
!!!    use dynamic_memory
!!!    use bounds, only: ext_buffers
!!!    use psolver_environment, only: epsl,d1eps,epsle0
!!!    implicit none
!!!!    character(len=1), intent(in) :: geocode !< @copydoc poisson_solver::doc::geocode
!!!    integer, intent(in) :: natreal !< number of centres defining the cavity
!!!    real(kind=8), intent(in) :: delta !< smoothness factor of the cavity
!!!!    integer, dimension(3), intent(in) :: ndims   !< dimensions of the simulation box
!!!!    real(kind=8), dimension(3), intent(in) :: hgrids !< grid spacings
!!!    real(kind=8), dimension(natreal), intent(in) :: radiireal !< radii of each of the atoms
!!!    !> position of all the atoms in the grid coordinates
!!!    real(kind=8), dimension(3,natreal), intent(in) :: rxyzreal
!!!    real(kind=8), dimension(bit%mesh%ndim), intent(out) :: eps !< dielectric inner cavity for sccs run
!!!
!!!    !local variables
!!!    logical :: perx,pery,perz
!!!    integer :: i,i1,i2,i3,iat,jat,ii,j,k,l,px,py,pz,unt
!!!    integer :: nbl1,nbl2,nbl3,nbr1,nbr2,nbr3,imin
!!!    real(kind=8) :: r2,x,y2,z2,d,d2,d12,y,z,eps_min,eps1,pi,de2,dde,d1,oneod,h,coeff,dmin,dmax
!!!    real(kind=8) :: value,valuemin
!!!    real(kind=8), dimension(3) :: v,rv,shift,sh
!!!
!!!    real(kind=8), parameter :: valuebc=1.d0
!!!    real(kind=8), dimension(6) :: plandist
!!!    integer, dimension(6) :: ba
!!!    real(kind=8), dimension(:), allocatable :: ep
!!!    real(kind=8), dimension(3,27*natreal) :: rxyztot
!!!    real(kind=8), dimension(27*natreal) :: radiitot
!!!    real(kind=8), dimension(:), allocatable :: radii
!!!    real(kind=8), dimension(:,:), allocatable :: rxyz
!!!    logical, parameter :: dumpeps=.false.
!!!
!!!    !buffers associated to the geocode
!!!    !conditions for periodicity in the three directions
!!!    perx=(geocode /= 'F')
!!!    pery=(geocode == 'P')
!!!    perz=(geocode /= 'F')
!!!
!!!    call ext_buffers(perx,nbl1,nbr1)
!!!    call ext_buffers(pery,nbl2,nbr2)
!!!    call ext_buffers(perz,nbl3,nbr3)
!!!
!!!    pi = 4.d0*datan(1.d0)
!!!
!!!    shift(1)=hgrids(1)*ndims(1)
!!!    shift(2)=hgrids(2)*ndims(2)
!!!    shift(3)=hgrids(3)*ndims(3)
!!!
!!!    !------------------------------------------------------------------------------------------------------
!!!    ! Depending of Free, Periodic or Surface bc, image atoms are or not included.
!!!
!!!    !  if (bigdft_mpi%iproc==0) then
!!!    !   do iat=1,natreal
!!!    !    call yaml_map('real input atoms',iat)
!!!    !    call yaml_map('radii',radiireal(iat))
!!!    !    call yaml_map('rxyz',rxyzreal(:,iat))
!!!    !   end do
!!!    !  end if
!!!
!!!    px=0
!!!    py=0
!!!    pz=0
!!!    if (perx) px=1
!!!    if (pery) py=1
!!!    if (perz) pz=1
!!!
!!!    rxyztot(:,:)=0.d0
!!!
!!!    i=0
!!!    do iat=1,natreal
!!!       ba(1:6)=0
!!!       ! checking what are the image atoms to include in the calculation of the
!!!       ! cavity.
!!!       rv(1:3)=rxyzreal(1:3,iat)
!!!       plandist(1)=dabs(rv(1))
!!!       plandist(2)=dabs(shift(1)-rv(1))
!!!       plandist(3)=dabs(rv(2))
!!!       plandist(4)=dabs(shift(2)-rv(2))
!!!       plandist(5)=dabs(rv(3))
!!!       plandist(6)=dabs(shift(3)-rv(3))
!!!       do ii=1,6
!!!          valuemin=1.d0
!!!          d=plandist(ii)
!!!          value=epsl(d,radiireal(iat),delta)
!!!          if (value.lt.valuebc) then ! valuebc is the value to check on the box border to accept or refuse an image atom.
!!!             if (abs(value).lt.valuemin) then
!!!                valuemin=abs(value)
!!!                imin=ii
!!!             end if
!!!             select case(ii)
!!!             case (1)
!!!                ba(1)=1*px
!!!             case (2)
!!!                ba(2)=-1*px
!!!             case (3)
!!!                ba(3)=1*py
!!!             case (4)
!!!                ba(4)=-1*py
!!!             case (5)
!!!                ba(5)=1*pz
!!!             case (6)
!!!                ba(6)=-1*pz
!!!             end select
!!!          end if
!!!       end do
!!!
!!!       do j=ba(6),ba(5)
!!!          sh(3)=real(j,kind=8)*shift(3)
!!!          do k=ba(4),ba(3)
!!!             sh(2)=real(k,kind=8)*shift(2)
!!!             do l=ba(2),ba(1)
!!!                sh(1)=real(l,kind=8)*shift(1)
!!!                rv(1:3)=rxyzreal(1:3,iat) + sh(1:3)
!!!                i=i+1
!!!                rxyztot(1:3,i)=rv(1:3)
!!!                radiitot(i)=radiireal(iat)
!!!             end do
!!!          end do
!!!       end do
!!!
!!!    end do
!!!
!!!    nat=i
!!!
!!!    ep=f_malloc(nat,id='ep')
!!!    rxyz=f_malloc([3,nat],id='rxyz')
!!!    radii=f_malloc(nat,id='radii')
!!!
!!!    rxyz(1:3,1:nat)=rxyztot(1:3,1:nat)
!!!    radii(1:nat)=radiitot(1:nat)
!!!
!!!    !   if (bigdft_mpi%iproc==0) then
!!!    !    write(*,*)plandist
!!!    !    write(*,'(1x,a,1x,e14.7,1x,a,1x,i4)')'Value min =',valuemin,'at bc side',imin
!!!    !    call yaml_map('nat',nat)
!!!    !    do iat=1,nat
!!!    !     call yaml_map('atom',iat)
!!!    !     call yaml_map('radii',radii(iat))
!!!    !     call yaml_map('rxyz',rxyz(:,iat))
!!!    !    end do
!!!    !   end if
!!!
!!!    !------------------------------------------------------------------------------------------------------
!!!    ! Starting the cavity building for rxyztot atoms=real+image atoms (total natcurr) for periodic
!!!    ! and surface boundary conditions or atoms=real for free bc.
!!!
!!!    do i3=1,ndims(3)
!!!       z=hgrids(3)*(i3-1-nbl3)
!!!       v(3)=z
!!!       do i2=1,ndims(2)
!!!          y=hgrids(2)*(i2-1-nbl2)
!!!          v(2)=y
!!!          do i1=1,ndims(1)
!!!             x=hgrids(1)*(i1-1-nbl1)
!!!             v(1)=x
!!!
!!!             do iat=1,nat
!!!                d2=(x-rxyz(1,iat))**2+(y-rxyz(2,iat))**2+(z-rxyz(3,iat))**2
!!!                d=dsqrt(d2)
!!!
!!!                if (d2.eq.0.d0) then
!!!                   d2=1.0d-30
!!!                   ep(iat)=epsl(d,radii(iat),delta)
!!!                else
!!!                   ep(iat)=epsl(d,radii(iat),delta)
!!!                end if
!!!             end do
!!!
!!!             eps(i1,i2,i3)= 1.d0 - product(ep)
!!!
!!!          end do
!!!       end do
!!!    end do
!!!
!!!
!!!!!$    if (dumpeps) then
!!!!!$
!!!!!$       unt=f_get_free_unit(20)
!!!!!$       call f_open_file(unt,file='epsinnersccs.dat')
!!!!!$       i1=1!n03/2
!!!!!$       do i2=1,ndims(2)
!!!!!$          do i3=1,ndims(3)
!!!!!$             write(unt,'(2(1x,I4),2(1x,e14.7))')i2,i3,eps(i1,i2,i3),eps(ndims(1)/2,i2,i3)
!!!!!$          end do
!!!!!$       end do
!!!!!$       call f_close(unt)
!!!!!$
!!!!!$       unt=f_get_free_unit(22)
!!!!!$       call f_open_file(unt,file='epsinnersccs_line_y.dat')
!!!!!$       do i2=1,ndims(2)
!!!!!$          write(unt,'(1x,I8,1(1x,e22.15))')i2,eps(ndims(1)/2,i2,ndims(3)/2)
!!!!!$       end do
!!!!!$       call f_close(unt)
!!!!!$
!!!!!$       unt=f_get_free_unit(23)
!!!!!$       call f_open_file(unt,file='epsinnersccs_line_z.dat')
!!!!!$       do i3=1,ndims(3)
!!!!!$          write(unt,'(1x,I8,1(1x,e22.15))')i3,eps(ndims(1)/2,ndims(2)/2,i3)
!!!!!$       end do
!!!!!$       call f_close(unt)
!!!!!$
!!!!!$    end if
!!!
!!!    call f_free(ep)
!!!    call f_free(rxyz)
!!!    call f_free(radii)
!!!
!!!  end subroutine epsinnersccs_rigid_cavity_error_multiatoms_bc
!!!!!!


  subroutine epsilon_inner_cavity(nat,rxyz,radii,delta,oxyz,mesh,grid,diel)
    use box
    use psolver_environment
    implicit none
    integer, intent(in) :: nat
    real(dp), intent(in) :: delta
    type(cell), intent(in) :: mesh
    type(FFT_metadata), intent(in) :: grid
    real(dp), dimension(nat), intent(in) :: radii
    real(dp), dimension(3,nat), intent(in) :: rxyz,oxyz
    type(dielectric_arrays), intent(inout) :: diel
    !local variables
    integer :: iat
    real(dp) :: tt,d
    type(box_iterator) :: bit

    bit=box_iter(mesh,i3s=grid%istart+1,n3p=grid%n3p,origin=oxyz)
    do while(box_next_point(bit))
       !loop on atoms
       tt=1.0_dp
       do iat=1,nat
          !d=distance(bit%mesh,rxyz(1,iat),bit%rxyz)
          d=box_iter_distance(bit,rxyz(1,iat))
          tt=tt*epsl(d,radii(iat),delta)
       end do
       diel%epsinnersccs(bit%i,bit%i23+1)=1.0_dp-tt
    end do

  end subroutine epsilon_inner_cavity



  !> Calculate four sets of dimension needed for the calculation of the
  !! convolution for the periodic system
  !!
  !! @warning
  !!    This four sets of dimensions are actually redundant (mi=n0i),
  !!    due to the backward-compatibility
  !!    with the other geometries of the Poisson Solver.
  !!    The dimensions 2 and 3 are exchanged.
  !! @author Luigi Genovese
  !! @date October 2006
  subroutine new_P_grid(n01,n02,n03,grid,nproc,enlarge_md2)
    use dictionaries, only: f_err_throw
    use yaml_strings
    implicit none
    !Arguments
    logical, intent(in) :: enlarge_md2
    integer, intent(in) :: n01,n02,n03   !< original real dimensions (input)
    integer, intent(in) :: nproc
    type(FFT_metadata), intent(out) :: grid
    !Local variables
    integer :: l1,l2,l3

    grid = FFT_metadata_null()
    !dimensions of the density in the real space
    grid%m1=n01
    grid%m2=n03
    grid%m3=n02

    ! real space grid dimension (suitable for number of processors)
    l1=grid%m1
    l2=grid%m2
    l3=grid%m3

    !initialize the n dimension to solve Cray compiler bug
    grid%n1=l1
    grid%n2=l2
    grid%n3=l3

    call fourier_dim(l1,grid%n1)
    if (grid%n1 /= grid%m1) then
       call f_err_throw('The FFT in the x direction is not allowed, n01 dimension '//n01)
    end if

    call fourier_dim(l2,grid%n2)
    if (grid%n2 /= grid%m2) then
       call f_err_throw('The FFT in the z direction is not allowed, n03 dimension '//n03)
    end if

    call fourier_dim(l3,grid%n3)
    if (grid%n3 /= grid%m3) then
       call f_err_throw('The FFT in the y direction is not allowed, n02 dimension '//n02)
    end if

    !dimensions that contain the unpadded real space,
    ! compatible with the number of processes
    grid%md1=grid%n1
    grid%md2=grid%n2
    grid%md3=grid%n3

    !enlarge the md2 dimension to be compatible with MPI_ALLTOALL communication
    do while(nproc*(grid%md2/nproc) < grid%n2)
       grid%md2=grid%md2+1
    end do

    if (enlarge_md2) grid%md2=(grid%md2/nproc+1)*nproc

    !dimensions of the kernel, 1/8 of the total volume,
    !compatible with nproc
    grid%nd1=grid%n1/2+1
    grid%nd2=grid%n2/2+1
    grid%nd3=grid%n3/2+1

    !enlarge the md2 dimension to be compatible with MPI_ALLTOALL communication
    do while(modulo(grid%nd3,nproc) /= 0)
       grid%nd3=grid%nd3+1
    end do

  END SUBROUTINE new_P_grid


  !> Calculate four sets of dimension needed for the calculation of the
  !! convolution for the surface system
  !!
  !! SYNOPSIS
  !!    n01,n02,n03 original real dimensions (input)
  !!
  !!    m1,m2,m3 original real dimension, with 2 and 3 exchanged
  !!
  !!    n1,n2 the first FFT dimensions, for the moment supposed to be even
  !!    n3    the double of the first FFT even dimension greater than m3
  !!          (improved for the HalFFT procedure)
  !!
  !!    md1,md2     the n1,n2 dimensions.
  !!    md3         half of n3 dimension. They contain the real unpadded space,
  !!                which has been properly enlarged to be compatible with the FFT dimensions n_i.
  !!                md2 is further enlarged to be a multiple of nproc
  !!
  !!    nd1,nd2,nd3 fourier dimensions for which the kernel FFT is injective,
  !!                formally 1/8 of the fourier grid. Here the dimension nd3 is
  !!                enlarged to be a multiple of nproc
  !!
  !! @warning
  !!    This four sets of dimensions are actually redundant (mi=n0i),
  !!    due to the backward-compatibility
  !!    with the Poisson Solver with other geometries.
  !!    Dimensions n02 and n03 were exchanged
  !! @author Luigi Genovese
  !! @date October 2006
  subroutine new_S_grid(n01,n02,n03,grid,nproc,gpu,enlarge_md2,non_ortho)
    use dictionaries, only: f_err_throw
    use yaml_strings
    implicit none
    logical, intent(in) :: enlarge_md2
    integer, intent(in) :: n01,n02,n03,nproc,gpu
    type(FFT_metadata), intent(out) :: grid
    integer :: l1,l2,l3
    logical, intent(in), optional :: non_ortho
    !local variables
    logical :: north

    grid = FFT_metadata_null()
    north=.false.
    if (present(non_ortho)) north=non_ortho
    !dimensions of the density in the real space
    grid%m1=n01
    grid%m2=n03
    grid%m3=n02

    ! real space grid dimension (suitable for number of processors)
    l1=grid%m1
    l2=grid%m2
    if (gpu.eq.0) then
       l3=grid%m3 !beware of the half dimension
    else
       l3=2*grid%m3
    endif

    !initialize the n dimension to solve Cray compiler bug
    grid%n1=l1
    grid%n2=l2
    grid%n3=l3

    call fourier_dim(l1,grid%n1)
    if (grid%n1 /= grid%m1) then
       call f_err_throw('The FFT in the x direction is not allowed, n03 dimension '//n01)
    end if

    call fourier_dim(l2,grid%n2)
    if (grid%n2 /= grid%m2) then
       call f_err_throw('The FFT in the z direction is not allowed, n03 dimension '//n03)
    end if

    do
       call fourier_dim(l3,grid%n3)
       if (modulo(grid%n3,2) == 0) then
          exit
       end if
       l3=l3+1
    end do
    if (gpu.eq.0) grid%n3=2*grid%n3

    !dimensions that contain the unpadded real space,
    ! compatible with the number of processes
    grid%md1=grid%n1
    grid%md2=grid%n2
    grid%md3=grid%n3/2
    do while(nproc*(grid%md2/nproc) < grid%n2)
       !151 if (nproc*(md2/nproc).lt.n2) then
       grid%md2=grid%md2+1
       !goto 151
       !endif
    end do

    if (enlarge_md2) grid%md2=(grid%md2/nproc+1)*nproc

    !dimensions of the kernel, 1/8 of the total volume,
    !compatible with nproc
    !note: for non-orthorhombic cells the dimensions of the kernel
    !should become double either in nd1 or in nd2

    !these two dimensions are like that since they are even
    grid%nd1=grid%n1/2+1
    grid%nd2=grid%n2/2+1
    if (north) grid%nd2=grid%n2
    grid%nd3=grid%n3/2+1
    do while(modulo(grid%nd3,nproc) /= 0)
       !250 if (modulo(nd3,nproc) .ne. 0) then
       grid%nd3=grid%nd3+1
       !goto 250
       !endif
    end do

  END SUBROUTINE new_S_grid


  !> Calculate four sets of dimension needed for the calculation of the
  !! convolution for the Wires BC system
  !!
  !! SYNOPSIS
  !!    n01,n02,n03 original real dimensions (input)
  !!
  !!    m1,m2,m3 original real dimension, with 2 and 3 exchanged
  !!
  !!    n1,n2 the first FFT dimensions, for the moment supposed to be even
  !!    n3    the double of the first FFT even dimension greater than m3
  !!          (improved for the HalFFT procedure)
  !!
  !!    md1,md2     the n1,n2 dimensions.
  !!    md3         half of n3 dimension. They contain the real unpadded space,
  !!                which has been properly enlarged to be compatible with the FFT dimensions n_i.
  !!                md2 is further enlarged to be a multiple of nproc
  !!
  !!    nd1,nd2,nd3 fourier dimensions for which the kernel FFT is injective,
  !!                formally 1/8 of the fourier grid. Here the dimension nd3 is
  !!                enlarged to be a multiple of nproc
  !!
  !! @warning
  !!    This four sets of dimensions are actually redundant (mi=n0i),
  !!    due to the backward-compatibility
  !!    with the Poisson Solver with other geometries.
  !!    Dimensions n02 and n03 were exchanged
  !! @author Luigi Genovese
  !! @date October 2006
  subroutine new_W_grid(n01,n02,n03,grid,nproc,gpu,enlarge_md2)
    use dictionaries, only: f_err_throw
    use yaml_strings
    implicit none
    logical, intent(in) :: enlarge_md2
    integer, intent(in) :: n01,n02,n03,nproc,gpu
    type(FFT_metadata), intent(out) :: grid
    integer :: l1,l2,l3

    grid = FFT_metadata_null()
    !dimensions of the density in the real space
    grid%m1=n01
    grid%m2=n03
    grid%m3=n02

    ! real space grid dimension (suitable for number of processors)
    l1=2*grid%m1
    l2=grid%m2
    if (gpu.eq.0) then
       l3=grid%m3 !beware of the half dimension
    else
       l3=2*grid%m3
    endif

    do
       call fourier_dim(l1,grid%n1)
       if (modulo(grid%n1,2) == 0) then
          exit
       end if
       l1=l1+1
    end do


    call fourier_dim(l2,grid%n2)
    if (grid%n2 /= grid%m2) then
       call f_err_throw('The FFT in the z direction is not allowed, n03 dimension '//n03)
    end if

    do
       call fourier_dim(l3,grid%n3)
       if (modulo(grid%n3,2) == 0) then
          exit
       end if
       l3=l3+1
    end do

    if (gpu.eq.0) grid%n3=2*grid%n3

    !dimensions that contain the unpadded real space,
    ! compatible with the number of processes
    grid%md1=grid%n1/2
    grid%md2=grid%n2
    grid%md3=grid%n3/2
    do while(nproc*(grid%md2/nproc) < grid%n2)
       !151 if (nproc*(md2/nproc).lt.n2) then
       grid%md2=grid%md2+1
       !goto 151
       !endif
    end do

    if (enlarge_md2) grid%md2=(grid%md2/nproc+1)*nproc

    !dimensions of the kernel, 1/8 of the total volume,
    !compatible with nproc

    !these two dimensions are like that since they are even
    grid%nd1=grid%n1/2+1
    grid%nd2=grid%n2/2+1
    grid%nd3=grid%n3/2+1
    do while(modulo(grid%nd3,nproc) /= 0)
       !250 if (modulo(nd3,nproc) .ne. 0) then
       grid%nd3=grid%nd3+1
       !goto 250
       !endif
    end do

  END SUBROUTINE new_W_grid


  !> Calculate four sets of dimension needed for the calculation of the
  !! zero-padded convolution
  !!
  !! @warning
  !!    The dimension m2 and m3 correspond to n03 and n02 respectively
  !!    this is needed since the convolution routine manage arrays of dimension
  !!    (md1,md3,md2/nproc)
  !! @author Luigi Genovese
  !! @date February 2006
  subroutine new_F_grid(n01,n02,n03,grid,nproc,gpu,enlarge_md2)
    implicit none
    !Arguments
    logical, intent(in) :: enlarge_md2
    integer, intent(in) :: n01,n02,n03  !< Original real dimensions
    integer, intent(in) :: nproc,gpu
    type(FFT_metadata), intent(out) :: grid
    !Local variables
    integer :: l1,l2,l3, mul3

    grid = FFT_metadata_null()
    !dimensions of the density in the real space, inverted for convenience
    grid%m1=n01
    grid%m2=n03
    grid%m3=n02
    ! real space grid dimension (suitable for number of processors)
    l1=2*grid%m1
    l2=2*grid%m2
    if (gpu.eq.0) then
       l3=grid%m3 !beware of the half dimension
       mul3=2
    else
       l3=2*grid%m3
       mul3=4 ! in GPU we still need this dimension's size to be multiple of 4
    endif
    !initialize the n dimension to solve Cray compiler bug
    grid%n1=l1
    grid%n2=l2
    grid%n3=l3
    do
       call fourier_dim(l1,grid%n1)
       if (modulo(grid%n1,2) == 0) then
          exit
       end if
       l1=l1+1
    end do
    do
       call fourier_dim(l2,grid%n2)
       if (modulo(grid%n2,2) == 0) then
          exit
       end if
       l2=l2+1
    end do
    do
       call fourier_dim(l3,grid%n3)
       if (modulo(grid%n3,mul3) == 0) then
          exit
       end if
       l3=l3+1
    end do
    if (gpu.eq.0) grid%n3=2*grid%n3

    !dimensions that contain the unpadded real space,
    ! compatible with the number of processes
    grid%md1=grid%n1/2
    grid%md2=grid%n2/2
    grid%md3=grid%n3/2
    do while(nproc*(grid%md2/nproc) < grid%n2/2)
       !151 if (nproc*(md2/nproc).lt.n2/2) then
       grid%md2=grid%md2+1
       !goto 151
       !endif
    end do

    if (enlarge_md2) grid%md2=(grid%md2/nproc+1)*nproc

    !dimensions of the kernel, 1/8 of the total volume,
    !compatible with nproc
    grid%nd1=grid%n1/2+1
    grid%nd2=grid%n2/2+1
    grid%nd3=grid%n3/2+1

    do while(modulo(grid%nd3,nproc) /= 0)
       !250 if (modulo(nd3,nproc) .ne. 0) then
       grid%nd3=grid%nd3+1
       !    goto 250
       ! endif
    end do

  END SUBROUTINE new_F_grid

  subroutine to_fft_grid(grid, zf, rho, nproc)
    implicit none
    type(FFT_metadata), intent(in) :: grid
    integer, intent(in) :: nproc
    real(dp), dimension(grid%m1,grid%m3*grid%n3p), intent(in) :: rho
    real(dp), dimension(grid%md1,grid%md3*2*(grid%md2/nproc)), intent(inout) :: zf

    integer :: n3delta, i1, i23, j3, j23

    n3delta=grid%md3-grid%m3
    !$omp parallel do default(shared) private(i1,i23,j23,j3)
    do i23=1,grid%n3p*grid%m3
       j3=(i23-1)/grid%m3
       j23=i23+n3delta*j3
       do i1=1,grid%m1
          zf(i1,j23)=rho(i1,i23)
       end do
    end do
    !$omp end parallel do
  end subroutine to_fft_grid

  subroutine from_fft_grid(grid, rho, zf, nproc)
    implicit none
    type(FFT_metadata), intent(in) :: grid
    integer, intent(in) :: nproc
    real(dp), dimension(grid%m1,grid%m3*grid%n3p), intent(inout) :: rho
    real(dp), dimension(grid%md1,grid%md3*2*(grid%md2/nproc)), intent(in) :: zf

    integer :: n3delta, i1, i23, j3, j23

    n3delta=grid%md3-grid%m3
    !$omp parallel do default(shared) private(i1,i23,j23,j3)
    do i23=1,grid%n3p*grid%m3
       j3=(i23-1)/grid%m3
       j23=i23+n3delta*j3
       do i1=1,grid%m1
          rho(i1,i23)=zf(i1,j23)
       end do
    end do
    !$omp end parallel do
  end subroutine from_fft_grid

end module PStypes
