!> @file
!!    Main routine to perform Poisson solver calculation
!! @author
!!    Creation date: February 2007<br/>
!!    Luigi Genovese
!!    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


!> Calculate the electrostatic (Hartree) potential by solving the Poisson equation
!! @f$\nabla^2 V(x,y,z)=-4 \pi \rho(x,y,z)@f$
!! from a given @f$\rho@f$,
!! for different boundary conditions (free, surface, wire and periodic)
!! an for different data distributions.
!! For a nonvacuum calculation it solves the generalized Poisson equation
!! @f$\nabla \cdot \epsilon( \textbf{r}) \nabla \phi(\textbf{r}) = -4 \pi \rho(\textbf{r})@f$.
!! Following the boundary conditions, it applies the Poisson Kernel previously calculated.
!!
!! @warning
!!    The dimensions of the arrays must be compatible with geocode, datacode, nproc,
!!    ixc and iproc. Since the arguments of these routines are indicated with the *, it
!!    is IMPERATIVE to use the PS_dim4allocation routine for calculation arrays sizes.
!!    Moreover, for the cases with the exchange and correlation the density must be initialised
!!    to 10^-20 and not to zero.
!!
!! @todo
!!    Wire boundary condition is missing
subroutine Electrostatic_Solver(kernel,rhov,energies,pot_ion,rho_ion,ehartree)
  use FDder
  use workarrays
  !use box
  use at_domain, only: domain_geocode
  use f_enums
  use dynamic_memory
  use yaml_output
  use psolver_environment
  use PStypes
  use PSbox
  use dictionaries, only: f_err_throw
  use f_utils
  use wrapper_linalg
  implicit none
  !> kernel of the coulomb operator, it also contains metadata about the parallelisation scheme
  !! and the data distributions in the grid.
  !! can be also used to gather the distributed arrays for data processing or poltting purposes
  type(coulomb_operator), intent(inout) :: kernel
  !> on input, density of the (G)Pe. On output, electrostatic potential, possibly corrected with extra term in
  !! the case of rho-dependent sccs cavity when the suitable variable of the options datatype is set.
  !! The latter correction term is useful to define a KS DFT potential for the definition of the Hamiltonian out of
  !! the Electrostatic environment defined from rho.
  !! The last dimension is either kernel%mesh%ndims(3) or kernel%grid%n3p, depending if kernel%opt%datacode is 'G' or 'D' respectively
  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),*), intent(inout) :: rhov
  !> Datatype containing the energies and th stress tensor.
  !! the components are filled accordin to the coulomb operator set ans the options given to the solver.
  type(PSolver_energies), intent(out), optional :: energies
  !> Additional external potential that is added to the output, if present.
  !! Usually represents the potential of the ions that is needed to define the full electrostatic potential of a Vacuum Poisson Equation
  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%grid%n3p), intent(inout), optional, target :: pot_ion
  !> Additional external density that is added to the output input, if present.
  !! The treatment of the Poisson Equation is done with the sum of the two densities whereas the rho-dependent cavity and some components
  !! of the energies are calculated only with the input rho.
  real(dp), dimension(kernel%mesh%ndims(1), kernel%mesh%ndims(2), kernel%grid%n3p), intent(inout), optional, target :: rho_ion
  !> Electrostatic Energy of the system given as @f$\int \rho \cdot V @f$, where @f$\rho@f$ and @f$V@f$ correspond to the
  !! values of rhov array in input and output, respectively. This value is already reduced such that each of the
  !! MPI tasks have the same value
  real(dp), intent(out), optional :: ehartree
  !local variables
  real(dp), parameter :: max_ratioex_PB = 1.0d2
  logical :: sum_pi,sum_ri,build_c,is_vextra,plot_cavity,wrtmsg
  logical :: cudasolver,poisson_boltzmann,calc_nabla2pot,needmem
  integer :: i3start,n1,n23,i3s,i23s,i23sd2,i3sd2,i_PB,i3s_pot_pb
  real(dp) :: e_static,norm_nonvac,ehartreeLOC,res_PB
  type(PSolver_energies) :: energs
  type(low_level_workarrays) :: w
  real(dp), dimension(:,:,:), pointer :: wzf
  real(dp), dimension(:,:), allocatable :: depsdrho,dsurfdrho
  real(dp), dimension(:,:,:), allocatable :: rhopot_full,nabla2_rhopot,delta_rho,cc_rho
  real(dp), dimension(:,:,:,:), allocatable :: nabla_rho
  real(dp), dimension(:,:), allocatable :: rho_pb
  real(dp), dimension(:,:,:), pointer :: pot_ion_eff,vextra_eff
  integer, parameter :: ECAV_=1,EREP_=2,EDIS_=3
  real(dp), dimension(3) :: ecavs
  !character(len=3) :: quiet

  call f_routine(id='Electrostatic_Solver')

   energs=PSolver_energies_null()

   select case(kernel%opt%datacode)
   case('G')
      !starting address of rhopot in the case of global i/o
      i3start=kernel%grid%istart*kernel%mesh%ndims(1)*kernel%mesh%ndims(2)+1
      i23s=kernel%grid%istart*kernel%mesh%ndims(2)+1
      i3s=kernel%grid%istart+1
      if (kernel%grid%n3p == 0) then
         i3start=1
         i23s=1
         i3s=1
      end if
   case('D')
      !distributed i/o
      i3start=1
      i23s=1
      i3s=1
   case default
      i3s = 0
      call f_err_throw('datacode ("'//kernel%opt%datacode//&
           '") not admitted in PSolver')
   end select

   !aliasing
   n23=kernel%grid%m3*kernel%grid%n3p
   n1=kernel%grid%m1

   i3sd2=kernel%grid%istart+1
   i23sd2=kernel%grid%istart*kernel%mesh%ndims(2)+1
   if (kernel%grid%n3p==0) then
      i3sd2=1
      i23sd2=1
   end if

   poisson_boltzmann=.not. (kernel%method .hasattr. PS_PB_NONE_ENUM)


   wrtmsg=.true.
  select case(kernel%opt%verbosity_level)
  case(0)
     !call f_strcpy(quiet,'YES')
     wrtmsg=.false.
  case(1)
     !call f_strcpy(quiet,'NO')
     wrtmsg=.true.
  end select
  !in any case only master proc writes messages
  wrtmsg=wrtmsg .and. kernel%mpi_env%iproc==0 .and. kernel%mpi_env%igroup==0

  !decide what to do
  sum_pi=present(pot_ion) .and. n23 > 0
  sum_ri=present(rho_ion) .and. n23 > 0
  build_c=(kernel%method .hasattr. PS_SCCS_ENUM) .and. kernel%opt%update_cavity
  calc_nabla2pot=build_c .or. kernel%opt%final_call
  is_vextra=sum_pi .or. build_c
  plot_cavity=kernel%opt%cavity_info .and. (kernel%method /= PS_VAC_ENUM)
  cudasolver= (kernel%igpu==1 .and. .not. kernel%opt%calculate_strten)

  !check of the input variables, if needed
