!> @file
!!    Routines to create the kernel for Poisson solver
!! @author
!!    Copyright (C) 2002-2017 BigDFT group  (LG)<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


!!$!> Initialization of the Poisson kernel
!!$function pkernel_init_old(verb,iproc,nproc,igpu,geocode,ndims,hgrids,itype_scf,&
!!$     alg,cavity,mu0_screening,angrad,mpi_env,taskgroup_size) result(kernel)
!!$  use yaml_output
!!$  use yaml_strings, only: f_strcpy
!!$  use f_precisions, only: f_loc
!!$  implicit none
!!$  logical, intent(in) :: verb       !< Verbosity
!!$  integer, intent(in) :: itype_scf  !< Type of interpolating scaling function
!!$  integer, intent(in) :: iproc      !< Proc Id
!!$  integer, intent(in) :: nproc      !< Number of processes
!!$  integer, intent(in) :: igpu
!!$  character(len=1), intent(in) :: geocode !< @copydoc poisson_solver::doc::geocode
!!$  integer, dimension(3), intent(in) :: ndims
!!$  real(gp), dimension(3), intent(in) :: hgrids
!!$  !> algorithm of the Solver. Might accept the values "VAC" (default), "PCG", or "PI"
!!$  character(len=*), intent(in), optional :: alg
!!$  !> cavity used, possible values "none" (default), "rigid", "sccs"
!!$  character(len=*), intent(in), optional :: cavity
!!$  real(kind=8), intent(in), optional :: mu0_screening
!!$  real(gp), dimension(3), intent(in), optional :: angrad
!!$  type(mpi_environment), intent(in), optional :: mpi_env
!!$  integer, intent(in), optional :: taskgroup_size
!!$  type(coulomb_operator) :: kernel
!!$  !local variables
!!$  real(dp) :: alphat,betat,gammat,mu0t
!!$  integer :: nthreads,group_size
!!$  !integer :: ierr
!!$  !$ integer :: omp_get_max_threads
!!$
!!$
!!$  !nullification
!!$  kernel=pkernel_null()
!!$
!!$  !geocode and ISF family
!!$!  kernel%geocode=geocode
!!$  !dimensions and grid spacings
!!$!  kernel%ndims=ndims
!!$!  kernel%hgrids=hgrids
!!$
!!$  if (present(angrad)) then
!!$!     kernel%angrad=angrad
!!$  else
!!$     alphat = 2.0_dp*datan(1.0_dp)
!!$     betat = 2.0_dp*datan(1.0_dp)
!!$     gammat = 2.0_dp*datan(1.0_dp)
!!$!     kernel%angrad=(/alphat,betat,gammat/)
!!$  end if
!!$
!!$
!!$  !old approach of input variables, before dictionary
!!$  if (.not. present(mu0_screening)) then
!!$     mu0t=0.0_gp
!!$  else
!!$     mu0t=mu0_screening
!!$  end if
!!$
!!$
!!$
!!$  kernel%mu=mu0t
!!$
!!$  if (present(alg)) then
!!$     select case(trim(alg))
!!$     case('VAC')
!!$        kernel%method=PS_VAC_ENUM
!!$     case('PI')
!!$        kernel%method=PS_PI_ENUM
!!$        kernel%nord=16
!!$        !here the parameters can be specified from command line
!!$        kernel%max_iter=50
!!$        kernel%minres=1.0e-8_dp!
!!$        kernel%PI_eta=0.6_dp
!!$     case('PCG')
!!$        kernel%method=PS_PCG_ENUM
!!$        kernel%nord=16
!!$        kernel%max_iter=50
!!$        kernel%minres=1.0e-8_dp!
!!$     case default
!!$        call f_err_throw('Error, kernel algorithm '//trim(alg)//&
!!$             'not valid')
!!$     end select
!!$  else
!!$     kernel%method=PS_VAC_ENUM
!!$  end if
!!$
!!$  if (present(cavity)) then
!!$     select case(trim(cavity))
!!$     case('vacuum')
!!$        call f_enum_attr(kernel%method,PS_NONE_ENUM)
!!$     case('rigid')
!!$        call f_enum_attr(kernel%method,PS_RIGID_ENUM)
!!$     case('sccs')
!!$        call f_enum_attr(kernel%method,PS_SCCS_ENUM)
!!$     case default
!!$        call f_err_throw('Error, cavity method '//trim(cavity)//&
!!$             ' not valid')
!!$     end select
!!$  else
!!$     call f_enum_attr(kernel%method,PS_NONE_ENUM)
!!$  end if
!!$
!!$  kernel%itype_scf=itype_scf
!!$
!!$
!!$  !gpu acceleration
!!$  kernel%igpu=igpu
!!$
!!$  kernel%initCufftPlan = 1
!!$  kernel%keepGPUmemory = 1
!!$  kernel%keepzf = 1
!!$
!!$  if (iproc == 0 .and. verb) then
!!$     if (mu0t==0.0_gp) then
!!$        call yaml_comment('Kernel Initialization',hfill='-')
!!$        call yaml_mapping_open('Poisson Kernel Initialization')
!!$     else
!!$        call yaml_mapping_open('Helmholtz Kernel Initialization')
!!$         call yaml_map('Screening Length (AU)',1/mu0t,fmt='(g25.17)')
!!$     end if
!!$  end if
!!$
!!$  group_size=nproc
!!$  if (present(taskgroup_size)) then
!!$     !if the taskgroup size is not a divisor of nproc do not create taskgroups
!!$     if (nproc >1 .and. taskgroup_size > 0 .and. taskgroup_size < nproc .and.&
!!$          mod(nproc,taskgroup_size)==0) then
!!$        group_size=taskgroup_size
!!$     end if
!!$  end if
!!$
!!$  !import the mpi_environment if present
!!$  if (present(mpi_env)) then
!!$     call copy_mpi_environment(src=mpi_env,dest=kernel%mpi_env)
!!$     !ernel%mpi_env=mpi_env
!!$  else
!!$     call mpi_environment_set(kernel%mpi_env,iproc,nproc,MPI_COMM_WORLD,group_size)
!!$  end if
!!$
!!$  !gpu can be used only for one nproc
!!$  if (nproc > 1) kernel%igpu=0
!!$
!!$  !-------------------
!!$  nthreads=0
!!$  if (kernel%mpi_env%iproc == 0 .and. kernel%mpi_env%igroup == 0 .and. verb) then
!!$     !$ nthreads = omp_get_max_threads()
!!$     call yaml_map('MPI tasks',kernel%mpi_env%nproc)
!!$     if (nthreads /=0) call yaml_map('OpenMP threads per MPI task',nthreads)
!!$     if (kernel%igpu==1) call yaml_map('Kernel copied on GPU',.true.)
!!$     if (kernel%method /= 'VAC') call yaml_map('Iterative method for Generalised Equation',toa(kernel%method))
!!$     if (kernel%method .hasattr. PS_RIGID_ENUM) call yaml_map('Cavity determination','rigid')
!!$     if (kernel%method .hasattr. PS_SCCS_ENUM) call yaml_map('Cavity determination','sccs')
!!$     call yaml_mapping_close() !kernel
!!$  end if
!!$
!!$end function pkernel_init_old

pure function pkernel_null() result(k)
  use box
  use workarrays
  use f_enums
  use wrapper_MPI
  use psolver_environment
  use PStypes
  implicit none
  type(coulomb_operator) :: k
  k%itype_scf=0
  !    k%geocode='F'
  call nullify_f_enum(k%method)
  k%cavity=cavity_default()
  k%opt=PSolver_options_null()
  k%mu=0.0_gp
  k%mesh=cell_null()
  !    k%ndims=(/0,0,0/)
  !    k%hgrids=(/0.0_gp,0.0_gp,0.0_gp/)
  nullify(k%kernel)
  call nullify_work_arrays(k%w)
  call nullify_GPU_workarrays(k%GPU)
  call nullify_PCG_GPU_workarrays(k%PCG_GPU)
  call nullify_dielectric_arrays(k%diel)
  call nullify_grid_observables(k%arr)
  call nullify_mpi_environment(k%mpi_env)
  call nullify_mpi_environment(k%inplane_mpi)
  call nullify_mpi_environment(k%part_mpi)
  call nullify_FFT_metadata(k%grid)
  k%igpu=0
  k%use_gpu_direct=.false.
  k%keepzf=1
  k%max_iter=0
  k%PI_eta=0.0_dp
  k%minres=0.0_dp
  k%minres_PB=0.0_dp
  k%radii_set=0
  nullify(k%radii_dict)
end function pkernel_null

!> Free memory used by the kernel operation and all workarrays.
subroutine pkernel_free(kernel)
  use dictionaries, only: dict_free
  use PStypes
  use workarrays
  use dynamic_memory
  use wrapper_MPI
  implicit none
  type(coulomb_operator), intent(inout) :: kernel
  call dict_free(kernel%radii_dict)
  call f_free_ptr(kernel%kernel)
  call free_FFT_metadata(kernel%grid)
  call free_dielectric_arrays(kernel%diel)
  call free_grid_observables(kernel%arr)
  if(kernel%keepzf == 1) call free_PS_workarrays(kernel%w)
  !free GPU data
  call free_PCG_GPU_workarrays(kernel%PCG_GPU)
  if (kernel%igpu == 1) then
     if (kernel%mpi_env%iproc == 0) then
        call free_GPU_workarrays(kernel%GPU)
     endif
  end if
  call release_mpi_environment(kernel%inplane_mpi)
  call release_mpi_environment(kernel%part_mpi)
  call release_mpi_environment(kernel%mpi_env)
end subroutine pkernel_free

!> Initialization of the Poisson kernel starting from the box and boundary
!! conditions data.
!function pkernel_init(iproc,nproc,dict,geocode,ndims,hgrids,alpha_bc,beta_ac,gamma_ab,mpi_env) result(kernel)
function pkernel_init(iproc,nproc,dict,dom,ndims,hgrids,alpha_bc,beta_ac,gamma_ab,mpi_env) result(kernel)
  use yaml_output
  use dictionaries
  use numerics
  use wrapper_MPI
  use f_enums
  use psolver_environment
  use box, only: cell_new
  use f_input_file, only: input_file_dump
  use at_domain
  use PStypes
  implicit none
  integer, intent(in) :: iproc      !< Proc Id
  integer, intent(in) :: nproc      !< Number of processes
  type(dictionary), pointer :: dict !< dictionary of the input variables
  !character(len=1), intent(in) :: geocode !< @copydoc poisson_solver::doc::geocode
  type(domain), intent(in) :: dom !< data type for the simulation domain
  integer, dimension(3), intent(in) :: ndims
  real(gp), dimension(3), intent(in) :: hgrids
  real(gp), intent(in), optional :: alpha_bc,beta_ac,gamma_ab
  type(mpi_environment), intent(in), optional :: mpi_env
  type(coulomb_operator) :: kernel
  !local variables
  integer :: nthreads,group_size,taskgroup_size
  !$ integer :: omp_get_max_threads

  !nullification
  kernel=pkernel_null()

  !mesh initialization
  !kernel%mesh=cell_new(geocode,ndims,hgrids,alpha_bc,beta_ac,gamma_ab)
  !dom=domain_new(units=ATOMIC_UNITS,bc=geocode_to_bc_enum(geocode),&
  !          alpha_bc=alpha_bc,beta_ac=beta_ac,gamma_ab=gamma_ab,acell=ndims*hgrids)


  kernel%mesh=cell_new(dom,ndims,hgrids)

  !new treatment for the kernel input variables
  kernel%method=PS_VAC_ENUM
  if (DICT_COMPLETED .notin. dict) call PS_input_dict(dict) !complete the dictionary

  call PS_fill_variables(kernel,kernel%opt,dict) !fill the structure with basic results

  kernel%keepzf=1

  !import the mpi_environment if present
  if (present(mpi_env)) then
     call copy_mpi_environment(src=mpi_env,dest=kernel%mpi_env)
  else

     !specialized treatment
     taskgroup_size=dict//SETUP_VARIABLES//TASKGROUP_SIZE_KEY

     group_size=nproc
     !if the taskgroup size is not a divisor of nproc do not create taskgroups
     if (taskgroup_size > 0) then
       if (nproc >1 .and. taskgroup_size < nproc .and.&
            mod(nproc,taskgroup_size)==0) then
          group_size=taskgroup_size
       end if
     end if
     call mpi_environment_set(kernel%mpi_env,iproc,nproc,mpiworld(),group_size)
  end if

  !gpu can be used only for one nproc
  if (nproc > 1) kernel%igpu=0

  !-------------------
  nthreads=0
  if (kernel%mpi_env%iproc == 0 .and. kernel%mpi_env%igroup == 0 .and. kernel%opt%verbosity_level==1) then
     if (kernel%mu==0.0_gp) then
        call yaml_comment('Kernel Initialization',hfill='-')
        call yaml_mapping_open('Poisson Kernel Initialization')
     else
        call yaml_mapping_open('Helmholtz Kernel Initialization')
        call yaml_map('Screening Length (AU)',1.0_gp/kernel%mu,fmt='(g25.17)')
     end if
     !we might also perform an input_file dump if needed
     call input_file_dump(dict)
     !$ nthreads = omp_get_max_threads()
     call yaml_map('MPI tasks',kernel%mpi_env%nproc)
     if (nthreads /=0) call yaml_map('OpenMP threads per MPI task',nthreads)
     if (kernel%igpu==1) call yaml_map('Kernel copied on GPU',.true.)
     if (kernel%method /= 'VAC') call yaml_map('Iterative method for Generalised Equation',toa(kernel%method))
     if (kernel%method .hasattr. PS_RIGID_ENUM) call yaml_map('Cavity determination','rigid')
     if (kernel%method .hasattr. PS_SCCS_ENUM) call yaml_map('Cavity determination','sccs')
     call yaml_mapping_close() !kernel
  end if

end function pkernel_init

!> Allocate a pointer which corresponds to the zero-padded FFT slice needed for
!! calculating the convolution with the kernel expressed in the interpolating scaling
!! function basis. The kernel pointer is unallocated on input, allocated on output.
subroutine pkernel_set(kernel,eps,dlogeps,oneoeps,oneosqrteps,corr,verbose) !optional arguments
  use yaml_output
  use dynamic_memory
  use time_profiling, only: f_timing
  use dictionaries, only: f_err_throw
  use yaml_strings, only: operator(+), yaml_toa
  use numerics
  use workarrays
  use PStypes
  use f_enums
  use wrapper_MPI
  !use box
  use at_domain, only: domain_geocode, domain_periodic_dims
  implicit none
  !Arguments
  type(coulomb_operator), intent(inout) :: kernel
  !> dielectric function. Needed for non VAC methods, given in full dimensions
  real(dp), dimension(:,:,:), intent(in), optional :: eps
  !> logarithmic derivative of epsilon. Needed for SC method.
  !! if absent, it will be calculated from the array of epsilon
  real(dp), dimension(:,:,:,:), intent(in), optional :: dlogeps
  !> inverse of epsilon. Needed for the SC method.
  !! if absent, it will be calculated from the array of epsilon
  real(dp), dimension(:,:,:), intent(in), optional :: oneoeps
  !> inverse square root of epsilon. Needed for PCG method.
  !! if absent, it will be calculated from the array of epsilon
  real(dp), dimension(:,:,:), intent(in), optional :: oneosqrteps
  !> correction term for the PCG method (represents q(r) of equation (16)
  !! in Fisicaro J. Chem. Phys. 144, 014103 (2016)).
  !! if absent, it will be calculated from the array of epsilon
  real(dp), dimension(:,:,:), intent(in), optional :: corr
  logical, intent(in), optional :: verbose
  !local variables
  character(len=1) :: geocode
  logical :: dump,wrtmsg
  character(len=*), parameter :: subname='createKernel'
  integer :: i_stat
  integer :: nlimd,nlimk
  real(kind=8) :: mu0t
  real(kind=8), dimension(:), allocatable :: pkernel2
  integer :: i1,i2,i3,j1,j2,j3,ind,indt,size2,sizek,kernelnproc,size3
  integer :: n3pr1,n3pr2,n1,n23
  integer :: myiproc_node, mynproc_node
  integer,dimension(3) :: n
  real(dp) :: p1,p2,mu3,ker
  logical, dimension(3) :: per
  logical :: initCufftPlan, gpuPCGRed !< control if GPU can be used for PCG reductions
  !call timing(kernel%mpi_env%iproc+kernel%mpi_env%igroup*kernel%mpi_env%nproc,'PSolvKernel   ','ON')
  call f_timing(TCAT_PSOLV_KERNEL,'ON')
  call f_routine(id='pkernel_set')
  !pi=4.0_dp*atan(1.0_dp)
  wrtmsg=.true.
  if (present(verbose)) wrtmsg=verbose

  dump=wrtmsg .and. kernel%mpi_env%iproc+kernel%mpi_env%igroup==0

  mu0t=kernel%mu

  if (dump) then
     if (mu0t==0.0_gp) then
        call yaml_mapping_open('Poisson Kernel Creation')
     else
        call yaml_mapping_open('Helmholtz Kernel Creation')
        call yaml_map('Screening Length (AU)',1/mu0t,fmt='(g25.17)')
     end if
  end if

  kernelnproc=kernel%mpi_env%nproc
  if (kernel%igpu == 1) kernelnproc=1

  geocode=domain_geocode(kernel%mesh%dom)

  select case(geocode)
     !if (kernel%geocode == 'P') then
  case('P')

     if (dump) then
        call yaml_map('Boundary Conditions','Periodic')
     end if
     call new_P_grid(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3),&
          kernel%grid,kernel%mpi_env%nproc,.false.)

     if (kernel%igpu > 0) then
       kernel%kernel = f_malloc_ptr((kernel%grid%n1/2+1)*kernel%grid%n2*kernel%grid%n3/kernelnproc,id='kernel%kernel')
     else
        if (mod(kernel%grid%nd3,kernelnproc) /= 0) &
             call f_err_throw('Parallel convolution:ERROR:nd3')
       kernel%kernel = f_malloc_ptr(kernel%grid%nd1*kernel%grid%nd2*kernel%grid%nd3/kernelnproc,id='kernel%kernel')
     endif
     !!! PSolver n1-n2 plane mpi partitioning !!!
     call inplane_partitioning(kernel%mpi_env,kernel%grid%md2,kernel%grid%n2, &
          kernel%grid%n3/2+1,kernel%part_mpi,kernel%inplane_mpi,n3pr1,n3pr2)