!!$  if (kernel%method /= PS_VAC_ENUM .and. .not. present(rho_ion)) then
!!$     call f_err_throw('Error in Electrostatic_Solver, for a cavity treatment the array rho_ion is needed')
!!$  end if
  if (kernel%method == PS_PI_ENUM .and. .not. dielectric_arrays_forPI(kernel%diel)) then
     call f_err_throw('The PI method needs the arrays of dlogeps and oneoeps,'//&
          ' use pkernel_set_epsilon routine to set them')
  else if (kernel%method == PS_PCG_ENUM .and. .not. dielectric_arrays_forPCG(kernel%diel)) then
     call f_err_throw('The PCG method needs the arrays corr and oneosqrteps,'//&
          ' use pkernel_set_epsilon routine to set them')
  end if

  if (wrtmsg) then
     call yaml_mapping_open('Poisson Solver')
     select case(domain_geocode(kernel%mesh%dom))
     case('F')
        call yaml_map('BC','Free')
     case('P')
        call yaml_map('BC','Periodic')
     case('S')
        call yaml_map('BC','Surface')
     case('W')
        call yaml_map('BC','Wires')
     end select
     call yaml_map('Box',kernel%mesh%ndims,fmt='(i5)')
     call yaml_map('MPI tasks',kernel%mpi_env%nproc,fmt='(i5)')
     if (cudasolver) call yaml_map('GPU acceleration',.true.)
  end if

  !in the case of SC cavity, gather the full density and determine the depsdrho
  !here the if statement for the SC cavity should be put
  !print *,'method',trim(char(kernel%method)),associated(kernel%method%family),trim(char(kernel%method%family))
  if (calc_nabla2pot) then
     rhopot_full=f_malloc(kernel%mesh%ndims,id='rhopot_full')
     nabla2_rhopot=f_malloc(kernel%mesh%ndims,id='nabla2_rhopot')
  end if

  if (build_c) then
     delta_rho=f_malloc(kernel%mesh%ndims,id='delta_rho')
     cc_rho=f_malloc(kernel%mesh%ndims,id='cc_rho')
     nabla_rho=f_malloc([kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3),3],id='nabla_rho')
     depsdrho=f_malloc([n1,n23],id='depsdrho')
     dsurfdrho=f_malloc([n1,n23],id='dsurfdrho')
     !useless for datacode= G
     if (kernel%opt%datacode == 'D') then
        call PS_gather(rhov(1,1,i3s),kernel%grid,kernel%mpi_env,dest=rhopot_full)
     else
        call f_memcpy(n=product(kernel%mesh%ndims),src=rhov(1,1,1),dest=rhopot_full(1,1,1))
     end if
     !call pkernel_build_epsilon(kernel,work_full,eps0,depsdrho,dsurfdrho)
     call rebuild_cavity_from_rho(rhopot_full,nabla_rho,nabla2_rhopot,delta_rho,cc_rho,depsdrho,dsurfdrho,&
          kernel)
     call f_free(nabla_rho)
     call f_free(delta_rho)
     call f_free(cc_rho)
  end if

  if (kernel%method == PS_PI_ENUM .and. calc_nabla2pot) call f_free(rhopot_full)

  !add the ionic density to the potential, calculate also the integral
  !between the rho and pot_ion and the extra potential if present
  e_static=0.0_dp
  if (sum_ri) then
     if (sum_pi) then
        call finalize_hartree_results(.true.,cudasolver,kernel%GPU,&
             kernel%method /= PS_VAC_ENUM,&
             rho_ion,&
             kernel%grid%m1,kernel%grid%m3,kernel%grid%n3p,&
             kernel%grid%m1,kernel%grid%m3,kernel%grid%n3p,&
             pot_ion,rhov(1,1,i3s),rhov(1,1,i3s),e_static)
     else
        call axpy(n1*n23,1.0_dp,rho_ion(1,1,1),1,rhov(1,1,i3s),1)
     end if
     if (wrtmsg) call yaml_map('Summing up ionic density',.true.)
  end if

  !inform about the quantity of charge "outside" the cavity
  if (kernel%method /= PS_VAC_ENUM) then
     call f_zero(norm_nonvac)
     if (n23 >0) call nonvacuum_projection(n1,n23,rhov(1,1,i3s),kernel%diel%oneoeps,norm_nonvac)
     norm_nonvac=norm_nonvac*product(kernel%mesh%hgrids)
     call PS_reduce(norm_nonvac,kernel%mpi_env)
     if (wrtmsg) call yaml_map('Integral of the density in the nonvacuum region',norm_nonvac)
  end if

  !we need to reallocate the zf array with the right size when called with stress_tensor and gpu
  if(kernel%keepzf == 1) then
     if(kernel%igpu==1 .and. kernel%opt%calculate_strten) then !LG: what means that?
        call f_free_ptr(kernel%w%zf)
        kernel%w%zf = f_malloc_ptr([kernel%grid%md1, kernel%grid%md3, &
             2*kernel%grid%md2/kernel%mpi_env%nproc],id='zf')
     end if
     wzf => kernel%w%zf
  else
     wzf = f_malloc_ptr([kernel%grid%md1, kernel%grid%md3, &
          2*kernel%grid%md2/kernel%mpi_env%nproc],id='zf')
  end if
  select case(trim(toa(kernel%method)))
  case('PCG')
     call alloc_PCG_workarrays(w, rhov(1,1,i3s), n1, n23)
     call ensure_grid_observables_allocations(kernel%arr, n1, n23, n23)
  case('PI')
     call alloc_PI_workarrays(w, kernel%mesh%ndims)
     call ensure_grid_observables_allocations(kernel%arr, n1, n23, &
          & kernel%mesh%ndims(2)*kernel%mesh%ndims(3))
  end select

  i3s_pot_pb=0  !in the PCG case
  if (kernel%method == PS_PI_ENUM) i3s_pot_pb=i23sd2-1

  !switch between neutral and ionic solution (GPe or PBe)
  if (poisson_boltzmann) then
     if (.not. associated(kernel%arr%rho_ions))&
          kernel%arr%rho_ions=f_malloc0_ptr([n1,n23],id='rho_ions')
     rho_pb = f_malloc([n1, n23], id = 'rho_pb')
     call f_memcpy(n = n1 * n23, src = rhov(1, 1, i3s), dest = rho_pb)
     if (kernel%opt%use_pb_input_guess) then
        call PB_iteration(n1,n23,i3s_pot_pb,1.0_dp,kernel%cavity,rhov(1,1,i3s),kernel%arr%pot,kernel%diel%eps,&
             kernel%arr%rho_ions,rho_pb,res_PB)
        if (.not. kernel%opt%use_input_guess .and. kernel%method == PS_PCG_ENUM ) call f_zero(kernel%arr%pot)
     else
        call f_zero(kernel%arr%rho_ions)
     end if
     if (wrtmsg) call yaml_sequence_open('Poisson Boltzmann solver')
     loop_pb: do i_PB=1,kernel%max_iter_PB
        if (wrtmsg) then
           call yaml_sequence(advance='no')
           call yaml_mapping_open()
        end if
        call Parallel_GPS(kernel,kernel%diel,kernel%arr, &
             cudasolver,kernel%opt%potential_integral,energs%strten,&
             wrtmsg,rho_pb,kernel%opt%use_input_guess,w,wzf)

        call PB_iteration(n1,n23,i3s_pot_pb,kernel%PB_eta,kernel%cavity,rhov(1,1,i3s),kernel%arr%pot,kernel%diel%eps,&
             kernel%arr%rho_ions,rho_pb,res_PB)
        if (kernel%method == PS_PCG_ENUM) call f_memcpy(src=rho_pb,dest=w%PCG%res)
        call PS_reduce(res_PB,kernel%mpi_env)
        res_PB=sqrt(res_PB/product(kernel%mesh%ndims))
        if (wrtmsg) then
           call yaml_newline()
           call EPS_iter_output(i_PB,0.0_dp,res_PB,0.0_dp,0.0_dp,0.0_dp)
           call yaml_mapping_close()
        end if
        if (res_PB < kernel%minres_PB .or. res_PB > max_ratioex_PB) exit loop_pb
     end do loop_pb
     if (wrtmsg) call yaml_sequence_close()
     call f_free(rho_pb)
  else
     !call the Generalized Poisson Solver
     call Parallel_GPS(kernel,kernel%diel,kernel%arr, &
          cudasolver,kernel%opt%potential_integral,energs%strten,&
          wrtmsg,rhov(1,1,i3s),kernel%opt%use_input_guess,w,wzf)
  end if
  call free_low_level_workarrays(w)

  !this part is not important now, to be fixed later
  if (plot_cavity) then
     if (kernel%method == PS_PCG_ENUM) then
        needmem=.not. allocated(rhopot_full)
        if (needmem) rhopot_full=f_malloc(kernel%mesh%ndims,id='rhopot_full')
        call PS_gather(src=kernel%arr%pot,dest=rhopot_full,mpi_env=kernel%mpi_env,grid=kernel%grid)
        call polarization_charge(kernel,rhopot_full,rhov(1,1,i3s),kernel%arr%rho_pol)
        if (needmem) call f_free(rhopot_full)
        if (kernel%mpi_env%iproc==0 .and. kernel%mpi_env%igroup==0) &
             call yaml_map('Polarization charge calculated',.true.)
     end if
  end if

!!$  !here we should extract the information on the cavity
!!$  !--------------------------------------
!!$  ! Polarization charge, to be calculated on-demand
!!$  call pol_charge(kernel,pot_full,rho,kernel%w%pot)
!!$  !--------------------------------------

  if (.not. plot_cavity) then
     call f_free_ptr(kernel%arr%rho_pol)
     nullify(kernel%arr%rho_pol)
  end if

  !the external ionic potential is referenced if present
  if (sum_pi) then
     pot_ion_eff=>pot_ion
  else
     !point to a temporary array
     pot_ion_eff=>wzf !<however unused
  end if
  if (build_c) then
     if(.not. associated(wzf)) then
        wzf = f_malloc_ptr([kernel%grid%md1, kernel%grid%md3, 2*kernel%grid%md2/kernel%mpi_env%nproc],id='zf')
     end if
     vextra_eff=>wzf
  else if (sum_pi) then
     vextra_eff=>pot_ion_eff
  else
     vextra_eff=>wzf !hovever unused
  end if

  ehartreeLOC=0.0_gp
  select case(trim(toa(kernel%method)))
  case('VAC')
     call finalize_hartree_results(present(pot_ion),cudasolver,kernel%GPU,&
          .false.,pot_ion_eff,&
          kernel%grid%m1,kernel%grid%m3,kernel%grid%n3p,&
          kernel%grid%md1,kernel%grid%md3,2*(kernel%grid%md2/kernel%mpi_env%nproc),&
          rhov(1,1,i3s),wzf,rhov(1,1,i3s),ehartreeLOC)
  case('PI')
     !if statement for SC cavity
     if (calc_nabla2pot) then
        !in the PI method the potential is allocated as a full array
        call nabla_u_square(kernel%mesh,kernel%arr%pot,nabla2_rhopot,kernel%diel%nord)
!!$        call add_Vextra(n1,n23,nabla2_rhopot(1,1,i3sd2),&
!!$             depsdrho,dsurfdrho,kernel%cavity,kernel%opt%only_electrostatic,&
!!$             sum_pi,pot_ion_eff,vextra_eff)
       end if