!!$     if (kernel%mpi_env%nproc>2*(n3/2+1)-1) then
!!$       n3pr1=kernel%mpi_env%nproc/(n3/2+1)
!!$       n3pr2=n3/2+1
!!$       md2plus=.false.
!!$       if ((md2/kernel%mpi_env%nproc)*n3pr1*n3pr2 < n2) then
!!$           md2plus=.true.
!!$       endif
!!$
!!$       if (kernel%mpi_env%iproc==0 .and. n3pr1>1) call yaml_map('PSolver n1-n2 plane mpi partitioning activated:',&
!!$          trim(yaml_toa(n3pr1,fmt='(i5)'))//' x'//trim(yaml_toa(n3pr2,fmt='(i5)'))//&
!!$          ' taskgroups')
!!$       if (kernel%mpi_env%iproc==0 .and. md2plus) &
!!$            call yaml_map('md2 was enlarged for PSolver n1-n2 plane mpi partitioning, md2=',md2)
!!$
!!$       !!$omp master !commented out, no parallel region
!!$       if (n3pr1>1) call mpi_environment_set1(kernel%inplane_mpi,kernel%mpi_env%iproc,kernel%mpi_env%nproc, &
!!$                                             kernel%mpi_env%mpi_comm,n3pr1,n3pr2)
!!$       !!$omp end master
!!$       !!$omp barrier
!!$     else
!!$       n3pr1=1
!!$       n3pr2=kernel%mpi_env%nproc
!!$     endif
!!$
!!$     !!$omp master
!!$     call mpi_environment_set(kernel%part_mpi,kernel%mpi_env%iproc,kernel%mpi_env%nproc,kernel%mpi_env%mpi_comm,n3pr2)
!!$     !!$omp end master
!!$     !!$omp barrier

     ! n3pr1, n3pr2 are sent to Free_Kernel subroutine below
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     call Periodic_Kernel(kernel%grid%n1,kernel%grid%n2,kernel%grid%n3, &
          kernel%grid%nd1,kernel%grid%nd2,kernel%grid%nd3,&
          kernel%mesh%hgrids(1),kernel%mesh%hgrids(2),kernel%mesh%hgrids(3),&
          kernel%itype_scf,kernel%kernel,kernel%mpi_env%iproc,kernelnproc,&
          !mu0t,alphat,betat,gammat,&
          n3pr2,n3pr1)

     nlimd=kernel%grid%n2
     nlimk=kernel%grid%n3/2+1

     !no powers of hgrid because they are incorporated in the plane wave treatment
     kernel%grid%scal=1.0_dp/(real(kernel%grid%n1,dp)*real(kernel%grid%n2*kernel%grid%n3,dp)) !to reduce chances of integer overflow


  !else if (kernel%geocode == 'S') then
  case('S')

     if (dump) then
        call yaml_map('Boundary Conditions','Surface')
     end if
     !Build the Kernel
     call new_S_grid(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3),&
          kernel%grid,kernel%mpi_env%nproc,&
          kernel%igpu,.false.,non_ortho=.not. kernel%mesh%dom%orthorhombic)


     if (kernel%igpu > 0) then
       kernel%kernel = f_malloc_ptr((kernel%grid%n1/2+1)*kernel%grid%n2*kernel%grid%n3/kernelnproc,id='kernel%kernel')
     else
        if (mod(kernel%grid%nd3,kernelnproc) /= 0) &
             call f_err_throw('Parallel convolution:ERROR:nd3')
       kernel%kernel = f_malloc_ptr(kernel%grid%nd1*kernel%grid%nd2*kernel%grid%nd3/kernelnproc,id='kernel%kernel')
     endif

     !!! PSolver n1-n2 plane mpi partitioning !!!
     call inplane_partitioning(kernel%mpi_env,kernel%grid%md2,kernel%grid%n2, &
          kernel%grid%n3/2+1,kernel%part_mpi,kernel%inplane_mpi,n3pr1,n3pr2)

!!$     if (kernel%mpi_env%nproc>2*(n3/2+1)-1) then
!!$       n3pr1=kernel%mpi_env%nproc/(n3/2+1)
!!$       n3pr2=n3/2+1
!!$       md2plus=.false.
!!$       if ((md2/kernel%mpi_env%nproc)*n3pr1*n3pr2 < n2) then
!!$           md2plus=.true.
!!$       endif
!!$
!!$       if (kernel%mpi_env%iproc==0 .and. n3pr1>1) &
!!$            call yaml_map('PSolver n1-n2 plane mpi partitioning activated:',&
!!$            trim(yaml_toa(n3pr1,fmt='(i5)'))//' x'//trim(yaml_toa(n3pr2,fmt='(i5)'))//&
!!$            ' taskgroups')
!!$       if (kernel%mpi_env%iproc==0 .and. md2plus) &
!!$            call yaml_map('md2 was enlarged for PSolver n1-n2 plane mpi partitioning, md2=',md2)
!!$
!!$       !$omp master
!!$       if (n3pr1>1) &
!!$            call mpi_environment_set1(kernel%inplane_mpi,kernel%mpi_env%iproc,kernel%mpi_env%nproc, &
!!$            kernel%mpi_env%mpi_comm,n3pr1,n3pr2)
!!$       !$omp end master
!!$       !$omp barrier
!!$     else
!!$       n3pr1=1
!!$       n3pr2=kernel%mpi_env%nproc
!!$     endif
!!$
!!$     !$omp master
!!$     call mpi_environment_set(kernel%part_mpi,kernel%mpi_env%iproc,&
!!$          kernel%mpi_env%nproc,kernel%mpi_env%mpi_comm,n3pr2)
!!$     !$omp end master
!!$     !$omp barrier

     ! n3pr1, n3pr2 are sent to Free_Kernel subroutine below
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


     !the kernel must be built and scattered to all the processes
     call Surfaces_Kernel(kernel%mpi_env%iproc,kernelnproc,&
          kernel%mpi_env%mpi_comm,kernel%inplane_mpi%mpi_comm,&
          kernel%grid%n1,kernel%grid%n2,kernel%grid%n3,&
          kernel%grid%m3,kernel%grid%nd1,kernel%grid%nd2,kernel%grid%nd3,&
          kernel%mesh,&
          kernel%itype_scf,kernel%kernel,mu0t)!,alphat)!,betat,gammat)!,n3pr2,n3pr1)

     !last plane calculated for the density and the kernel
     nlimd=kernel%grid%n2
     nlimk=kernel%grid%n3/2+1

     !only one power of hgrid
     !factor of -4*pi for the definition of the Poisson equation
     kernel%grid%scal=-16.0_dp*atan(1.0_dp)*real(kernel%mesh%hgrids(2),dp)/&
          real(kernel%grid%n1*kernel%grid%n2,dp)/real(kernel%grid%n3,dp)

  !else if (kernel%geocode == 'F') then
  case('F')
     if (dump) then
        call yaml_map('Boundary Conditions','Free')
     end if
!     print *,'debug',kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3),kernel%mesh%hgrids(1),kernel%mesh%hgrids(2),kernel%mesh%hgrids(3)
     !Build the Kernel
     call new_F_grid(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3),&
          kernel%grid,kernel%mpi_env%nproc,kernel%igpu,.false.)

     if (kernel%igpu > 0) then
       kernel%kernel = f_malloc_ptr((kernel%grid%n1/2+1)*kernel%grid%n2*kernel%grid%n3/kernelnproc,id='kernel%kernel')
     else
       !allocate(kernel%kernel(nd1*nd2*nd3/kernelnproc+ndebug),stat=i_stat)
        if (mod(kernel%grid%nd3,kernelnproc) /= 0) &
             call f_err_throw('Parallel convolution:ERROR:nd3')
       kernel%kernel = f_malloc_ptr(kernel%grid%nd1*kernel%grid%nd2*(kernel%grid%nd3/kernelnproc),id='kernel%kernel')
     endif

     !!! PSolver n1-n2 plane mpi partitioning !!!
     call inplane_partitioning(kernel%mpi_env,kernel%grid%md2,kernel%grid%n2/2,&
          kernel%grid%n3/2+1,kernel%part_mpi,kernel%inplane_mpi,n3pr1,n3pr2)