!!$     !here the harteee energy can be calculated and the ionic potential
!!$       !added
!!$       call finalize_hartree_results(is_vextra,cudasolver,kernel,&
!!$          vextra_eff,&
!!$          kernel%grid%m1,kernel%grid%m3,kernel%grid%n3p,&
!!$          kernel%grid%m1,kernel%grid%m3,kernel%grid%n3p,&
!!$          rhov(1,1,i3s),kernel%w%pot(1,i23sd2),rhov(1,1,i3s),ehartreeLOC)

  case('PCG')
     !only useful for gpu, bring back the x array
     if (kernel%PCG_GPU%used .and. allocated_PCG_GPU(kernel%PCG_GPU)) then !GPU case
        call get_gpu_data(kernel%grid%m3*kernel%grid%n3p*kernel%grid%m1,&
             kernel%arr%pot,kernel%PCG_GPU%x)
     end if

     if (calc_nabla2pot) then
        call PS_gather(src=kernel%arr%pot,dest=rhopot_full,mpi_env=kernel%mpi_env,grid=kernel%grid)
        call nabla_u_square(kernel%mesh,rhopot_full,nabla2_rhopot,kernel%diel%nord)
        call f_free(rhopot_full)
!!$        call add_Vextra(n1,n23,nabla2_rhopot(1,1,i3sd2),&
!!$             depsdrho,dsurfdrho,kernel%cavity,kernel%opt%only_electrostatic,&
!!$             sum_pi,pot_ion_eff,vextra_eff)
     end if

!!$     !here the harteee energy can be calculated and the ionic potential
!!$     !added
!!$     call finalize_hartree_results(is_vextra,cudasolver,kernel,&
!!$          vextra_eff,&
!!$          kernel%grid%m1,kernel%grid%m3,kernel%grid%n3p,&
!!$          kernel%grid%m1,kernel%grid%m3,kernel%grid%n3p,&
!!$          rhov(1,1,i3s),kernel%w%pot,rhov(1,1,i3s),ehartreeLOC)

  end select

  if (kernel%method /= PS_VAC_ENUM) then
     !here the harteee energy can be calculated and the ionic potential
     !added

     if (build_c) then
        call add_Vextra(n1,n23,nabla2_rhopot(1,1,i3sd2),&
             depsdrho,dsurfdrho,kernel%cavity,kernel%opt%only_electrostatic,&
             sum_pi,pot_ion_eff,vextra_eff)
     end if

     call finalize_hartree_results(is_vextra,cudasolver,kernel%GPU,&
          .true., vextra_eff,&
          kernel%grid%m1,kernel%grid%m3,kernel%grid%n3p,&
          kernel%grid%m1,kernel%grid%m3,kernel%grid%n3p,&
          rhov(1,1,i3s),kernel%arr%pot(1,i3s_pot_pb+1),rhov(1,1,i3s),ehartreeLOC)
  end if

  if (calc_nabla2pot) then
     !destroy oneoverepsilon array in the case of the forces for the rigid case
     !if (kernel%opt%final_call) call nabla2pot_epsm1(n1,n23,kernel%w%eps,nabla2_rhopot(1,1,i3sd2),kernel%w%oneoeps)
     if (kernel%opt%final_call) call nabla2pot_epsm1(n1,n23,nabla2_rhopot(1,1,i3sd2),kernel%diel%oneoeps)
     call f_free(nabla2_rhopot)
  end if


  if (build_c) then
     call f_free(depsdrho)
     call f_free(dsurfdrho)
  end if
  nullify(vextra_eff,pot_ion_eff)

  if(kernel%keepzf /= 1) call f_free_ptr(wzf)
  if (.not. kernel%opt%use_input_guess .and. &
       & (.not. poisson_boltzmann .or. .not. kernel%opt%use_pb_input_guess)) then
     call f_free_ptr(kernel%arr%pot)
     nullify(kernel%arr%pot)
  end if

  !gather the full result in the case of datacode = G
  if (kernel%opt%datacode == 'G') call PS_gather(rhov,kernel%grid,kernel%mpi_env)

  if (kernel%opt%only_electrostatic .or. kernel%method == PS_VAC_ENUM) then
   kernel%diel%IntSur=0.0_gp
   kernel%diel%IntVol=0.0_gp
  end if
  !evaluating the total ehartree + e_static if needed
  !also cavitation energy can be given
  energs%hartree=ehartreeLOC*0.5_dp*kernel%mesh%volume_element!product(kernel%mesh%hgrids)
  energs%eVextra=e_static*kernel%mesh%volume_element!product(kernel%mesh%hgrids)
  energs%cavitation=(kernel%cavity%gammaS+kernel%cavity%alphaS)*kernel%diel%IntSur+&
       kernel%cavity%betaV*kernel%diel%IntVol

  call PS_reduce(energs,kernel%mpi_env)

  if (present(energies)) then
     energies=energs
  end if

  if (present(ehartree)) then
     ehartree=energs%hartree
  end if

!!! Old lines -------------------------------------------------------------------
!!  if (wrtmsg) then
!!     if (kernel%cavity%gammaS*kernel%IntSur /= 0.0_gp) &
!!          call yaml_map('Cavitation energy',kernel%cavity%gammaS*kernel%IntSur)
!!     if (kernel%cavity%alphaS*kernel%IntSur /= 0.0_gp) &
!!          call yaml_map('Repulsion energy',kernel%cavity%alphaS*kernel%IntSur)
!!     if (kernel%cavity%betaV*kernel%IntVol /= 0.0_gp) &
!!          call yaml_map('Dispersion energy',kernel%cavity%betaV*kernel%IntVol)
!!     if (energs%cavitation /= 0.0_gp) &
!!          call yaml_map('Non-eletrostatic energy',energs%cavitation)
!!  end if

  ecavs=0.0_dp
  if ((.not.(kernel%method == PS_VAC_ENUM)) .or. (.not.kernel%opt%only_electrostatic)) then
   ecavs(ECAV_)=kernel%cavity%gammaS*kernel%diel%IntSur
   ecavs(EREP_)=kernel%cavity%alphaS*kernel%diel%IntSur
   ecavs(EDIS_)=kernel%cavity%betaV*kernel%diel%IntVol
   call PS_reduce(ecavs,kernel%mpi_env)
  end if
  if (wrtmsg) then
   if (any(ecavs /= 0.0_gp)) then
    call yaml_map('Cavitation energy',ecavs(ECAV_))
    call yaml_map('Repulsion energy',ecavs(EREP_))
    call yaml_map('Dispersion energy',ecavs(EDIS_))
     if (energs%cavitation /= 0.0_gp) &
           call yaml_map('Non-electrostatic energy',energs%cavitation)
   end if
  end if

  if (wrtmsg) call yaml_mapping_close()

  call f_release_routine()
end subroutine Electrostatic_Solver


!>Generalized Poisson Solver working with parallel data distribution.
!!should not allocate memory as the memory handling is supposed to be done
!!outside. the only exception for the moment is represented by
!! apply_kernel as the inner poisson solver still allocates heap memory.
subroutine Parallel_GPS(kernel,diel,arr,cudasolver,offset,strten,wrtmsg,rho_dist,use_input_guess,w,wzf)
  use FDder!, only: update_rhopol
  use f_enums
  use workarrays
  use wrapper_linalg
  use yaml_output
  use yaml_strings
  use time_profiling
  use PSbase
  use PSbox
  use f_utils
  implicit none
  logical, intent(in) :: cudasolver,wrtmsg
  real(dp), intent(in) :: offset
  type(coulomb_operator), intent(in) :: kernel
  type(dielectric_arrays), intent(in) :: diel
  type(grid_observables), intent(inout) :: arr
  !>density in input, distributed version. Not modified even if written as inout
  real(dp), dimension(kernel%grid%m1,kernel%grid%m3*kernel%grid%n3p), intent(inout) :: rho_dist
  real(dp), dimension(6), intent(out) :: strten !<stress tensor
  logical, intent(in) :: use_input_guess
  type(low_level_workarrays), intent(inout) :: w
  real(dp), dimension(kernel%grid%md1, kernel%grid%md3, &
             2*kernel%grid%md2/kernel%mpi_env%nproc), intent(inout) :: wzf
  !local variables
  integer, parameter :: NEVER_DONE=0,DONE=1
  real(dp), parameter :: max_ratioex = 1.0e10_dp !< just to avoid crazy results
  real(dp), parameter :: no_ig_minres=1.0d-2 !< just to neglect wrong inputguess
  integer :: n1,n23,i1,i23,ip,i23s,iinit,i_stat
  real(dp) :: rpoints,rhores2,beta,ratio,normr,normb,alpha,q,beta0,kappa
  logical :: localPCG_GPU
  type(PCG_GPU_workarrays) :: lPCG_GPU
  !aliasings
  call f_timing(TCAT_PSOLV_COMPUT,'ON')
  rpoints=product(real(kernel%mesh%ndims,dp))

  n23=kernel%grid%m3*kernel%grid%n3p
  n1=kernel%grid%m1

  !now switch the treatment according to the method used
  select case(trim(toa(kernel%method)))
  case('VAC')
     !initalise to zero the zf array
     !call f_zero(wzf)
     !core psolver routine
     call apply_kernel(cudasolver,kernel%mesh,kernel%grid,&
          kernel%GPU,kernel%kernel,kernel%mu,kernel%mpi_env,kernel%part_mpi,&
          kernel%inplane_mpi,rho_dist,offset,strten,wzf,.false.)
  case('PI')

     if (wrtmsg) &
          call yaml_sequence_open('Embedded PSolver Polarization Iteration Method')

     if (use_input_guess) then
        !gathering the data to obtain the distribution array
        !call PS_gather(kernel%w%pot,kernel) !not needed as in PI the W%pot array is global
        call update_rhopol(kernel%mesh,arr%pot,diel%nord,1.0_dp,diel%eps,&
             diel%dlogeps,w%PI%rho,rhores2)
     end if

     ip=0
     iinit=NEVER_DONE
     pi_loop: do while (ip <= kernel%max_iter)
      ip=ip+1