!!$     if (kernel%mpi_env%nproc>2*(n3/2+1)-1) then
!!$       n3pr1=kernel%mpi_env%nproc/(n3/2+1)
!!$       n3pr2=n3/2+1
!!$       md2plus=.false.
!!$       if ((md2/kernel%mpi_env%nproc)*n3pr1*n3pr2 < n2/2) then
!!$           md2plus=.true.
!!$       endif
!!$
!!$       if (kernel%mpi_env%iproc==0 .and. n3pr1>1) call yaml_map('PSolver n1-n2 plane mpi partitioning activated:',&
!!$          trim(yaml_toa(n3pr1,fmt='(i5)'))//' x'//trim(yaml_toa(n3pr2,fmt='(i5)'))//&
!!$          ' taskgroups')
!!$       if (kernel%mpi_env%iproc==0 .and. md2plus) &
!!$            call yaml_map('md2 was enlarged for PSolver n1-n2 plane mpi partitioning, md2=',md2)
!!$
!!$       !$omp master
!!$       if (n3pr1>1) call mpi_environment_set1(kernel%inplane_mpi,kernel%mpi_env%iproc,kernel%mpi_env%nproc, &
!!$                                             kernel%mpi_env%mpi_comm,n3pr1,n3pr2)
!!$       !$omp end master
!!$       !$omp barrier
!!$     else
!!$       n3pr1=1
!!$       n3pr2=kernel%mpi_env%nproc
!!$     endif
!!$     !$omp master
!!$     call mpi_environment_set(kernel%part_mpi,kernel%mpi_env%iproc,kernel%mpi_env%nproc,kernel%mpi_env%mpi_comm,n3pr2)
!!$     !$omp end master
!!$     !$omp barrier

     ! n3pr1, n3pr2 are sent to Free_Kernel subroutine below
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

     !the kernel must be built and scattered to all the processes
     call Free_Kernel(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3),&
          kernel%grid%n1,kernel%grid%n2,kernel%grid%n3,&
          kernel%grid%nd1,kernel%grid%nd2,kernel%grid%nd3,&
          kernel%mesh%hgrids(1),kernel%mesh%hgrids(2),kernel%mesh%hgrids(3),&
          kernel%itype_scf,kernel%mpi_env%iproc,kernelnproc,kernel%kernel,mu0t,n3pr2,n3pr1)

     !last plane calculated for the density and the kernel
     nlimd=kernel%grid%n2/2
     nlimk=kernel%grid%n3/2+1

     !hgrid=max(hx,hy,hz)
     !kernel%grid%scal=product(kernel%mesh%hgrids)/real(n1*n2,dp)/real(n3,dp)
     kernel%grid%scal=kernel%mesh%volume_element/real(kernel%grid%n1*kernel%grid%n2,dp)/real(kernel%grid%n3,dp)

  !else if (kernel%geocode == 'W') then
  case('W')
     if (dump) then
        call yaml_map('Boundary Conditions','Wire')
     end if
     call new_W_grid(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3),&
          kernel%grid,kernel%mpi_env%nproc,kernel%igpu,.false.)

     if (kernel%igpu > 0) then
       kernel%kernel = f_malloc_ptr((kernel%grid%n1/2+1)*kernel%grid%n2*kernel%grid%n3/kernelnproc,id='kernel%kernel')
     else
        if (mod(kernel%grid%nd3,kernelnproc) /= 0) &
             call f_err_throw('Parallel convolution:ERROR:nd3')
       kernel%kernel = f_malloc_ptr(kernel%grid%nd1*kernel%grid%nd2*(kernel%grid%nd3/kernelnproc),id='kernel%kernel')
     endif

     !!! PSolver n1-n2 plane mpi partitioning !!!
     call inplane_partitioning(kernel%mpi_env,kernel%grid%md2,kernel%grid%n2,&
          kernel%grid%n3/2+1,kernel%part_mpi,kernel%inplane_mpi,n3pr1,n3pr2)

!!$     if (kernel%mpi_env%nproc>2*(n3/2+1)-1) then
!!$       n3pr1=kernel%mpi_env%nproc/(n3/2+1)
!!$       n3pr2=n3/2+1
!!$       md2plus=.false.
!!$       if ((md2/kernel%mpi_env%nproc)*n3pr1*n3pr2 < n2) then
!!$           md2plus=.true.
!!$       endif
!!$
!!$       if (kernel%mpi_env%iproc==0 .and. n3pr1>1) call yaml_map('PSolver n1-n2 plane mpi partitioning activated:',&
!!$          trim(yaml_toa(n3pr1,fmt='(i5)'))//' x'//trim(yaml_toa(n3pr2,fmt='(i5)'))//&
!!$          ' taskgroups')
!!$       if (md2plus) call yaml_map('md2 was enlarged for PSolver n1-n2 plane mpi partitioning, md2=',md2)
!!$
!!$       !$omp master
!!$       if (n3pr1>1) call mpi_environment_set1(kernel%inplane_mpi,kernel%mpi_env%iproc,kernel%mpi_env%nproc, &
!!$                                             kernel%mpi_env%mpi_comm,n3pr1,n3pr2)
!!$       !$omp end master
!!$       !$omp barrier
!!$     else
!!$       n3pr1=1
!!$       n3pr2=kernel%mpi_env%nproc
!!$     endif
!!$
!!$     !$omp master
!!$     call mpi_environment_set(kernel%part_mpi,kernel%mpi_env%iproc,kernel%mpi_env%nproc,kernel%mpi_env%mpi_comm,n3pr2)
!!$     !$omp end master
!!$     !$omp barrier
!!$
!!$     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


     call Wires_Kernel(kernel%mpi_env%iproc,kernelnproc,&
          kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3),&
          kernel%grid%n1,kernel%grid%n2,kernel%grid%n3,&
          kernel%grid%nd1,kernel%grid%nd2,kernel%grid%nd3,&
          kernel%mesh%hgrids(1),kernel%mesh%hgrids(2),kernel%mesh%hgrids(3),&
          kernel%itype_scf,kernel%kernel,mu0t)

     nlimd=kernel%grid%n2
     nlimk=kernel%grid%n3/2+1

     !only one power of hgrid
     !factor of -1/(2pi) already included in the kernel definition
     kernel%grid%scal=-2.0_dp*kernel%mesh%hgrids(1)*kernel%mesh%hgrids(2)/&
          real(kernel%grid%n1*kernel%grid%n2,dp)/real(kernel%grid%n3,dp)

  case default
     nlimd = 0
     nlimk = 0
     !if (iproc==0)
     !write(*,'(1x,a,3a)')'createKernel, geocode not admitted',kernel%geocode
     call f_err_throw('createKernel, geocode '//trim(geocode)//&
          'not admitted')
  end select
  !print *,'thereAAA',iproc,nproc,kernel%mpi_env%iproc,kernel%nproc,kernel%mpi_env%mpi_comm
!call MPI_BARRIER(kernel%mpi_env%mpi_comm,ierr)

  if (dump) then
     call grid_dump_layout(kernel%grid, kernel%mpi_env%nproc, nlimd, nlimk)
  end if

  if(kernel%keepzf == 1) then
    if(kernel%igpu /= 1) then
    !  kernel%w%zf = f_malloc_ptr([md1, md3, md2/kernel%mpi_env%nproc],id='zf')
    !else
       kernel%w%zf = f_malloc_ptr([kernel%grid%md1, kernel%grid%md3, &
            2*kernel%grid%md2/kernel%mpi_env%nproc],id='zf')
    end if
  end if

  if (kernel%igpu >0) then
    gpuPCGRed = (trim(toa(kernel%method))=='PCG')
    n(1)=kernel%grid%n1!kernel%mesh%ndims(1)*(2-kernel%geo(1))
    n(2)=kernel%grid%n3!kernel%mesh%ndims(2)*(2-kernel%geo(2))
    n(3)=kernel%grid%n2!kernel%mesh%ndims(3)*(2-kernel%geo(3))


    !perform the estimation of the processors
    call mpinoderanks(kernel%mpi_env%iproc,kernel%mpi_env%nproc,kernel%mpi_env%mpi_comm,&
         myiproc_node,mynproc_node)


    call cuda_estimate_memory_needs(kernel, n, &
         int(mynproc_node,kind=8), initCufftPlan, gpuPCGRed) !LG: why longs?

    size3=kernel%grid%n1*kernel%grid%n2*kernel%grid%n3
    if (gpuPCGRed) then
       kernel%PCG_GPU%used = .true.
       if (kernel%opt%keepGPUmemory) then
          call alloc_PCG_GPU_workarrays(kernel%PCG_GPU, size3, i_stat)
          if (i_stat /= 0) call f_err_throw('error cudamalloc PCG_GPU (GPU out of memory ?) ')
       end if
    end if
   if (kernel%mpi_env%iproc == 0) then
      sizek=(kernel%grid%n1/2+1)*kernel%grid%n2*kernel%grid%n3
      pkernel2 = f_malloc(sizek,id='pkernel2')

      ! transpose kernel for GPU
      do i3=1,kernel%grid%n3
         j3=i3+(i3/(kernel%grid%n3/2+2))*(kernel%grid%n3+2-2*i3)!injective dimension
         mu3=real(j3-1,dp)/real(kernel%grid%n3,dp)
         mu3=(mu3/kernel%mesh%hgrids(2))**2 !beware of the exchanged dimension
         do i2=1,kernel%grid%n2
            j2=i2+(i2/(kernel%grid%n2/2+2))*(kernel%grid%n2+2-2*i2)!injective dimension
            p2=real(j2-1,dp)/real(kernel%grid%n2,dp)
            do i1=1,kernel%grid%n1
               j1=i1+(i1/(kernel%grid%n1/2+2))*(kernel%grid%n1+2-2*i1)!injective dimension
               !injective index
               ind=j1+(j2-1)*kernel%grid%nd1+(j3-1)*kernel%grid%nd1*kernel%grid%nd2
               !unfolded index
               indt=i2+(j1-1)*kernel%grid%n2+(i3-1)*kernel%grid%nd1*kernel%grid%n2
               if (geocode == 'P') then
                  p1=real(j1-1,dp)/real(kernel%grid%n1,dp)
                  ker = pi*((p1/kernel%mesh%hgrids(1))**2+(p2/kernel%mesh%hgrids(3))**2+mu3)+kernel%mu**2/16.0_dp/datan(1.0_dp)
                  pkernel2(indt)=kernel%kernel(ind)/ker
               else
                  pkernel2(indt)=kernel%kernel(ind)
               end if
            end do
         end do
      end do
      !offset to zero
      if (geocode == 'P') pkernel2(1)=0.0_dp

      if (kernel%igpu == 2) kernel%kernel=pkernel2

      if (kernel%igpu == 1) then
         call alloc_GPU_workarrays(kernel%GPU, sizek, geocode, i_stat)
         if (i_stat /= 0) call f_err_throw('error allocating GPU workarrays')
         if (kernel%opt%keepGPUmemory) then
            size2=2*kernel%grid%n1*kernel%grid%n2*kernel%grid%n3
            call alloc_inner_GPU_workarrays(kernel%GPU, size2, size3, i_stat)
            if (i_stat /= 0) call f_err_throw('error allocating inner GPU workarrays')
         end if

         call reset_gpu_data(sizek,pkernel2,kernel%GPU%k)

         if (dump) call yaml_map('Kernel Copied on GPU',.true.)

         if (initCufftPlan) call create_GPU_plans(kernel%GPU, n)
      endif

      call f_free(pkernel2)
   endif

  endif