!     pi_loop: do ip=1,kernel%max_iter
        !update the needed part of rhopot array
        !irho=1
        !i3s=kernel%grid%istart
        i23s=kernel%grid%istart*kernel%grid%m3
        do i23=1,n23
           do i1=1,n1
              arr%pot(i1,i23+i23s)=& !this is full
              !rhopot(irho)=&
                   diel%oneoeps(i1,i23)*rho_dist(i1,i23)+&
                   w%PI%rho(i1,i23+i23s) !this is full
              arr%rho_pol(i1,i23)=arr%pot(i1,i23+i23s)-rho_dist(i1,i23)
              !irho=irho+1
           end do
        end do

        !initalise to zero the zf array
        !call f_zero(wzf)
        call apply_kernel(cudasolver,kernel%mesh,kernel%grid,&
             kernel%GPU,kernel%kernel,kernel%mu,kernel%mpi_env,kernel%part_mpi,&
             kernel%inplane_mpi,arr%pot(1,i23s+1),&
             offset,strten,wzf,.true.)
        !gathering the data to obtain the distribution array
        call PS_gather(arr%pot,kernel%grid,kernel%mpi_env)

        !update rhopol and calculate residue
        !reduction of the residue not necessary
        call update_rhopol(kernel%mesh,arr%pot,diel%nord,kernel%PI_eta,diel%eps,&
             diel%dlogeps,w%PI%rho,rhores2)

        rhores2=sqrt(rhores2/rpoints)

        if (wrtmsg) then
           call yaml_newline()
           call yaml_sequence(advance='no')
           call EPS_iter_output(ip,0.0_dp,rhores2,0.0_dp,0.0_dp,0.0_dp)
        end if

        if (rhores2 < kernel%minres) exit pi_loop

        if ((rhores2 > no_ig_minres).and.use_input_guess .and. iinit==NEVER_DONE) then
           call f_zero(w%PI%rho)
!!$           i23s=grid%istart*grid%m3
!!$           do i23=1,n23
!!$              do i1=1,n1
!!$                 kernel%w%rho(i1,i23+i23s)=0.0_dp !this is full
!!$              end do
!!$           end do
           if (kernel%mpi_env%iproc==0) &
                call yaml_warning("Input guess not used due to residual norm > "//trim(yaml_toa(no_ig_minres)))
           iinit=DONE
        end if
     end do pi_loop
     if (wrtmsg) call yaml_sequence_close()
  case('PCG')
     if (wrtmsg) then
        call yaml_newline()
        call yaml_sequence_open('Embedded PSolver, Preconditioned Conjugate Gradient Method')
     end if

     normb=dot(n1*n23,w%PCG%res(1,1),1,w%PCG%res(1,1),1)
     call PS_reduce(normb,kernel%mpi_env)
     normb=sqrt(normb/rpoints)
     normr=normb

     iinit=1
     if (use_input_guess) then
      iinit=2

      !$omp parallel do default(shared) private(i1,i23,q)
      do i23=1,n23
         do i1=1,n1
            q=arr%pot(i1,i23)*diel%corr(i1,i23)
            w%PCG%q(i1,i23)=arr%pot(i1,i23)
            w%PCG%z(i1,i23)=(w%PCG%res(i1,i23)-q)*&
                                 diel%oneoeps(i1,i23)
         end do
      end do
      !$omp end parallel do

      call apply_kernel(cudasolver,kernel%mesh,kernel%grid,&
           kernel%GPU,kernel%kernel,kernel%mu,kernel%mpi_env,kernel%part_mpi,&
           kernel%inplane_mpi,w%PCG%z,offset,strten,wzf,.true.)

      normr=0.0_dp
      !$omp parallel do default(shared) private(i1,i23) &
      !$omp reduction(+:normr)
      do i23=1,n23
         do i1=1,n1
            arr%pot(i1,i23)=w%PCG%z(i1,i23)*diel%oneoeps(i1,i23)
            w%PCG%z(i1,i23)=w%PCG%res(i1,i23)
            w%PCG%res(i1,i23)=(w%PCG%q(i1,i23) - arr%pot(i1,i23))*diel%corr(i1,i23)
!!$            if (kernel%w%res(i1,i23) /= 0.0_dp) then
!!$               print *,'facs',kernel%w%q(i1,i23)
!!$               print *,'facs2',kernel%w%pot(i1,i23)
!!$               print *,'facs3',kernel%w%corr(i1,i23)
!!$               print *,'here',kernel%w%res(i1,i23)
!!$               print *,'there',kernel%w%res(i1,i23)**2
!!$            end if
            w%PCG%q(i1,i23)=0.d0
            normr=normr+w%PCG%res(i1,i23)**2
         end do
      end do
      !$omp end parallel do
      !print *,'here',sum(kernel%w%res)
      !normr=dot(n1*n23,kernel%w%res(1,1),1,kernel%w%res(1,1),1)
      call PS_reduce(normr,kernel%mpi_env)
      normr=sqrt(normr/rpoints)
      ratio=normr/normb

      if (wrtmsg) then
       call yaml_newline()
       call yaml_sequence(advance='no')
       call EPS_iter_output(1,0.0_dp,normr,0.0_dp,0.0_dp,0.0_dp)
      end if
      if (normr < kernel%minres) iinit=kernel%max_iter+10

      if (normr > no_ig_minres ) then

       !wipe out the IG information as it turned out to be useless
       !$omp parallel do default(shared) private(i1,i23)
       do i23=1,n23
          do i1=1,n1
             w%PCG%res(i1,i23)=w%PCG%z(i1,i23)
             arr%pot(i1,i23)=0.d0
          end do
       end do
       !$omp end parallel do

       iinit=1
       !call yaml_warning('Input guess not used due to residual norm > 1')
       if (kernel%mpi_env%iproc==0) &
            call yaml_warning("Input guess not used due to residual norm > "//trim(yaml_toa(no_ig_minres) ))
      end if

     end if

     beta=1.d0
     ratio=1.d0

     !$omp parallel do default(shared) private(i1,i23)
     do i23=1,n23
        do i1=1,n1
           w%PCG%z(i1,i23)=w%PCG%res(i1,i23)*diel%oneoeps(i1,i23)
        end do
     end do
     !$omp end parallel do

     lPCG_GPU = kernel%PCG_GPU
     localPCG_GPU = lPCG_GPU%used .and. .not. allocated_PCG_GPU(lPCG_GPU)
     if (localPCG_GPU) then
        call alloc_PCG_GPU_workarrays(lPCG_GPU, n1*n23, i_stat)
        if (i_stat /= 0) print *,'error cudamalloc',i_stat
     end if
     call init_PCG_GPU_workarrays(lPCG_GPU, diel, w%PCG%res)

     PCG_loop: do ip=iinit,kernel%max_iter

        !initalise to zero the zf array
        !call f_zero(wzf)
        !  Apply the Preconditioner
        call apply_kernel(cudasolver,kernel%mesh,kernel%grid,&
             kernel%GPU,kernel%kernel,kernel%mu,kernel%mpi_env,kernel%part_mpi,&
             kernel%inplane_mpi,w%PCG%z,offset,strten,wzf,.true.)

        beta0 = beta
        beta = dielectric_PCG_reduce_beta(diel, w%PCG, lPCG_GPU)
        call PS_reduce(beta, kernel%mpi_env)
        kappa = dielectric_PCG_reduce_kappa(diel, w%PCG, lPCG_GPU, beta, beta0)
        call PS_reduce(kappa, kernel%mpi_env)
        alpha = beta / kappa
        normr = dielectric_PCG_reduce_norm(diel, arr%pot, w%PCG, lPCG_GPU, alpha)
        call PS_reduce(normr, kernel%mpi_env)

        normr=sqrt(normr/rpoints)

        ratio=normr/normb
        if (wrtmsg) then
           call yaml_newline()
           call yaml_sequence(advance='no')
           !call EPS_iter_output(ip,normb,normr,ratio,alpha,beta)
           call EPS_iter_output(ip,0.0_dp,normr,0.0_dp,0.0_dp,0.0_dp)
        end if
        if (normr < kernel%minres .or. normr > max_ratioex) exit PCG_loop
     end do PCG_loop

     if (localPCG_GPU) then
        call free_PCG_GPU_workarrays(lPCG_GPU)
     end if

     if (wrtmsg) call yaml_sequence_close()
  end select
  call f_timing(TCAT_PSOLV_COMPUT,'OF')
end subroutine Parallel_GPS

subroutine H_potential(datacode,kernel,rhopot,pot_ion,eh,offset,sumpion,&
     quiet,rho_ion,stress_tensor) !optional argument
  use FDder
  use f_enums
  use yaml_strings
  use psolver_environment
   implicit none

   !> kernel of the Poisson equation. It is provided in distributed case, with
   !! dimensions that are related to the output of the PS_dim4allocation routine
   !! it MUST be created by following the same geocode as the Poisson Solver.
   !! it is declared as inout as in the cavity treatment it might be modified
   type(coulomb_operator), intent(inout) :: kernel

   !> @copydoc poisson_solver::doc::datacode
   character(len=1), intent(in) :: datacode

   !> Logical value which states whether to sum pot_ion to the final result or not
   !!   .true.  rhopot will be the Hartree potential + pot_ion
   !!           pot_ion will be untouched
   !!   .false. rhopot will be only the Hartree potential
   !!           pot_ion will be ignored
   logical, intent(in) :: sumpion

   !> Total integral on the supercell of the final potential on output
   real(dp), intent(in) :: offset

   !> Hartree Energy (Hartree)
   real(gp), intent(out) :: eh

   !> On input, it represents the density values on the grid points
   !! On output, it is the Hartree potential (and maybe also pot_ion)
   real(dp), dimension(*), intent(inout) :: rhopot

   !> Additional external potential that is added to the output,
   !! when the XC parameter ixc/=0 and sumpion=.true.
   !! When sumpion=.true., it is always provided in the distributed form,
   !! clearly without the overlapping terms which are needed only for the XC part
   real(dp), dimension(*), intent(inout) :: pot_ion

   !> Optional argument to avoid output writings
   character(len=3), intent(in), optional :: quiet

   !> Additional external density added to the input, regardless of the value of sumpion,
   !! without the overlapping terms which are needed only for the XC part
   real(dp), dimension(kernel%grid%m1,kernel%grid%m3*kernel%grid%n3p), intent(inout), optional :: rho_ion


   !> Stress tensor: Add the stress tensor part from the Hartree potential
   real(dp), dimension(6), intent(out), optional :: stress_tensor

   !local variables
   character(len=*), parameter :: subname='H_potential'
   real(dp), parameter :: max_ratioex = 1.0e10_dp,eps0=78.36d0 !to be inserted in pkernel
   logical :: global,verb
   type(PSolver_energies) :: energies

   !kernel%opt=PSolver_options_null()
   global=.false.
   global=datacode=='G'
   verb=.true.
   if (present(quiet)) then
      if ((quiet .eqv. 'yes') .and. kernel%method == PS_VAC_ENUM) &
           verb=.false.
   end if

   call PS_set_options(kernel,global_data=global,&
        calculate_strten=present(stress_tensor),verbose=verb,&
        update_cavity=kernel%method .hasattr. PS_SCCS_ENUM,&
        potential_integral=offset,&
        final_call=(kernel%method .hasattr. 'rigid') .and.&
        present(stress_tensor))

   if (sumpion .and. present(rho_ion) .and. kernel%method /= PS_VAC_ENUM) then
      call Electrostatic_Solver(kernel,rhopot,energies,pot_ion,rho_ion)
   else if (sumpion) then
      call Electrostatic_Solver(kernel,rhopot,energies,pot_ion)
   else if (present(rho_ion)) then
      call Electrostatic_Solver(kernel,rhopot,energies,rho_ion=rho_ion)
   else
      call Electrostatic_Solver(kernel,rhopot,energies)
   end if

   !retrieve the energy and stress
   !eh=energies%hartree+energies%eVextra
   eh=energies%hartree+energies%eVextra+energies%cavitation
   if (present(stress_tensor)) stress_tensor=energies%strten

END SUBROUTINE H_potential

!!$subroutine extra_sccs_potential(kernel,work_full,depsdrho,pot,eps0)
!!$  implicit none
!!$  type(coulomb_operator), intent(in) :: kernel
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3)), intent(out) :: work_full
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2)*kernel%grid%n3p), intent(inout) :: depsdrho
!!$  !real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2)*kernel%grid%n3p), intent(in) :: dsurfdrho
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2)*kernel%grid%n3p) :: pot !intent in
!!$  real(dp), intent(in) :: eps0
!!$
!!$  call PS_gather(src=pot,kernel=kernel,dest=work_full)
!!$ !!$  !first gather the potential to calculate the derivative
!!$ !!$  if (kernel%mpi_env%nproc > 1) then
!!$ !!$     call fmpi_allgather(pot,recvbuf=work_full,recvcounts=kernel%counts,&
!!$ !!$          displs=kernel%displs,comm=kernel%mpi_env%mpi_comm)
!!$ !!$  else
!!$ !!$     call f_memcpy(src=pot,dest=work_full)
!!$ !!$  end if
!!$
!!$  !then calculate the extra potential and add it to pot
!!$  !call sccs_extra_potential(kernel,work_full,depsdrho,dsurfdrho,eps0)
!!$  call sccs_extra_potential(kernel,work_full,depsdrho,eps0)
!!$
!!$end subroutine extra_sccs_potential