!print *,'there',iproc,nproc,kernel%iproc,kernel%mpi_env%nproc,kernel%mpi_env%mpi_comm
!call MPI_BARRIER(kernel%mpi_comm,ierr)
!print *,'okcomm',kernel%mpi_comm,kernel%iproc
!call MPI_BARRIER(bigdft_mpi%mpi_comm,ierr)

  if (dump) call yaml_mapping_close() !kernel

  if (kernel%igpu == 0) then
     per = domain_periodic_dims(kernel%mesh%dom)
  !add the checks that are done at the beginning of the Poisson Solver
  if (mod(kernel%grid%n1,2) /= 0 .and. .not. per(1)) &
       call f_err_throw('Parallel convolution:ERROR:n1') !this can be avoided
  if (mod(kernel%grid%n2,2) /= 0 .and. .not. per(3)) &
       call f_err_throw('Parallel convolution:ERROR:n2') !this can be avoided
  if (mod(kernel%grid%n3,2) /= 0 .and. .not. per(2)) &
       call f_err_throw('Parallel convolution:ERROR:n3') !this can be avoided
  if (kernel%grid%nd1 < kernel%grid%n1/2+1) call f_err_throw('Parallel convolution:ERROR:nd1')
  if (kernel%grid%nd2 < kernel%grid%n2/2+1) call f_err_throw('Parallel convolution:ERROR:nd2')
  if (kernel%grid%nd3 < kernel%grid%n3/2+1) call f_err_throw('Parallel convolution:ERROR:nd3')
  !these can be relaxed
!!$  if (kernel%grid%md1 < n1dim) call f_err_throw('Parallel convolution:ERROR:md1')
!!$  if (kernel%grid%md2 < n2dim) call f_err_throw('Parallel convolution:ERROR:md2')
!!$  if (kernel%grid%md3 < n3dim) call f_err_throw('Parallel convolution:ERROR:md3')
  if (mod(kernel%grid%md2,kernel%mpi_env%nproc) /= 0) &
       call f_err_throw('Parallel convolution:ERROR:md2'+ &
    yaml_toa(kernel%mpi_env%nproc)+yaml_toa(kernel%grid%md2))
end if

  call create_rho_distribution(kernel%grid, kernel%mpi_env%iproc, kernel%mpi_env%nproc)
  ! multi-gpu poisson distribution
  if (kernel%igpu == 1 .and. kernel%mpi_env%iproc == 0) then
     call create_GPU_rho_distribution(kernel%GPU, kernel%mpi_env%nproc, &
          kernel%grid%m2, kernel%grid%md1, kernel%grid%md2, kernel%grid%md3)
  end if

  !allocate cavity if needed
  n1=kernel%mesh%ndims(1)
  n23=kernel%mesh%ndims(2)*kernel%grid%n3p

  !>>>>set the treatment of the cavity
  select case(trim(toa(kernel%method)))
  case('PCG')
     call alloc_dielectric_arrays_forPCG(kernel%diel, n1, n23)
     if (present(eps)) then
         if (present(oneosqrteps)) then
            call pkernel_set_epsilon(kernel,eps=eps,oneosqrteps=oneosqrteps)
         else if (present(corr)) then
            call pkernel_set_epsilon(kernel,eps=eps,corr=corr)
         else
            call pkernel_set_epsilon(kernel,eps=eps)
         end if
     else if (present(oneosqrteps) .and. present(corr)) then
         call pkernel_set_epsilon(kernel,oneosqrteps=oneosqrteps,corr=corr)
     else if (present(oneosqrteps) .neqv. present(corr)) then
        call f_err_throw('For PCG method either eps, oneosqrteps and/or corr should be present')
     end if
  case('PI')
     call alloc_dielectric_arrays_forPI(kernel%diel, n1, n23, kernel%mesh%ndims)
     if (present(eps)) then
        if (present(oneoeps)) then
           call pkernel_set_epsilon(kernel,eps=eps,oneoeps=oneoeps)
        else if (present(dlogeps)) then
           call pkernel_set_epsilon(kernel,eps=eps,dlogeps=dlogeps)
        else
           call pkernel_set_epsilon(kernel,eps=eps)
        end if
     else if (present(oneoeps) .and. present(dlogeps)) then
        call pkernel_set_epsilon(kernel,oneoeps=oneoeps,dlogeps=dlogeps)
     else if (present(oneoeps) .neqv. present(dlogeps)) then
        call f_err_throw('For PI method either eps, oneoeps and/or dlogeps should be present')
     end if
  end select

  call f_release_routine()
  call f_timing(TCAT_PSOLV_KERNEL,'OF')

END SUBROUTINE pkernel_set

!> Set the dielectric cavity epsilon in the pkernel structure for a nonvacuum
!! treatment. It generate the dielectric cavity epsilon(r) and all working
!! arrays needed by the PCG or SC solver of the generalized Poisson equation.
!! There are several methods to do that:
!! 1. In case of the soft-sphere model we need just to pass some informations
!!    of our atomistic system like the total number of atoms (nat), their positions
!!    (rxyz(1:3,nat)) and their radii.
!!      call pkernel_set_epsilon(pkernel,nat=nat,rxyz=rxyz,radii=radii)
!! 2. If you have a given cavity epsilon(r) (on the same real space grid of the input
!!    charge) build up with other methods, you can directly set up all working arrays:
!!      call pkernel_set_epsilon(pkernel,eps=eps)
!! 3. If you have both the cavity and the working arrays you can pass all of them to
!!    the solver. In the case of PCG solver you need these three vectors:
!!      call pkernel_set_epsilon(pkernel,eps=eps,oneosqrteps=oneosqrteps,corr=corr)
!!    Here eps represent the dielectric cavity epsilon(r), oneosqrteps the inverse of
!!    its square root, and corr the vector q(r) of equation (16) in Fisicaro J. Chem.
!!    Phys. 144, 014103 (2016). All these vectors have to be on the same real space
!!    grid of the input charge.
!!    In the case of SC solver you need to pass these vectors:
!!      call pkernel_set_epsilon(pkernel,eps=eps,oneoeps=oneoeps,dlogeps=dlogeps)
!!    where oneoeps is the inverse of epsilon and dlogeps the derivative of its
!!    natural logarithm.
subroutine pkernel_set_epsilon(kernel,eps,dlogeps,oneoeps,oneosqrteps,corr,nat,rxyz,radii)
  use yaml_strings
  use dynamic_memory
  use FDder
  use dictionaries, only: f_err_throw
  use numerics, only: pi
  use psolver_environment, only: rigid_cavity_arrays,vacuum_eps
  use f_utils, only: f_zero
  use workarrays
  use f_enums
  implicit none
  !> Poisson Solver kernel
  type(coulomb_operator), intent(inout) :: kernel
  !> dielectric function. Needed for non VAC methods, given in full dimensions
  real(dp), dimension(:,:,:), intent(in), optional :: eps
  !> logarithmic derivative of epsilon. Needed for SC method.
  !! if absent, it will be calculated from the array of epsilon
  real(dp), dimension(:,:,:,:), intent(in), optional :: dlogeps
  !> inverse of epsilon. Needed for SC method.
  !! if absent, it will be calculated from the array of epsilon
  real(dp), dimension(:,:,:), intent(in), optional :: oneoeps
  !> inverse square root of epsilon. Needed for PCG method.
  !! if absent, it will be calculated from the array of epsilon
  real(dp), dimension(:,:,:), intent(in), optional :: oneosqrteps
  !> correction term for PCG
  !! if absent, it will be calculated from the array of epsilon
  real(dp), dimension(:,:,:), intent(in), optional :: corr
  !> number of atoms, can be inserted to define the rigid cavity
  integer, intent(in), optional :: nat
  !> if nat is present, also the positions of the atoms have to be defined
  !! (dimension 3,nat). The rxyz values are defined accordingly to the
  !! position of the atoms in the grid starting from the point [1,1,1] to ndims(:)
  real(dp), dimension(*), intent(in), optional :: rxyz
  !> and the radii aroud each atoms also have to be defined (dimension nat)
  real(dp), dimension(*), intent(in), optional :: radii
  !local variables
  logical, dimension(3) :: prst
  integer :: n1,n23,i3s

  if (present(corr)) then
     !check the dimensions (for the moment no parallelism)
     if (any(shape(corr) /= kernel%mesh%ndims)) &
          call f_err_throw('Error in the dimensions of the array corr,'//&
          trim(yaml_toa(shape(corr))))
  end if
  if (present(eps)) then
     !check the dimensions (for the moment no parallelism)
     if (any(shape(eps) /= kernel%mesh%ndims)) &
          call f_err_throw('Error in the dimensions of the array epsilon,'//&
          trim(yaml_toa(shape(eps))))
  end if
  if (present(oneoeps)) then
     !check the dimensions (for the moment no parallelism)
     if (any(shape(oneoeps) /= kernel%mesh%ndims)) &
          call f_err_throw('Error in the dimensions of the array oneoeps,'//&
          trim(yaml_toa(shape(oneoeps))))
  end if
  if (present(oneosqrteps)) then
     !check the dimensions (for the moment no parallelism)
     if (any(shape(oneosqrteps) /= kernel%mesh%ndims)) &
          call f_err_throw('Error in the dimensions of the array oneosqrteps,'//&
          trim(yaml_toa(shape(oneosqrteps))))
  end if
  if (present(dlogeps)) then
     !check the dimensions (for the moment no parallelism)
     if (any(shape(dlogeps) /= &
          [3,kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3)])) &
          call f_err_throw('Error in the dimensions of the array dlogeps,'//&
          trim(yaml_toa(shape(dlogeps))))
  end if

  prst=[present(nat),present(rxyz),present(radii)]
  if (.not. all(prst) .and. any(prst)) &
       call f_err_throw('All rxyz, radii and nat have to be present in the '//&
       'pkernel_set_epsilon routine')

  if (all(prst) .and. .not. (kernel%method .hasattr. 'rigid')) then
     call f_err_throw('Where rxyz, radii and nat are present in the '//&
          'pkernel_set_epsilon routine the cavity has to be set to "rigid"')
  end if

  !store the arrays needed for the method
  !the stored arrays are of rank two to collapse indices for
  !omp parallelism
  n1=kernel%mesh%ndims(1)
  n23=kernel%mesh%ndims(2)*kernel%grid%n3p
  !starting point in third direction
  i3s=kernel%grid%istart+1
  if (kernel%grid%n3p==0) i3s=1

  select case(trim(toa(kernel%method)))
  case('PCG')
     call set_dielectric_arrays_forPCG(kernel%diel, n1, n23, i3s, kernel%grid%n3p, kernel%mesh, &
          eps, oneosqrteps, corr, nat, rxyz, radii, kernel%cavity, kernel%mesh%volume_element)
  case('PI')
     call set_dielectric_arrays_forPI(kernel%diel, n1, n23, i3s, kernel%grid%n3p, kernel%mesh, &
          eps, oneoeps, dlogeps, nat, rxyz, radii, kernel%cavity, kernel%mesh%volume_element)
  end select
end subroutine pkernel_set_epsilon

!> create the memory space needed to store the arrays for the
!! description of the cavity
subroutine pkernel_allocate_cavity(kernel,vacuum)
  use psolver_environment, only: PS_SCCS_ENUM,vacuum_eps
  use f_utils, only: f_zero
  use f_enums
  implicit none
  type(coulomb_operator), intent(inout) :: kernel
  logical, intent(in), optional :: vacuum !<if .true. the cavity is allocated as no cavity exists, i.e. only vacuum
  !local variables
  integer :: n1,n23,i1,i23

  n1=kernel%mesh%ndims(1)
  n23=kernel%mesh%ndims(2)*kernel%grid%n3p
!!$    call PS_allocate_cavity_workarrays(n1,n23,kernel%ndims,&
!!$         kernel%method,kernel%w)
  if (present(vacuum)) then
     if (vacuum) then
        select case(trim(toa(kernel%method)))
        case('PCG')
           call f_zero(kernel%diel%corr)
           do i23=1,n23
              do i1=1,n1
                 kernel%diel%eps(i1,i23)=vacuum_eps
                 kernel%diel%oneoeps(i1,i23)=1.0_dp/sqrt(vacuum_eps)
              end do
           end do
        case('PI')
           call f_zero(kernel%diel%dlogeps)
           do i23=1,n23
              do i1=1,n1
                 kernel%diel%eps(i1,i23)=vacuum_eps
                 kernel%diel%oneoeps(i1,i23)=1.0_dp/vacuum_eps
              end do
           end do
        end select
        if (kernel%method .hasattr. PS_SCCS_ENUM) &
             call f_zero(kernel%diel%epsinnersccs)
     end if
  end if

end subroutine pkernel_allocate_cavity

!> set the array radii on the basis of the information provided by the user
function pkernel_get_radius(kernel,atname) result(radius)
  use numerics, only: Bohr_Ang
  use psolver_environment
  use dictionaries
  use PStypes
  implicit none
  !> Poisson Solver kernel
  type(coulomb_operator), intent(inout) :: kernel
  !> name of the atom
  character(len=*), intent(in) :: atname
  !> radii of each of the atom types, calculated on the basis of the input values
  real(dp)  :: radius

  if (atname .in. kernel%radii_dict) then
     radius=kernel%radii_dict//atname
  else
     select case (kernel%radii_set)
     case(RADII_PAULING_ID)
        radius = radii_Pau(atname)
     case(RADII_BONDI_ID)
        radius = radii_Bondi(atname)
     case(RADII_UFF_ID)
        radius = radii_UFF(atname)
     end select
  end if

end function pkernel_get_radius

subroutine cuda_estimate_memory_needs(kernel, n, nproc_node, initCufftPlan, gpuPCGRed)
  use iso_c_binding
  use wrapper_MPI
  use yaml_output
  use dictionaries, only: f_err_throw
  implicit none
  !Arguments
  type(coulomb_operator), intent(in) :: kernel
  integer,dimension(3), intent(in) :: n
  integer(kind=8), intent(in) :: nproc_node
  logical, intent(out) :: initCufftPlan
  logical, intent(inout) :: gpuPCGRed
  !Local variables
  integer(kind=C_SIZE_T) :: maxPlanSize, freeGPUSize, totalGPUSize
  integer(kind=8) :: size2,sizek,size3
  integer(kind=8) :: kernelSize, PCGRedSize, plansSize
  integer :: myiproc_node, mynproc_node, ndevices
  real(dp) alpha

  kernelSize=0
  PCGRedSize=0
  plansSize=0
  maxPlanSize=0
  freeGPUSize=0
  totalGPUSize=0
  initCufftPlan = .false.

  !perform the estimation of the processors in the world
  call mpinoderanks(mpirank(mpiworld()),mpisize(mpiworld()),mpiworld(),&
       myiproc_node,mynproc_node)
  !assign the process to one GPU, round robin style
  call cudagetdevicecount(ndevices)
  if(ndevices>1) then
    call cudasetdevice(modulo(myiproc_node,ndevices))
  end if

 !estimate with CUDA the free memory size, and the size of the plans
 call cuda_estimate_memory_needs_cu(kernel%mpi_env%iproc,n,&
    kernel%GPU%geo,plansSize,maxPlanSize,freeGPUSize, totalGPUSize )

   size2=2*n(1)*n(2)*n(3)*sizeof(alpha)
   sizek=(n(1)/2+1)*n(2)*n(3)*sizeof(alpha)
   size3=n(1)*n(2)*n(3)*sizeof(alpha)

!only the first MPI process of the group needs the GPU for apply_kernel
 if(kernel%mpi_env%iproc==0) then
   kernelSize =2*size2+size3+sizek
 end if

!all processes can use the GPU for apply_reductions
 if(gpuPCGRed) then
   !add a 10% margin, because we use a little bit more
   PCGRedSize=int(real(7*size3+4*sizeof(alpha),kind=8)*1.1d0,kind=8)
   !print *,"PCG reductions size : %lu\n", PCGRedSize
 end if