!!$subroutine pol_charge(kernel,pot_full,rho,pot)
!!$  implicit none
!!$  type(coulomb_operator), intent(inout) :: kernel
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3)), intent(out) :: pot_full
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2)*kernel%grid%n3p), intent(inout) :: rho
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2)*kernel%grid%n3p) :: pot !intent in
!!$
!!$  !first gather the potential to calculate the derivative
!!$  call PS_gather(src=pot,kernel=kernel,dest=pot_full)
!!$ !!$  if (kernel%mpi_env%nproc > 1) then
!!$ !!$     call fmpi_allgather(pot,recvbuf=pot_full,recvcounts=kernel%counts,&
!!$ !!$          displs=kernel%displs,comm=kernel%mpi_env%mpi_comm)
!!$ !!$  else
!!$ !!$     call f_memcpy(src=pot,dest=pot_full)
!!$ !!$  end if
!!$
!!$  !calculate the extra potential and add it to pot
!!$  call polarization_charge(kernel,pot_full,rho)
!!$
!!$end subroutine pol_charge

!>put in pol_charge array the polarization charge
subroutine polarization_charge(kernel,pot,rho,rho_pol)
  use FDder
  use dynamic_memory
  implicit none
  type(coulomb_operator), intent(inout) :: kernel
  !>complete potential, needed to calculate the derivative
  real(dp), dimension(kernel%grid%m1,kernel%grid%m3,kernel%grid%m2), intent(in) :: pot
  real(dp), dimension(kernel%grid%m1,kernel%grid%m3*kernel%grid%n3p), intent(in) :: rho
  real(dp), dimension(kernel%grid%m1,kernel%grid%m3*kernel%grid%n3p), intent(out) :: rho_pol
  !local variables
  integer :: i3,i3s,i2,i1,i23,n01,n02,n03
  real(dp) :: pi
  real(dp), dimension(:,:,:,:), allocatable :: nabla_pot
  real(dp), dimension(:,:,:), allocatable :: lapla_pot

  pi=4.0_dp*atan(1.0_dp)
  n01=kernel%grid%m1
  n02=kernel%grid%m3
  n03=kernel%grid%m2
  !starting point in third direction
  i3s=kernel%grid%istart+1

  nabla_pot=f_malloc([n01,n02,n03,3],id='nabla_pot')
  lapla_pot=f_malloc([n01,n02,n03],id='lapla_pot')
  !calculate derivative of the potential

  call nabla_u(kernel%mesh,pot,nabla_pot,kernel%diel%nord)
  call div_u_i(kernel%mesh,nabla_pot,lapla_pot,kernel%diel%nord)
  i23=1
  do i3=i3s,i3s+kernel%grid%n3p-1!kernel%mesh%ndims(3)
     do i2=1,n02
        do i1=1,n01
           !this section has to be inserted into a optimized calculation of the
           !derivative
           rho_pol(i1,i23)=(-0.25_dp/pi)*lapla_pot(i1,i2,i3)-rho(i1,i23)
        end do
        i23=i23+1
     end do
  end do

  call f_free(nabla_pot)
  call f_free(lapla_pot)
end subroutine polarization_charge

subroutine EPS_iter_output(iter,normb,normr,ratio,alpha,beta)
  use yaml_output
  use yaml_strings
  implicit none
  integer, intent(in) :: iter
  real(dp), intent(in) :: normb,normr,ratio,beta,alpha
  !local variables
  character(len=*), parameter :: vrb='(1pe25.17)'!'(1pe16.4)'

  !call yaml_newline()
  call yaml_mapping_open('Iteration quality',flow=.true.)
  if (beta /= 0.0_dp) call yaml_comment('GPS Iteration '+iter,hfill='_')
  !write the PCG iteration
  call yaml_map('iter',iter,fmt='(i4)')
  !call yaml_map('rho_norm',normb)
  if (normr/=0.0_dp) call yaml_map('res',normr,fmt=vrb)
  if (ratio /= 0.0_dp) call yaml_map('ratio',ratio,fmt=vrb)
  if (alpha /= 0.0_dp) call yaml_map('alpha',alpha,fmt=vrb)
  if (beta /= 0.0_dp) call yaml_map('beta',beta,fmt=vrb)

  call yaml_mapping_close()
end subroutine EPS_iter_output