!print *,"free mem",freeGPUSize,", total",totalGPUSize,". Trying Total : ",kernelSize+plansSize+PCGRedSize,&
!" with kernel ",kernelSize," plans ",plansSize, "maxplan",&
!maxPlanSize, "and red ",PCGRedSize, "nprocs/node", nproc_node

 if(freeGPUSize<nproc_node*(kernelSize+maxPlanSize)) then
     if(kernel%mpi_env%iproc==0)then
       call f_err_throw('Not Enough memory on the card to allocate GPU kernels, free Memory :' // &
       trim(yaml_toa(freeGPUSize)) // ", total Memory :"// trim(yaml_toa(totalGPUSize)) //&
       ", minimum needed memory :"// trim(yaml_toa(nproc_node*(kernelSize+maxPlanSize))) )
     end if
 else if(freeGPUSize <nproc_node*(kernelSize+plansSize)) then
     if(kernel%mpi_env%iproc==0) &
       call yaml_warning( "WARNING: not enough free memory for cufftPlans on GPU, performance will be degraded")
     initCufftPlan=.false.
     gpuPCGRed = .false.
 else if(gpuPCGRed .and. (freeGPUSize < nproc_node*(kernelSize+plansSize+PCGRedSize))) then
     if(kernel%mpi_env%iproc==0) &
      call yaml_warning( "WARNING: not enough free memory for GPU PCG reductions, performance will be degraded")
     gpuPCGRed = .false.
 else
     !call yaml_comment("Memory on the GPU is sufficient for" // trim(yaml_toa(nproc_node)) // " processes/node")
     initCufftPlan=.true.
 end if

call fmpi_barrier(comm=kernel%mpi_env%mpi_comm)

end subroutine cuda_estimate_memory_needs

!>put in depsdrho array the extra potential
!!$subroutine sccs_extra_potential(kernel,pot,depsdrho,eps0)
!!$  use FDder
!!$  use yaml_output
!!$  implicit none
!!$  type(coulomb_operator), intent(in) :: kernel
!!$  !>complete potential, needed to calculate the derivative
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3)), intent(in) :: pot
!!$  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), intent(in) :: eps0
!!$  !local variables
!!$  integer :: i3,i3s,i2,i1,i23,i,n01,n02,n03
!!$  real(dp) :: d2,pi,gammaSau,alphaSau,betaVau
!!$  real(dp), dimension(:,:,:,:), allocatable :: nabla2_pot
!!$  !real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3)) :: pot2,depsdrho1,depsdrho2
!!$
!!$  gammaSau=kernel%cavity%gammaS*5.291772109217d-9/8.238722514d-3 ! in atomic unit
!!$  alphaSau=kernel%cavity%alphaS*5.291772109217d-9/8.238722514d-3 ! in atomic unit
!!$  betaVau=kernel%cavity%betaV/2.942191219d4 ! in atomic unit
!!$  pi = 4.d0*datan(1.d0)
!!$  n01=kernel%mesh%ndims(1)
!!$  n02=kernel%mesh%ndims(2)
!!$  n03=kernel%mesh%ndims(3)
!!$  !starting point in third direction
!!$  i3s=kernel%grid%istart+1
!!$
!!$  nabla2_pot=f_malloc([n01,n02,n03,3],id='nabla_pot')
!!$  !calculate derivative of the potential
!!$  !call nabla_u_square(kernel%geocode,n01,n02,n03,pot,nabla2_pot,kernel%nord,kernel%mesh%hgrids)
!!$  call nabla_u(kernel%mesh,pot,nabla2_pot,kernel%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
!!$           d2=0.0_dp
!!$           do i=1,3
!!$              d2 = d2+nabla2_pot(i1,i2,i3,i)**2
!!$           end do
!!$ !!$           !depsdrho1(i1,i2,i3)=depsdrho(i1,i23)
!!$ !!$           d2=nabla2_pot(i1,i2,i3)
!!$           depsdrho(i1,i23)=-0.125d0*depsdrho(i1,i23)*d2/pi!&
!!$                            !+(alphaSau+gammaSau)*dsurfdrho(i1,i23)&
!!$                            !+betaVau*depsdrho(i1,i23)/(1.d0-eps0)
!!$           !depsdrho(i1,i23)=depsdrho(i1,i23)*d2
!!$        end do
!!$        i23=i23+1
!!$     end do
!!$  end do
!!$
!!$  call f_free(nabla2_pot)
!!$
!!$  if (kernel%mpi_env%iproc==0 .and. kernel%mpi_env%igroup==0) then
!!$       call yaml_map('Extra SCF potential calculated',.true.)
!!$  end if
!!$
!!$end subroutine sccs_extra_potential

!!$!>build the needed arrays of the cavity from a given density
!!$!!according to the SCF cavity definition given by Andreussi et al. JCP 136, 064102 (2012)
!!$!! @warning: for the moment the density is supposed to be not distributed as the
!!$!! derivatives are calculated sequentially
!!$subroutine pkernel_build_epsilon(kernel,edens,eps0,depsdrho,dsurfdrho)
!!$  use numerics, only: safe_exp
!!$  use f_utils
!!$  use yaml_output
!!$  use FDder
!!$  implicit none
!!$  !> Poisson Solver kernel
!!$  real(dp), intent(in) :: eps0
!!$  type(coulomb_operator), intent(inout) :: kernel
!!$  !> electronic density in the full box. This is needed because of the calculation of the
!!$  !! gradient
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3)), intent(inout) :: edens
!!$  !> functional derivative of the sc epsilon with respect to
!!$  !! the electronic density, in distributed memory
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2)*kernel%grid%n3p), intent(out) :: depsdrho
!!$  !> functional derivative of the surface integral with respect to
!!$  !! the electronic density, in distributed memory
!!$  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2)*kernel%grid%n3p), intent(out) :: dsurfdrho
!!$  !local variables
!!$  logical, parameter :: dumpeps=.true.  !.true.
!!$  real(kind=8), parameter :: edensmax = 0.005d0 !0.0050d0
!!$  real(kind=8), parameter :: edensmin = 0.0001d0
!!$  real(kind=8), parameter :: innervalue = 0.9d0
!!$  integer :: n01,n02,n03,i1,i2,i3,i23,i3s,unt
!!$  real(dp) :: oneoeps0,oneosqrteps0,pi,fact1,fact2,fact3,d2,x,y,z
!!$  real(dp) :: epsv
!!$  !real(dp) :: dde,ddtx,c1,c2
!!$  real(dp), dimension(:,:,:), allocatable :: ddt_edens,epscurr,depsdrho1,cc
!!$  real(dp), dimension(:,:,:,:), allocatable :: nabla_edens
!!$  real(dp), parameter :: gammaS = 72.d0 ![dyn/cm]
!!$  real(dp), parameter :: alphaS = -22.0d0 ![dyn/cm]
!!$  real(dp), parameter :: betaV = -0.35d0 ![GPa]
!!$  real(dp) :: gammaSau, alphaSau,betaVau,epsm1
!!$  real(gp) :: IntSur,IntVol,noeleene,Cavene,Repene,Disene
!!$
!!$  gammaSau=kernel%cavity%gammaS*5.291772109217d-9/8.238722514d-3 ! in atomic unit
!!$  alphaSau=kernel%cavity%alphaS*5.291772109217d-9/8.238722514d-3 ! in atomic unit
!!$  betaVau=kernel%cavity%betaV/2.942191219d4 ! in atomic unit
!!$  IntSur=0.d0
!!$  IntVol=0.d0
!!$
!!$  n01=kernel%mesh%ndims(1)
!!$  n02=kernel%mesh%ndims(2)
!!$  n03=kernel%mesh%ndims(3)
!!$  !starting point in third direction
!!$  i3s=kernel%grid%istart+1
!!$
!!$  !allocate the work arrays
!!$  nabla_edens=f_malloc([n01,n02,n03,3],id='nabla_edens')
!!$  ddt_edens=f_malloc(kernel%mesh%ndims,id='ddt_edens')
!!$  depsdrho1=f_malloc(kernel%mesh%ndims,id='depsdrho1')
!!$  cc=f_malloc(kernel%mesh%ndims,id='cc')
!!$  if (dumpeps) epscurr=f_malloc(kernel%mesh%ndims,id='epscurr')
!!$
!!$  !build the gradients and the laplacian of the density
!!$  !density gradient in du
!!$  call nabla_u(kernel%mesh,edens,nabla_edens,kernel%nord)
!!$  !density laplacian in d2u
!!$  call div_u_i(kernel%mesh,nabla_edens,ddt_edens,kernel%nord,cc)
!!$
!!$  pi = 4.d0*datan(1.d0)
!!$  oneoeps0=1.d0/eps0
!!$  oneosqrteps0=1.d0/dsqrt(eps0)
!!$  fact1=2.d0*pi/(dlog(edensmax)-dlog(edensmin))
!!$  fact2=(dlog(eps0))/(2.d0*pi)
!!$  fact3=(dlog(eps0))/(dlog(edensmax)-dlog(edensmin))
!!$
!!$  epsm1=(kernel%cavity%epsilon0-1.0_gp)
!!$  if (kernel%mpi_env%iproc==0 .and. kernel%mpi_env%igroup==0) &
!!$       call yaml_map('Rebuilding the cavity for method',trim(toa(kernel%method)))
!!$
!!$  !now fill the pkernel arrays according the the chosen method
!!$  !if ( trim(PSol)=='PCG') then
!!$  select case(trim(toa(kernel%method)))
!!$  case('PCG')
!!$     !in PCG we only need corr, oneosqrtepsilon
!!$     i23=1
!!$     do i3=i3s,i3s+kernel%grid%n3p-1!kernel%mesh%ndims(3)
!!$        !do i3=1,n03
!!$        do i2=1,n02
!!$           do i1=1,n01
!!$              d2 = nabla_edens(i1,i2,i3,1)**2 + nabla_edens(i1,i2,i3,2)**2 + nabla_edens(i1,i2,i3,3)**2
!!$              call dielectric_PCG_set_at(kernel%diel, i1, i23, innervalue, kernel%cavity, &
!!$                   & edens(i1,i2,i3), ddt_edens(i1,i2,i3), d2, &
!!$                   & epsv, depsdrho(i1, i23), dsurfdrho(i1, i23))
!!$              IntSur=IntSur + depsdrho(i1, i23)*sqrt(d2)/epsm1
!!$              IntVol=IntVol + (kernel%cavity%epsilon0-epsv)/epsm1
!!$              if (dumpeps) epscurr(i1,i2,i3)=epsv
!!$           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+kernel%grid%n3p-1!kernel%mesh%ndims(3)
!!$        do i2=1,n02
!!$           do i1=1,n01
!!$              d2 = nabla_edens(i1,i2,i3,1)**2 + nabla_edens(i1,i2,i3,2)**2 + nabla_edens(i1,i2,i3,3)**2
!!$              call dielectric_PI_set_at(kernel%diel, i1, i23, i2, i3, innervalue, kernel%cavity, &
!!$                   & edens(i1,i2,i3), ddt_edens(i1,i2,i3), nabla_edens(i1,i2,i3,:), d2, cc(i1, i2, i3), &
!!$                   & epsv, depsdrho(i1, i23), dsurfdrho(i1, i23))
!!$              dsurfdrho(i1, i23) = dsurfdrho(i1, i23) / epsm1
!!$              IntSur=IntSur + depsdrho(i1, i23)*sqrt(d2)/epsm1
!!$              IntVol=IntVol + (kernel%cavity%epsilon0-epsv)/epsm1
!!$              if (dumpeps) epscurr(i1,i2,i3)=epsv
!!$           end do
!!$           i23=i23+1
!!$        end do
!!$     end do
!!$  end select
!!$
!!$  !IntSur=IntSur*kernel%mesh%hgrids(1)*kernel%mesh%hgrids(2)*kernel%mesh%hgrids(3)!/(eps0-1.d0)
!!$  !IntVol=IntVol*kernel%mesh%hgrids(1)*kernel%mesh%hgrids(2)*kernel%mesh%hgrids(3)
!!$  IntSur=IntSur*kernel%mesh%volume_element!/(eps0-1.d0)
!!$  IntVol=IntVol*kernel%mesh%volume_element
!!$
!!$  Cavene= gammaSau*IntSur*627.509469d0
!!$  Repene= alphaSau*IntSur*627.509469d0
!!$  Disene=  betaVau*IntVol*627.509469d0
!!$  noeleene=Cavene+Repene+Disene
!!$
!!$  if (kernel%mpi_env%iproc==0 .and. kernel%mpi_env%igroup==0) then
!!$     call yaml_map('Surface integral',IntSur)
!!$     call yaml_map('Volume integral',IntVol)
!!$     call yaml_map('Cavity energy',Cavene)
!!$     call yaml_map('Repulsion energy',Repene)
!!$     call yaml_map('Dispersion energy',Disene)
!!$     call yaml_map('Total non-electrostatic energy',noeleene)
!!$  end if
!!$
!!$  if (dumpeps) then
!!$
!!$     unt=f_get_free_unit(21)
!!$     call f_open_file(unt,file='epsilon_sccs.dat')
!!$     i1=1!n03/2
!!$     do i2=1,n02
!!$        do i3=1,n03
!!$           write(unt,'(2(1x,I4),3(1x,e14.7))')i2,i3,epscurr(i1,i2,i3),epscurr(n01/2,i2,i3),edens(n01/2,i2,i3)
!!$        end do
!!$     end do
!!$     call f_close(unt)
!!$
!!$     unt=f_get_free_unit(22)
!!$     call f_open_file(unt,file='epsilon_line_sccs_x.dat')
!!$     do i1=1,n01
!!$        x=i1*kernel%mesh%hgrids(1)
!!$        write(unt,'(1x,I8,4(1x,e22.15))')i1,x,epscurr(i1,n02/2,n03/2),edens(i1,n02/2,n03/2),depsdrho1(i1,n02/2,n03/2)
!!$     end do
!!$     call f_close(unt)
!!$
!!$     unt=f_get_free_unit(23)
!!$     call f_open_file(unt,file='epsilon_line_sccs_y.dat')
!!$     do i2=1,n02
!!$        y=i2*kernel%mesh%hgrids(2)
!!$        write(unt,'(1x,I8,3(1x,e22.15))')i2,y,epscurr(n01/2,i2,n03/2),edens(n01/2,i2,n03/2)
!!$     end do
!!$     call f_close(unt)
!!$
!!$     unt=f_get_free_unit(24)
!!$     call f_open_file(unt,file='epsilon_line_sccs_z.dat')
!!$     do i3=1,n03
!!$        z=i3*kernel%mesh%hgrids(3)
!!$        write(unt,'(1x,I8,3(1x,e22.15))')i3,z,epscurr(n01/2,n02/2,i3),edens(n01/2,n02/2,i3)
!!$     end do
!!$     call f_close(unt)
!!$
!!$     call f_free(epscurr)
!!$
!!$  end if
!!$
!!$  call f_free(ddt_edens)
!!$  call f_free(nabla_edens)
!!$  call f_free(depsdrho1)
!!$  call f_free(cc)
!!$
!!$end subroutine pkernel_build_epsilon


!> New version of the pkernel_build epsilon Routine,
!! with explicit workarrays.
!! This version is supposed not to allocate any array
subroutine rebuild_cavity_from_rho(rho_full,nabla_rho,nabla2_rho,delta_rho,cc_rho,depsdrho,dsurfdrho,&
     kernel)
  use FDder
  use f_enums
  use PSbox
  use PStypes
  use psolver_environment
  implicit none
  type(coulomb_operator), intent(inout) :: kernel
  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3)), intent(in) :: rho_full
  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3)), intent(out) :: delta_rho
  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3)), intent(out) :: cc_rho,nabla2_rho
  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2),kernel%mesh%ndims(3),3), intent(out) :: nabla_rho
  real(dp), dimension(kernel%mesh%ndims(1),kernel%mesh%ndims(2)*kernel%grid%n3p), intent(out) :: depsdrho,dsurfdrho
  !local variables
  integer :: n01,n02,n03,i3s

  n01=kernel%mesh%ndims(1)
  n02=kernel%mesh%ndims(2)
  n03=kernel%mesh%ndims(3)

  !calculate the derivatives of the density
  !build the gradients and the laplacian of the density
  !density gradient in du
  !call nabla_u(kernel%geocode,n01,n02,n03,rho_full,nabla_rho,kernel%nord,kernel%mesh%hgrids)
  call nabla_u_and_square(kernel%mesh,rho_full,nabla_rho,nabla2_rho,kernel%diel%nord)
  !density laplacian in delta_rho
  call div_u_i(kernel%mesh,nabla_rho,delta_rho,kernel%diel%nord,cc_rho)

  !aliasing for the starting point
  i3s=kernel%grid%istart+1
  if (kernel%grid%n3p == 0 ) i3s=1
  call build_cavity_from_rho(kernel%method,rho_full(1,1,i3s),nabla2_rho(1,1,i3s), &
       delta_rho(1,1,i3s),cc_rho(1,1,i3s),kernel%mesh,kernel%grid,kernel%diel,&
       kernel%cavity,depsdrho,dsurfdrho)

  if (kernel%method=='PI') then
     !form the inner cavity with a gathering
     call PS_gather(kernel%diel%epsinnersccs,kernel%grid,kernel%mpi_env,dest=delta_rho)
     call dlepsdrho_sccs(kernel%mesh%ndims,rho_full,nabla_rho,delta_rho,kernel%diel%dlogeps,kernel%cavity)
  end if

end subroutine rebuild_cavity_from_rho

subroutine inplane_partitioning(mpi_env,mdz,n2wires,n3planes,part_mpi,inplane_mpi,n3pr1,n3pr2)
  use wrapper_mpi
  use yaml_output
  implicit none
  integer, intent(in) :: mdz              !< dimension of the density in the z direction
  integer, intent(in) :: n2wires,n3planes !<number of interesting wires in a plane and number of interesting planes
  type(mpi_environment), intent(in) :: mpi_env !< global env of Psolver
  integer, intent(out) :: n3pr1,n3pr2     !< mpi grid of processors based on mpi_env
  type(mpi_environment), intent(out) :: inplane_mpi,part_mpi !<internal environments for the partitioning
  !local variables

  !condition for activation of the inplane partitioning (inactive for the moment due to breaking of OMP parallelization)
  if (mpi_env%nproc>2*(n3planes)-1 .and. .false.) then
     n3pr1=mpi_env%nproc/(n3planes)
     n3pr2=n3planes
!!$     md2plus=.false.
!!$     if ((mdz/mpi_env%nproc)*n3pr1*n3pr2 < n2wires) then
!!$        md2plus=.true.
!!$     endif

     if (mpi_env%iproc==0 .and. n3pr1>1 .and. mpi_env%igroup==0 ) then
          call yaml_map('PSolver n1-n2 plane mpi partitioning activated:',&
          trim(yaml_toa(n3pr1,fmt='(i5)'))//' x'//trim(yaml_toa(n3pr2,fmt='(i5)'))//&
          ' taskgroups')
        call yaml_map('md2 was enlarged for PSolver n1-n2 plane mpi partitioning, md2=',mdz)
     end if

     if (n3pr1>1) &
          call mpi_environment_set1(inplane_mpi,mpi_env%iproc, &
          mpi_env%mpi_comm,n3pr1,n3pr2)
  else
     n3pr1=1
     n3pr2=mpi_env%nproc
     inplane_mpi=mpi_environment_null()
  endif

  call mpi_environment_set(part_mpi,mpi_env%iproc,&
       mpi_env%nproc,mpi_env%mpi_comm,n3pr2)

end subroutine inplane_partitioning