!> Plot in different files the available information related to the coulomb operator.
!! The results is adapted to the actual setup of the calculation.
subroutine PS_dump_coulomb_operator(kernel,prefix)
  use IObox
  use yaml_output
  use f_enums
  use dynamic_memory
  use psolver_environment
  use PSbox
  implicit none
  type(coulomb_operator), intent(in) :: kernel
  character(len=*), intent(in) :: prefix
  !local variables
  logical :: master
  real(dp), dimension(:,:,:), allocatable :: global_arr

  master=kernel%mpi_env%iproc==0 .and. kernel%mpi_env%igroup==0

  !if available plot the dielectric function
  if (kernel%method /= 'VAC') then
     if (master) call yaml_map('Writing dielectric cavity in file','dielectric_cavity')
     global_arr = f_malloc(kernel%mesh%ndims,id='global_arr')
     call PS_gather(src=kernel%diel%eps,dest=global_arr,mpi_env=kernel%mpi_env,grid=kernel%grid)
     if (kernel%method .hasattr. PS_RIGID_ENUM) then
        !we might add the atoms in the case of a rigid cavity, they are in
        call dump_field(trim(prefix)//'dielectric_cavity',&
             kernel%mesh,1,global_arr,rxyz=kernel%diel%rxyz)
     else
        !charge dependent case
        call dump_field(trim(prefix)//'dielectric_cavity',&
             kernel%mesh,1,global_arr)
     end if
     !now check if the polarization charge is available
     if (associated(kernel%arr%rho_pol)) then
        call PS_gather(src=kernel%arr%rho_pol,dest=global_arr,mpi_env=kernel%mpi_env,grid=kernel%grid)
        call dump_field(trim(prefix)//'polarization_charge',kernel%mesh,1,global_arr)
     end if
     !now check if the ionic charge of the Poisson boltzmann charge is available
     if (associated(kernel%arr%rho_ions)) then
        call PS_gather(src=kernel%arr%rho_ions,dest=global_arr,mpi_env=kernel%mpi_env,grid=kernel%grid)
        call dump_field(trim(prefix)//'solvent_density',kernel%mesh,1,global_arr)
     end if
     call f_free(global_arr)
  end if

end subroutine PS_dump_coulomb_operator

!> Calculate the dimensions needed for the allocation of the arrays
!! related to the Poisson Solver
!!
!! @warning
!!    The XC enlarging due to GGA part is not present for surfaces and
!!    periodic boundary condition. This is related to the fact that the calculation of the
!!    gradient and the White-Bird correction are not yet implemented for non-isolated systems
!! @todo
!!    This routine should be separated in the inner part and the outer part responsible of the gradient calculation
!! @author Luigi Genovese
!! @date February 2007
subroutine PS_dim4allocation(geocode,datacode,iproc,nproc,n01,n02,n03,use_gradient,use_wb_corr,&
     igpu,n3d,n3p,n3pi,i3xcsh,i3s)
  use PStypes
  use dictionaries, only: f_err_throw
   implicit none
   character(len=1), intent(in) :: geocode  !< @copydoc poisson_solver::doc::geocode
   character(len=1), intent(in) :: datacode !< @copydoc poisson_solver::doc::datacode
   integer, intent(in) :: iproc        !< Process Id
   integer, intent(in) :: nproc        !< Number of processes
   integer, intent(in) :: n01,n02,n03  !< Dimensions of the real space grid to be hit with the Poisson Solver
   logical, intent(in) :: use_gradient !< .true. if functional is using the gradient.
   logical, intent(in) :: use_wb_corr  !< .true. if functional is using WB corrections.
   integer, intent(in) :: igpu         !< Is GPU enabled ?
   !> Third dimension of the density. For distributed data, it takes into account
   !! the enlarging needed for calculating the XC functionals.
   !! For global data it is simply equal to n03.
   !! When there are too many processes and there is no room for the density n3d=0
   integer, intent(out) :: n3d
   !> Third dimension for the potential. The same as n3d, but without
   !! taking into account the enlargment for the XC part. For non-GGA XC, n3p=n3d.
   integer, intent(out) :: n3p
   !> Dimension of the pot_ion array, always with distributed data.
   !! For distributed data n3pi=n3p
   integer, intent(out) :: n3pi
   !> Shift of the density that must be performed to enter in the
   !! non-overlapping region. Useful for recovering the values of the potential
   !! when using GGA XC functionals. If the density starts from rhopot(1,1,1),
   !! the potential starts from rhopot(1,1,i3xcsh+1).
   !! For non-GGA XCs and for global distribution data i3xcsh=0
   integer, intent(out) :: i3xcsh
   !> Starting point of the density effectively treated by each processor
   !! in the third direction.
   !! It takes into account also the XC enlarging. The array rhopot will correspond
   !! To the planes of third coordinate from i3s to i3s+n3d-1.
   !! The potential to the planes from i3s+i3xcsh to i3s+i3xcsh+n3p-1
   !! The array pot_ion to the planes from i3s+i3xcsh to i3s+i3xcsh+n3pi-1
   !! For global disposition i3s is equal to distributed case with i3xcsh=0.
   integer, intent(out) :: i3s

   !local variables
   !n(c) integer, parameter :: nordgr=4
   type(FFT_metadata) :: grid
   integer :: istart,iend,nxc,nwb,nxt,nxcl,nxcr,nwbl,nwbr
   integer :: n3pr1,n3pr2


   !calculate the dimensions wrt the geocode
   select case(geocode)
   case('P')
      call new_P_grid(n01,n02,n03,grid,nproc,.false.)
      if (nproc>2*(grid%n3/2+1)-1 .and. .false.) then
         n3pr1=nproc/(grid%n3/2+1)
         n3pr2=grid%n3/2+1
         if ((grid%md2/nproc)*n3pr1*n3pr2 < grid%n2) then
            grid%md2=(grid%md2/nproc+1)*nproc
         endif
      endif
   case('S')
      call new_S_grid(n01,n02,n03,grid,nproc,igpu,.false.)
      if (nproc>2*(grid%n3/2+1)-1 .and. .false.) then
         n3pr1=nproc/(grid%n3/2+1)
         n3pr2=grid%n3/2+1
         if ((grid%md2/nproc)*n3pr1*n3pr2 < grid%n2) then
            grid%md2=(grid%md2/nproc+1)*nproc
         endif
      endif
   case('F','H')
      call new_F_grid(n01,n02,n03,grid,nproc,igpu,.false.)
      if (nproc>2*(grid%n3/2+1)-1 .and. .false.) then
         n3pr1=nproc/(grid%n3/2+1)
         n3pr2=grid%n3/2+1
         if ((grid%md2/nproc)*n3pr1*n3pr2 < grid%n2/2) then
            grid%md2=(grid%md2/nproc+1)*nproc
         endif
      endif
   case('W')
      call new_W_grid(n01,n02,n03,grid,nproc,igpu,.false.)
      if (nproc>2*(grid%n3/2+1)-1 .and. .false.) then
         n3pr1=nproc/(grid%n3/2+1)
         n3pr2=grid%n3/2+1
         if ((grid%md2/nproc)*n3pr1*n3pr2 < grid%n2) then
            grid%md2=(grid%md2/nproc+1)*nproc
         endif
      endif
   case default
      !write(*,*) geocode
      !stop 'PS_dim4allocation: geometry code not admitted'
      call f_err_throw('Geometry code "'//geocode//'" not admitted in PS_dim4allocation')
   end select

   !formal start and end of the slice
   istart=iproc*(grid%md2/nproc)
   iend=min((iproc+1)*grid%md2/nproc,grid%m2)

!this second part of the routine is of interest only for the XC part to be in agreement with Hattree potential distribution
   select case(datacode)
   case('D')
      call xc_dimensions(geocode,use_gradient,use_wb_corr,istart,iend,grid%m2,nxc,nxcl,nxcr,nwbl,nwbr,i3s,i3xcsh)

      nwb=nxcl+nxc+nxcr-2
      nxt=nwbr+nwb+nwbl

      n3p=nxc
      n3d=nxt
      n3pi=n3p
   case('G')
      n3d=n03
      n3p=n03
      i3xcsh=0
      i3s=min(istart,grid%m2-1)+1
      n3pi=max(iend-istart,0)
   case default
      !print *,datacode
      !stop 'PS_dim4allocation: data code not admitted'
      call f_err_throw('data code "'//datacode//'" not admitted in PS_dim4allocation')
   end select

!!  print *,'P4,iproc',iproc,'nxc,ncxl,ncxr,nwbl,nwbr',nxc,nxcl,nxcr,nwbl,nwbr,&
!!       'ixc,n3d,n3p,i3xcsh,i3s',ixc,n3d,n3p,i3xcsh,i3s

END SUBROUTINE PS_dim4allocation


!> Calculate the dimensions to be used for the XC part, taking into account also
!! the White-bird correction which should be made for some GGA functionals
!!dimension for exchange-correlation (different in the global or distributed case)
!!let us calculate the dimension of the portion of the rho array to be passed
!!to the xc routine
!!this portion will depend on the need of calculating the gradient or not,
!!and whether the White-Bird correction must be inserted or not
!!(absent only in the LB ixc=13 case)
!
!!nxc is the effective part of the third dimension that is being processed
!!nxt is the dimension of the part of rho that must be passed to the gradient routine
!!nwb is the dimension of the part of rho in the wb-postprocessing routine
!!note: nxc <= nwb <= nxt
!!the dimension are related by the values of nwbl and nwbr
!!      nxc+nxcl+nxcr-2 = nwb
!!      nwb+nwbl+nwbr = nxt
!!
!! @warning It is imperative that iend <=m2
subroutine xc_dimensions(geocode,use_gradient,use_wb_corr,&
     & istart,iend,m2,nxc,nxcl,nxcr,nwbl,nwbr,i3s,i3xcsh)
  implicit none

  character(len=1), intent(in) :: geocode !< @copydoc poisson_solver::doc::geocode
  logical, intent(in) :: use_gradient     !< .true. if functional is using the gradient.
  logical, intent(in) :: use_wb_corr      !< .true. if functional is using WB corrections.
  integer, intent(in) :: istart,iend
  integer, intent(in) :: m2               !< dimension to be parallelised
  integer, intent(out) :: nxc             !< size of the parallelised XC potential
  integer, intent(out) :: nxcl,nxcr       !< left and right buffers for calculating the WB correction after call drivexc
  integer, intent(out) :: nwbl,nwbr       !< left and right buffers for calculating the gradient to pass to drivexc
  integer, intent(out) :: i3s             !< starting addres of the distributed dimension
  integer, intent(out) :: i3xcsh          !< shift to be applied to i3s for having the striting address of the potential
  !local variables
  integer, parameter :: nordgr=4 !the order of the finite-difference gradient (fixed)

  if (istart <= m2-1) then
     nxc=iend-istart
     if (use_gradient .and. geocode == 'F') then
        if (.not. use_wb_corr) then
           !now the dimension of the part required for the gradient
           nwbl=min(istart,nordgr)
           nwbr=min(m2-iend,nordgr) !always m2 < iend
           nxcl=1
           nxcr=1
        else
           !now the dimension of the part required for the gradient
           if(istart<=nordgr) then
              nxcl=istart+1
              nwbl=0
           else
              nxcl=nordgr+1
              nwbl=min(nordgr,istart-nordgr)
           end if
           if(iend>=m2-nordgr+1) then
              nxcr=m2-iend+1
              nwbr=0
           else
              nxcr=nordgr+1
              nwbr=min(nordgr,m2-nordgr-iend)
           end if
        end if
     else if (geocode /= 'F' .and. use_gradient .and. nxc /= m2) then
        if (.not. use_wb_corr) then
           !now the dimension of the part required for the gradient
           nwbl=nordgr
           nwbr=nordgr
           nxcl=1
           nxcr=1
        else
           nxcl=nordgr+1
           nwbl=nordgr
           nxcr=nordgr+1
           nwbr=nordgr
        end if
     !this case is also considered below
     !else if (geocode /= 'F' .and. use_gradient .and. nxc == m2) then
     else
        nwbl=0
        nwbr=0
        nxcl=1
        nxcr=1
     end if
     i3xcsh=nxcl+nwbl-1
     i3s=istart+1-i3xcsh
  else
     nwbl=0
     nwbr=0
     nxcl=1
     nxcr=1
     nxc=0
     i3xcsh=0
     i3s=m2
  end if
END SUBROUTINE xc_dimensions

!> 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 P_FFT_dimensions(n01,n02,n03,m1,m2,m3,n1,n2,n3,md1,md2,md3,nd1,nd2,nd3,nproc,enlarge_md2)
  use PStypes
  implicit none
  !Arguments
  logical, intent(in) :: enlarge_md2
  integer, intent(in) :: n01,n02,n03   !< original real dimensions (input)
  integer, intent(in) :: nproc
  integer, intent(out) :: m1,m2,m3     !< original real dimension, with m2 and m3 exchanged
  integer, intent(out) :: n1,n2,n3     !< the first FFT dimensions (even for the moment - the medium point being n/2+1)
  integer, intent(out) :: md1,md2,md3  !< the n1,n2,n3 dimensions. They contain the real unpadded space.
  !! md2 is further enlarged to be a multiple of nproc
  integer, intent(out) :: nd1,nd2,nd3  !< Fourier dimensions for which the kernel is injective,

  type(FFT_metadata) :: grid

  call new_P_grid(n01,n02,n03,grid,nproc,enlarge_md2)
  m1 = grid%m1
  m2 = grid%m2
  m3 = grid%m3
  n1 = grid%n1
  n2 = grid%n2
  n3 = grid%n3
  md1 = grid%md1
  md2 = grid%md2
  md3 = grid%md3
  nd1 = grid%nd1
  nd2 = grid%nd2
  nd3 = grid%nd3
END SUBROUTINE P_FFT_dimensions


!> 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 S_FFT_dimensions(n01,n02,n03,m1,m2,m3,n1,n2,n3,md1,md2,md3,nd1,nd2,nd3,nproc,gpu,enlarge_md2,non_ortho)
  use PStypes
  implicit none
  logical, intent(in) :: enlarge_md2
  integer, intent(in) :: n01,n02,n03,nproc,gpu
  integer, intent(out) :: m1,m2,m3,n1,n2,n3,md1,md2,md3,nd1,nd2,nd3
  logical, intent(in), optional :: non_ortho
  type(FFT_metadata) :: grid

  call new_S_grid(n01,n02,n03,grid,nproc,gpu,enlarge_md2,non_ortho)
  m1 = grid%m1
  m2 = grid%m2
  m3 = grid%m3
  n1 = grid%n1
  n2 = grid%n2
  n3 = grid%n3
  md1 = grid%md1
  md2 = grid%md2
  md3 = grid%md3
  nd1 = grid%nd1
  nd2 = grid%nd2
  nd3 = grid%nd3
END SUBROUTINE S_FFT_dimensions


!> 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 W_FFT_dimensions(n01,n02,n03,m1,m2,m3,n1,n2,n3,md1,md2,md3,nd1,nd2,nd3,nproc,gpu,enlarge_md2)
  use PStypes
  implicit none
  logical, intent(in) :: enlarge_md2
  integer, intent(in) :: n01,n02,n03,nproc,gpu
  integer, intent(out) :: m1,m2,m3,n1,n2,n3,md1,md2,md3,nd1,nd2,nd3
  type(FFT_metadata) :: grid

  call new_W_grid(n01,n02,n03,grid,nproc,gpu,enlarge_md2)
  m1 = grid%m1
  m2 = grid%m2
  m3 = grid%m3
  n1 = grid%n1
  n2 = grid%n2
  n3 = grid%n3
  md1 = grid%md1
  md2 = grid%md2
  md3 = grid%md3
  nd1 = grid%nd1
  nd2 = grid%nd2
  nd3 = grid%nd3
END SUBROUTINE W_FFT_dimensions


!> 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 F_FFT_dimensions(n01,n02,n03,m1,m2,m3,n1,n2,n3,md1,md2,md3,nd1,nd2,nd3,nproc,gpu,enlarge_md2)
  use PStypes
  implicit none
  !Arguments
  logical, intent(in) :: enlarge_md2
  integer, intent(in) :: n01,n02,n03  !< Original real dimensions
  integer, intent(in) :: nproc,gpu
  integer, intent(out) :: n1,n2       !< The first FFT even dimensions greater that 2*m1, 2*m2
  integer, intent(out) :: n3          !< The double of the first FFT even dimension greater than m3
  !! (improved for the HalFFT procedure)
  integer, intent(out) :: md1,md2,md3 !< Half of n1,n2,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
  integer, intent(out) :: 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
  integer, intent(out) :: m1,m2,m3
  type(FFT_metadata) :: grid

  call new_F_grid(n01,n02,n03,grid,nproc,gpu,enlarge_md2)
  m1 = grid%m1
  m2 = grid%m2
  m3 = grid%m3
  n1 = grid%n1
  n2 = grid%n2
  n3 = grid%n3
  md1 = grid%md1
  md2 = grid%md2
  md3 = grid%md3
  nd1 = grid%nd1
  nd2 = grid%nd2
  nd3 = grid%nd3
END SUBROUTINE F_FFT_dimensions

!>modifies the options of the poisson solver to switch certain options
subroutine PS_set_options(kernel,global_data,calculate_strten,verbose,&
     update_cavity,use_input_guess,cavity_info,cavitation_terms,&
     potential_integral,final_call)
  implicit none
  type(coulomb_operator), intent(inout) :: kernel
  logical, intent(in), optional :: global_data,calculate_strten,verbose
  logical, intent(in), optional :: update_cavity,use_input_guess
  logical, intent(in), optional :: cavity_info,cavitation_terms
  logical, intent(in), optional :: final_call
  real(gp), intent(in), optional :: potential_integral

  if (present(global_data)) then
     if (global_data) then
        kernel%opt%datacode='G'
     else
        kernel%opt%datacode='D'
     end if
  end if
  if (present(calculate_strten)) kernel%opt%calculate_strten=calculate_strten
  if (present(verbose)) then
     if (verbose) then
        kernel%opt%verbosity_level=1
     else
        kernel%opt%verbosity_level=0
     end if
  end if

  if (present(update_cavity   )) kernel%opt%update_cavity=update_cavity
  if (present(use_input_guess )) kernel%opt%use_input_guess=use_input_guess
  if (present(cavity_info     )) kernel%opt%cavity_info=cavity_info
  if (present(cavitation_terms)) kernel%opt%only_electrostatic=.not. cavitation_terms
  if (present(potential_integral)) kernel%opt%potential_integral =potential_integral
  if (present(final_call)) kernel%opt%final_call=final_call

end subroutine PS_set_options

subroutine PS_fill_variables(k,opt,dict)
  use dictionaries
  implicit none
  type(coulomb_operator), intent(inout) :: k
  type(PSolver_options), intent(inout) :: opt
  type(dictionary), pointer :: dict
  !local variables
  type(dictionary), pointer :: lvl,var

  ! Transfer dict values into input_variables structure.
  lvl => dict_iter(dict)
  do while(associated(lvl))
     var => dict_iter(lvl)
     do while(associated(var))
        call PS_input_fill(k,opt,dict_key(lvl),var)
        var => dict_next(var)
     end do
     lvl => dict_next(lvl)
  end do

end subroutine PS_fill_variables

subroutine PS_get_GPU_setup(k,igpu,gpudirect)
  use workarrays, only: GPU_has_plan
  implicit none
  type(coulomb_operator), intent(inout) :: k
  integer, intent(out) :: igpu, gpudirect

  if(k%igpu==1 .and. .not. GPU_has_plan(k%GPU)) then
     igpu=0
  else
     igpu=k%igpu
  end if
  gpudirect=0
  !check that we did not deactivate gpudirect manually
  if(igpu==1 .and. k%use_gpu_direct) gpudirect=1
end subroutine PS_get_GPU_setup

!> Set the dictionary from the input variables
subroutine PS_input_fill(k,opt, level, val)
  use PSbase
  use psolver_environment
  use yaml_output, only: yaml_warning
  use dictionaries
  use numerics
  use f_enums
  use PStypes
  implicit none
  type(coulomb_operator), intent(inout) :: k
  type(PSolver_options), intent(inout) :: opt
  type(dictionary), pointer :: val
  character(len = *), intent(in) :: level
  !local variables
  logical :: dummy_l
  real(gp) :: dummy_d
  !integer, dimension(2) :: dummy_int !<to use as filling for input variables
  real(gp), dimension(2) :: dummy_gp !< to fill the input variables
  !logical, dimension(2) :: dummy_log !< to fill the input variables
  !character(len=256) :: dummy_char
  character(len = max_field_length) :: strn

  if (index(dict_key(val), "_attributes") > 0) return

  select case(trim(level))
  case(KERNEL_VARIABLES)
     select case (trim(dict_key(val)))
     case(SCREENING)
        k%mu=val
     case(ISF_ORDER)
        k%itype_scf=val
     case(STRESS_TENSOR)
        opt%calculate_strten=val
     case DEFAULT
        if (k%mpi_env%iproc==0) &
             call yaml_warning("unknown input key '" // trim(level) // "/" // trim(dict_key(val)) // "'")
     end select
  case (ENVIRONMENT_VARIABLES)
     select case (trim(dict_key(val)))
     case (CAVITY_KEY)
        strn=val

        select case(trim(strn))
        case('vacuum')
           call f_enum_attr(k%method,PS_NONE_ENUM)
        case('soft-sphere')
           call f_enum_attr(k%method,PS_RIGID_ENUM)
        case('sccs')
           call f_enum_attr(k%method,PS_SCCS_ENUM)
        end select
     case (EPSILON_KEY)
        k%cavity%epsilon0=val
     case (EDENSMAXMIN)
        dummy_gp=val
        k%cavity%edensmin=dummy_gp(1)
        k%cavity%edensmax=dummy_gp(2)
     case (DELTA_KEY)
        dummy_d=val
        ! Divided by 4 because both rigid cavities are 4*delta spread
        k%cavity%delta=dummy_d  !0.25_gp*dummy_d
     case (FACT_RIGID)
        k%cavity%fact_rigid=val
     case (CAVITATION)
        dummy_l=val
        opt%only_electrostatic=.not. dummy_l
     case (GAMMAS_KEY)
        dummy_d=val
        k%cavity%gammaS=dummy_d*SurfAU
     case (ALPHAS_KEY)
        dummy_d=val
        k%cavity%alphaS=dummy_d*SurfAU
     case (BETAV_KEY)
        dummy_d=val
        k%cavity%betaV=dummy_d/AU_GPa
     case (GPS_ALGORITHM)
        strn=val
        select case(trim(strn))
        case('SC')
           call f_enum_update(dest=k%method,src=PS_PI_ENUM)
        case('PCG')
           call f_enum_update(dest=k%method,src=PS_PCG_ENUM)
        end select
     case(RADII_SET)
        strn=val
        select case(trim(strn))
        case('UFF')
           k%radii_set=RADII_UFF_ID
        case('Pauling')
           k%radii_set=RADII_PAULING_ID
        case('Bondi')
           k%radii_set=RADII_BONDI_ID
        end select
     case(ATOMIC_RADII)
        if (dict_size(val) > 0) call dict_copy(k%radii_dict,val)
     case (PI_ETA)
        k%PI_eta=val
     case (INPUT_GUESS)
        opt%use_input_guess=val
     case (FD_ORDER)
        k%diel%nord=val
     case (ITERMAX)
        k%max_iter=val
     case (MINRES)
        k%minres=val
     case (PB_METHOD)
        strn=val
        select case(trim(strn))
        case('none')
           call f_enum_attr(k%method,PS_PB_NONE_ENUM)
        case('linear')
           call f_enum_attr(k%method,PS_PB_LINEAR_ENUM)
        case('standard')
           call f_enum_attr(k%method,PS_PB_STANDARD_ENUM)
        case('modified')
           call f_enum_attr(k%method,PS_PB_MODIFIED_ENUM)
        end select
     case (PB_MINRES)
        k%minres_PB=val
     case (PB_ITERMAX)
        k%max_iter_PB=val
     case (PB_INPUT_GUESS)
        opt%use_pb_input_guess=val
     case (PB_ETA)
        k%PB_eta=val
     case DEFAULT
        if (k%mpi_env%iproc==0) &
             call yaml_warning("unknown input key '" // trim(level) // "/" // trim(dict_key(val)) // "'")
     end select
  case (SETUP_VARIABLES)
     select case (trim(dict_key(val)))
     case (ACCEL)
        strn=val
        select case(trim(strn))
        case('CUDA')
           k%igpu=1
        case('none')
           k%igpu=0
        end select
     case (KEEP_GPU_MEMORY)
        opt%keepGPUmemory=val
     case (USE_GPU_DIRECT)
        k%use_gpu_direct=val
     case (TASKGROUP_SIZE_KEY)

     case (GLOBAL_DATA)
        dummy_l=val
        if (dummy_l) then
           opt%datacode='G'
        else
           opt%datacode='D'
        end if
     case (VERBOSITY)
        dummy_l=val
        if (dummy_l) then
           opt%verbosity_level=1
        else
           opt%verbosity_level=0
        end if
     case (OUTPUT)
        !for the moment no treatment, to be added
     case DEFAULT
        if (k%mpi_env%iproc==0) &
             call yaml_warning("unknown input key '" // trim(level) // "/" // trim(dict_key(val)) // "'")
     end select
  case DEFAULT
  end select
END SUBROUTINE PS_input_fill

!>calculate the extra contribution to the forces and the cavitation terms
!!to be given at the end of the calculation
subroutine ps_soft_PCM_forces(kernel,fpcm)
  use psolver_environment
  use box
  use f_utils, only: f_zero
  implicit none
  type(coulomb_operator), intent(in) :: kernel
  real(dp), dimension(3,kernel%diel%nat), intent(inout) :: fpcm
  !local variables
  real(dp), parameter :: thr=1.e-12
  integer :: i1,i2,i3,i23
  real(dp) :: cc,epr,depsr,tt,kk
  type(cell) :: mesh
  real(dp), dimension(3) :: v,dleps,deps
  mesh=kernel%mesh !cell_new(kernel%geocode,kernel%mesh%ndims,kernel%mesh%hgrids)

  do i3=1,kernel%grid%n3p
     v(3)=cell_r(mesh,i3+kernel%grid%istart,dim=3)
     do i2=1,kernel%mesh%ndims(2)
        v(2)=cell_r(mesh,i2,dim=2)
        i23=i2+(i3-1)*kernel%mesh%ndims(2)
        do i1=1,kernel%mesh%ndims(1)
           tt=kernel%diel%oneoeps(i1,i23) !nablapot2(r)
           v(1)=cell_r(mesh,i1,dim=1)
           !this is done to obtain the depsilon
           call rigid_cavity_arrays(kernel%cavity,mesh%dom,v,kernel%diel%nat,&
                kernel%diel%rxyz,kernel%diel%radii,epr,depsr,dleps,cc,kk)
           if (abs(epr-vacuum_eps) < thr) cycle
           deps=dleps*epr
           call rigid_cavity_forces(kernel%opt%only_electrostatic,kernel%cavity,mesh,v,&
                kernel%diel%nat,kernel%diel%rxyz,kernel%diel%radii,epr,tt,fpcm,deps,kk)
        end do
     end do
  end do

end subroutine ps_soft_PCM_forces
