!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright (C) 2000 - 2018  CP2K developers group                                               !
!--------------------------------------------------------------------------------------------------!
! **************************************************************************************************
MODULE qs_rho0_ggrid

   USE atomic_kind_types,               ONLY: atomic_kind_type,&
                                              get_atomic_kind
   USE basis_set_types,                 ONLY: get_gto_basis_set,&
                                              gto_basis_set_type
   USE cell_types,                      ONLY: cell_type,&
                                              pbc
   USE cp_control_types,                ONLY: dft_control_type
   USE cp_para_types,                   ONLY: cp_para_env_type
   USE cube_utils,                      ONLY: cube_info_type
   USE input_constants,                 ONLY: tddfpt_singlet
   USE kinds,                           ONLY: dp,&
                                              int_8
   USE mathconstants,                   ONLY: dfac,&
                                              fourpi
   USE memory_utilities,                ONLY: reallocate
   USE message_passing,                 ONLY: mp_sum
   USE orbital_pointers,                ONLY: indco,&
                                              nco,&
                                              ncoset,&
                                              nso,&
                                              nsoset
   USE orbital_transformation_matrices, ONLY: orbtramat
   USE particle_types,                  ONLY: particle_type
   USE pw_env_types,                    ONLY: pw_env_get,&
                                              pw_env_type
   USE pw_methods,                      ONLY: pw_axpy,&
                                              pw_copy,&
                                              pw_integrate_function,&
                                              pw_transfer,&
                                              pw_zero
   USE pw_pool_types,                   ONLY: pw_pool_create_pw,&
                                              pw_pool_give_back_pw,&
                                              pw_pool_p_type,&
                                              pw_pool_type
   USE pw_types,                        ONLY: COMPLEXDATA1D,&
                                              REALDATA3D,&
                                              REALSPACE,&
                                              RECIPROCALSPACE,&
                                              pw_p_type,&
                                              pw_release
   USE qs_collocate_density,            ONLY: collocate_pgf_product_rspace
   USE qs_environment_types,            ONLY: get_qs_env,&
                                              qs_environment_type
   USE qs_force_types,                  ONLY: qs_force_type
   USE qs_harmonics_atom,               ONLY: get_none0_cg_list,&
                                              harmonics_atom_type
   USE qs_integrate_potential,          ONLY: integrate_pgf_product_rspace
   USE qs_kind_types,                   ONLY: get_qs_kind,&
                                              qs_kind_type
   USE qs_p_env_types,                  ONLY: qs_p_env_type
   USE qs_rho0_types,                   ONLY: get_rho0_mpole,&
                                              rho0_mpole_type
   USE qs_rho_atom_types,               ONLY: get_rho_atom,&
                                              rho_atom_coeff,&
                                              rho_atom_type
   USE realspace_grid_types,            ONLY: &
        pw2rs, realspace_grid_desc_p_type, realspace_grid_desc_type, realspace_grid_p_type, &
        realspace_grid_type, rs2pw, rs_grid_create, rs_grid_release, rs_grid_retain, rs_grid_zero, &
        rs_pw_transfer
   USE util,                            ONLY: get_limit
   USE virial_types,                    ONLY: virial_type
#include "./base/base_uses.f90"

   IMPLICIT NONE

   PRIVATE

! *** Global parameters (only in this module)

   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_rho0_ggrid'

! *** Public subroutines ***

   PUBLIC :: put_rho0_on_grid, rho0_s_grid_create, integrate_vhg0_rspace

CONTAINS

! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param rho0 ...
!> \param tot_rs_int ...
! **************************************************************************************************
   SUBROUTINE put_rho0_on_grid(qs_env, rho0, tot_rs_int)

      TYPE(qs_environment_type), POINTER                 :: qs_env
      TYPE(rho0_mpole_type), POINTER                     :: rho0
      REAL(dp), INTENT(OUT)                              :: tot_rs_int

      CHARACTER(LEN=*), PARAMETER :: routineN = 'put_rho0_on_grid', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: auxbas_grid, handle, iat, iatom, igrid, &
                                                            ikind, ithread, j, l0_ikind, lmax0, &
                                                            lmax_global, nat, nch_ik, nch_max, npme
      INTEGER, DIMENSION(:), POINTER                     :: atom_list, cores
      LOGICAL                                            :: paw_atom
      REAL(KIND=dp)                                      :: eps_rho_rspace, rpgf0, zet0
      REAL(KIND=dp), DIMENSION(3)                        :: ra
      REAL(KIND=dp), DIMENSION(:), POINTER               :: Qlm_c
      REAL(KIND=dp), DIMENSION(:, :), POINTER            :: pab
      TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      TYPE(cell_type), POINTER                           :: cell
      TYPE(cp_para_env_type), POINTER                    :: para_env
      TYPE(cube_info_type), DIMENSION(:), POINTER        :: cube_info
      TYPE(dft_control_type), POINTER                    :: dft_control
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(pw_env_type), POINTER                         :: pw_env
      TYPE(pw_p_type)                                    :: rho0_r_tmp
      TYPE(pw_p_type), POINTER                           :: coeff_gspace, coeff_rspace, rho0_s_gs, &
                                                            rho0_s_rs
      TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pw_pools
      TYPE(pw_pool_type), POINTER                        :: pw_pool
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      TYPE(realspace_grid_desc_p_type), DIMENSION(:), &
         POINTER                                         :: descs
      TYPE(realspace_grid_desc_type), POINTER            :: desc
      TYPE(realspace_grid_p_type), DIMENSION(:), POINTER :: grids
      TYPE(realspace_grid_type), POINTER                 :: rs_grid

      CALL timeset(routineN, handle)

      NULLIFY (atomic_kind_set, qs_kind_set, cores, pab, Qlm_c)

      NULLIFY (dft_control, pw_env, particle_set, para_env, cell, rho0_s_gs, rho0_s_rs)
      CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, &
                      particle_set=particle_set, &
                      atomic_kind_set=atomic_kind_set, &
                      qs_kind_set=qs_kind_set, &
                      para_env=para_env, &
                      pw_env=pw_env, cell=cell)
      eps_rho_rspace = dft_control%qs_control%eps_rho_rspace

      NULLIFY (descs, pw_pools)
      CALL pw_env_get(pw_env=pw_env, rs_descs=descs, rs_grids=grids, pw_pools=pw_pools)
      cube_info => pw_env%cube_info
      auxbas_grid = pw_env%auxbas_grid

      NULLIFY (rho0_s_gs, rho0_s_rs)
      CALL get_rho0_mpole(rho0_mpole=rho0, lmax_0=lmax0, &
                          zet0_h=zet0, igrid_zet0_s=igrid, &
                          rho0_s_gs=rho0_s_gs, &
                          rho0_s_rs=rho0_s_rs)

      ! *** set up the rs grid at level igrid
      NULLIFY (rs_grid, desc, pw_pool, coeff_rspace, coeff_gspace)
      desc => descs(igrid)%rs_desc
      rs_grid => grids(igrid)%rs_grid
      pw_pool => pw_pools(igrid)%pool

      CPASSERT(ASSOCIATED(desc))
      CPASSERT(ASSOCIATED(pw_pool))

      IF (igrid /= auxbas_grid) THEN
         ALLOCATE (coeff_rspace)
         ALLOCATE (coeff_gspace)

         CALL pw_pool_create_pw(pw_pool, coeff_rspace%pw, use_data=REALDATA3D, &
                                in_space=REALSPACE)
         CALL pw_pool_create_pw(pw_pool, coeff_gspace%pw, &
                                use_data=COMPLEXDATA1D, &
                                in_space=RECIPROCALSPACE)
      END IF
      CALL rs_grid_retain(rs_grid)
      CALL rs_grid_zero(rs_grid)

      nch_max = ncoset(lmax0)

      ALLOCATE (pab(nch_max, 1))

      !Compute global lmax for use in collocate_pgf_product_rspace
      lmax_global = 0
      DO ikind = 1, SIZE(atomic_kind_set)
         CALL get_rho0_mpole(rho0_mpole=rho0, ikind=ikind, l0_ikind=l0_ikind)
         lmax_global = MAX(lmax_global, l0_ikind)
      END DO

      DO ikind = 1, SIZE(atomic_kind_set)
         CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom_list, natom=nat)
         CALL get_qs_kind(qs_kind_set(ikind), paw_atom=paw_atom)

         IF (.NOT. paw_atom .AND. dft_control%qs_control%gapw_control%nopaw_as_gpw) CYCLE

         CALL get_rho0_mpole(rho0_mpole=rho0, ikind=ikind, l0_ikind=l0_ikind, &
                             rpgf0_s=rpgf0)

         nch_ik = ncoset(l0_ikind)
         pab = 0.0_dp

         CALL reallocate(cores, 1, nat)
         npme = 0
         cores = 0

         DO iat = 1, nat
            iatom = atom_list(iat)
            ra(:) = pbc(particle_set(iatom)%r, cell)
            IF (rs_grid%desc%parallel .AND. .NOT. rs_grid%desc%distributed) THEN
               ! replicated realspace grid, split the atoms up between procs
               IF (MODULO(nat, rs_grid%desc%group_size) == rs_grid%desc%my_pos) THEN
                  npme = npme+1
                  cores(npme) = iat
               ENDIF
            ELSE
               npme = npme+1
               cores(npme) = iat
            ENDIF

         END DO

         ithread = 0
         DO j = 1, npme

            iat = cores(j)
            iatom = atom_list(iat)

            CALL get_rho0_mpole(rho0_mpole=rho0, iat=iatom, Qlm_car=Qlm_c)

            pab(1:nch_ik, 1) = Qlm_c(1:nch_ik)

            ra(:) = pbc(particle_set(iatom)%r, cell)

            CALL collocate_pgf_product_rspace( &
               l0_ikind, zet0, 0, 0, 0.0_dp, 0, &
               ra, (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, 1.0_dp, pab, 0, 0, &
               rs_grid, cell, cube_info(igrid), eps_rho_rspace, ga_gb_function=401, &
               ithread=ithread, collocate_rho0=.TRUE., rpgf0_s=rpgf0, &
               use_subpatch=.TRUE., subpatch_pattern=0_int_8, lmax_global=lmax_global)

         END DO !  j

      END DO ! ikind

      IF (ASSOCIATED(cores)) THEN
         DEALLOCATE (cores)
      END IF

      DEALLOCATE (pab)

      IF (igrid /= auxbas_grid) THEN
         CALL rs_pw_transfer(rs_grid, coeff_rspace%pw, rs2pw)
         CALL rs_grid_release(rs_grid)
         CALL pw_zero(rho0_s_gs%pw)
         CALL pw_transfer(coeff_rspace%pw, coeff_gspace%pw)
         CALL pw_axpy(coeff_gspace%pw, rho0_s_gs%pw)

         tot_rs_int = pw_integrate_function(coeff_rspace%pw, isign=-1)

         CALL pw_pool_give_back_pw(pw_pool, coeff_rspace%pw)
         CALL pw_pool_give_back_pw(pw_pool, coeff_gspace%pw)

         DEALLOCATE (coeff_rspace, coeff_gspace)

      ELSE

         CALL pw_pool_create_pw(pw_pool, rho0_r_tmp%pw, &
                                use_data=REALDATA3D, in_space=REALSPACE)

         CALL rs_pw_transfer(rs_grid, rho0_r_tmp%pw, rs2pw)
         CALL rs_grid_release(rs_grid)

         tot_rs_int = pw_integrate_function(rho0_r_tmp%pw, isign=-1)

         CALL pw_transfer(rho0_r_tmp%pw, rho0_s_rs%pw)
         CALL pw_pool_give_back_pw(pw_pool, rho0_r_tmp%pw)

         CALL pw_zero(rho0_s_gs%pw)
         CALL pw_transfer(rho0_s_rs%pw, rho0_s_gs%pw)
      END IF
      CALL timestop(handle)

   END SUBROUTINE put_rho0_on_grid

! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param rho0_mpole ...
!> \param tddft ...
! **************************************************************************************************
   SUBROUTINE rho0_s_grid_create(qs_env, rho0_mpole, tddft)

      TYPE(qs_environment_type), POINTER                 :: qs_env
      TYPE(rho0_mpole_type), POINTER                     :: rho0_mpole
      LOGICAL, INTENT(IN), OPTIONAL                      :: tddft

      CHARACTER(len=*), PARAMETER :: routineN = 'rho0_s_grid_create', &
         routineP = moduleN//':'//routineN

      LOGICAL                                            :: my_tddft
      TYPE(pw_env_type), POINTER                         :: new_pw_env
      TYPE(pw_p_type), POINTER                           :: rho_gs, rho_rs
      TYPE(pw_pool_type), POINTER                        :: auxbas_pw_pool

      my_tddft = .FALSE.
      IF (PRESENT(tddft)) my_tddft = tddft

      NULLIFY (new_pw_env)
      CALL get_qs_env(qs_env, pw_env=new_pw_env)
      CPASSERT(ASSOCIATED(new_pw_env))

      NULLIFY (auxbas_pw_pool)
      CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
      CPASSERT(ASSOCIATED(auxbas_pw_pool))

      ! reallocate rho0 on the global grid in real and reciprocal space
      NULLIFY (rho_rs, rho_gs)
      CPASSERT(ASSOCIATED(rho0_mpole))
      rho_rs => rho0_mpole%rho0_s_rs
      rho_gs => rho0_mpole%rho0_s_gs

      ! rho0 density in real space
      IF (ASSOCIATED(rho_rs)) THEN
         CALL pw_release(rho_rs%pw)
         DEALLOCATE (rho_rs)
      END IF
      ALLOCATE (rho_rs)
      CALL pw_pool_create_pw(auxbas_pw_pool, rho_rs%pw, &
                             use_data=REALDATA3D, in_space=REALSPACE)
      rho0_mpole%rho0_s_rs => rho_rs

      ! rho0 density in reciprocal space
      IF (ASSOCIATED(rho_gs)) THEN
         CALL pw_release(rho_gs%pw)
         DEALLOCATE (rho_gs)
      END IF
      ALLOCATE (rho_gs)
      CALL pw_pool_create_pw(auxbas_pw_pool, rho_gs%pw, &
                             use_data=COMPLEXDATA1D)
      rho_gs%pw%in_space = RECIPROCALSPACE
      rho0_mpole%rho0_s_gs => rho_gs

      IF (my_tddft) THEN
         rho0_mpole%igrid_zet0_s = qs_env%local_rho_set%rho0_mpole%igrid_zet0_s
      END IF

   END SUBROUTINE rho0_s_grid_create

! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param v_rspace ...
!> \param calculate_forces ...
!> \param tddft ...
!> \param do_triplet ...
!> \param p_env ...
! **************************************************************************************************
   SUBROUTINE integrate_vhg0_rspace(qs_env, v_rspace, calculate_forces, &
                                    tddft, do_triplet, p_env)

      TYPE(qs_environment_type), POINTER                 :: qs_env
      TYPE(pw_p_type)                                    :: v_rspace
      LOGICAL, INTENT(IN)                                :: calculate_forces
      LOGICAL, INTENT(IN), OPTIONAL                      :: tddft, do_triplet
      TYPE(qs_p_env_type), OPTIONAL, POINTER             :: p_env

      CHARACTER(LEN=*), PARAMETER :: routineN = 'integrate_vhg0_rspace', &
         routineP = moduleN//':'//routineN

      INTEGER :: auxbas_grid, bo(2), handle, i, iat, iatom, ic, icg, ico, ig1, ig2, igrid, ii, &
         ikind, ipgf1, ipgf2, is, iset1, iset2, iso, iso1, iso2, ispin, j, l0_ikind, llmax, lmax0, &
         lshell, lx, ly, lz, m1, m2, max_iso_not0_local, max_s_harm, maxl, maxso, mepos, n1, n2, &
         nat, nch_ik, nch_max, ncurr, nset, nsotot, nspins, num_pe
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: cg_n_list
      INTEGER, ALLOCATABLE, DIMENSION(:, :, :)           :: cg_list
      INTEGER, DIMENSION(:), POINTER                     :: atom_list, lmax, lmin, npgf
      LOGICAL                                            :: grid_distributed, my_tddft, paw_atom, &
                                                            use_virial
      REAL(dp)                                           :: c4pi, eps_rho_rspace, force_tmp(3), &
                                                            ra(3), rpgf0, scale, zet0
      REAL(dp), DIMENSION(:), POINTER                    :: hab_sph, norm_l, Qlm
      REAL(dp), DIMENSION(:, :), POINTER                 :: hab, hdab_sph, intloc, pab
      REAL(dp), DIMENSION(:, :, :), POINTER              :: a_hdab_sph, hadb, hdab, Qlm_gg
      REAL(dp), DIMENSION(:, :, :, :), POINTER           :: a_hdab
      REAL(KIND=dp), DIMENSION(3, 3)                     :: my_virial_a, my_virial_b
      TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      TYPE(cell_type), POINTER                           :: cell
      TYPE(cp_para_env_type), POINTER                    :: para_env
      TYPE(cube_info_type), DIMENSION(:), POINTER        :: cube_info
      TYPE(dft_control_type), POINTER                    :: dft_control
      TYPE(gto_basis_set_type), POINTER                  :: orb_basis_set
      TYPE(harmonics_atom_type), POINTER                 :: harmonics
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(pw_env_type), POINTER                         :: pw_env
      TYPE(pw_p_type), POINTER                           :: coeff_gaux, coeff_gspace, coeff_raux, &
                                                            coeff_rspace
      TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pw_pools
      TYPE(pw_pool_type), POINTER                        :: pw_aux, pw_pool
      TYPE(qs_force_type), DIMENSION(:), POINTER         :: force
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      TYPE(realspace_grid_desc_p_type), DIMENSION(:), &
         POINTER                                         :: rs_descs
      TYPE(realspace_grid_desc_type), POINTER            :: rs_desc
      TYPE(realspace_grid_type), POINTER                 :: rs_v
      TYPE(rho0_mpole_type), POINTER                     :: rho0_mpole
      TYPE(rho_atom_coeff), DIMENSION(:), POINTER        :: int_local_h, int_local_s
      TYPE(rho_atom_type), DIMENSION(:), POINTER         :: rho_atom_set
      TYPE(rho_atom_type), POINTER                       :: rho_atom
      TYPE(virial_type), POINTER                         :: virial

      c4pi = fourpi

      CALL timeset(routineN, handle)

      NULLIFY (atomic_kind_set, qs_kind_set, dft_control, para_env, particle_set)
      NULLIFY (cell, force, pw_env, rho0_mpole, rho_atom_set)

      my_tddft = .FALSE.
      IF (PRESENT(tddft)) my_tddft = tddft

      CALL get_qs_env(qs_env=qs_env, &
                      atomic_kind_set=atomic_kind_set, &
                      qs_kind_set=qs_kind_set, &
                      cell=cell, &
                      dft_control=dft_control, &
                      para_env=para_env, &
                      force=force, pw_env=pw_env, &
                      rho0_mpole=rho0_mpole, &
                      rho_atom_set=rho_atom_set, &
                      particle_set=particle_set, &
                      virial=virial)

      use_virial = virial%pv_availability .AND. (.NOT. virial%pv_numer)

      nspins = dft_control%nspins

      IF (my_tddft) THEN
         IF (PRESENT(do_triplet)) THEN
            IF (nspins == 1 .AND. do_triplet) RETURN
         ELSE
            IF (nspins == 1 .AND. dft_control%tddfpt_control%res_etype /= tddfpt_singlet) RETURN
         ENDIF
      END IF

      IF (my_tddft) THEN
         rho0_mpole => p_env%local_rho_set%rho0_mpole
         rho_atom_set => p_env%local_rho_set%rho_atom_set
      END IF

      CALL get_rho0_mpole(rho0_mpole=rho0_mpole, lmax_0=lmax0, &
                          zet0_h=zet0, igrid_zet0_s=igrid, &
                          norm_g0l_h=norm_l)

      ! *** set up of the potential on the multigrids
      NULLIFY (rs_descs, pw_pools)
      CPASSERT(ASSOCIATED(pw_env))
      CALL pw_env_get(pw_env, rs_descs=rs_descs, pw_pools=pw_pools)

      ! *** assign from pw_env
      auxbas_grid = pw_env%auxbas_grid
      cube_info => pw_env%cube_info

      ! *** Get the potential on the right grid
      NULLIFY (rs_v, rs_desc, pw_pool, pw_aux, coeff_rspace, coeff_gspace)
      rs_desc => rs_descs(igrid)%rs_desc
      pw_pool => pw_pools(igrid)%pool

      ALLOCATE (coeff_gspace)
      ALLOCATE (coeff_rspace)
      CALL pw_pool_create_pw(pw_pool, coeff_gspace%pw, &
                             use_data=COMPLEXDATA1D, &
                             in_space=RECIPROCALSPACE)

      CALL pw_pool_create_pw(pw_pool, coeff_rspace%pw, use_data=REALDATA3D, &
                             in_space=REALSPACE)

      IF (igrid /= auxbas_grid) THEN
         pw_aux => pw_pools(auxbas_grid)%pool
         ALLOCATE (coeff_gaux)
         CALL pw_pool_create_pw(pw_aux, coeff_gaux%pw, &
                                use_data=COMPLEXDATA1D, &
                                in_space=RECIPROCALSPACE)
         CALL pw_transfer(v_rspace%pw, coeff_gaux%pw)
         CALL pw_copy(coeff_gaux%pw, coeff_gspace%pw)
         CALL pw_transfer(coeff_gspace%pw, coeff_rspace%pw)
         CALL pw_pool_give_back_pw(pw_aux, coeff_gaux%pw)
         DEALLOCATE (coeff_gaux)
         ALLOCATE (coeff_raux)
         CALL pw_pool_create_pw(pw_aux, coeff_raux%pw, use_data=REALDATA3D, &
                                in_space=REALSPACE)
         scale = coeff_rspace%pw%pw_grid%dvol/coeff_raux%pw%pw_grid%dvol
         coeff_rspace%pw%cr3d = scale*coeff_rspace%pw%cr3d
         CALL pw_pool_give_back_pw(pw_aux, coeff_raux%pw)
         DEALLOCATE (coeff_raux)
      ELSE

         IF (coeff_gspace%pw%pw_grid%spherical) THEN
            CALL pw_transfer(v_rspace%pw, coeff_gspace%pw)
            CALL pw_transfer(coeff_gspace%pw, coeff_rspace%pw)
         ELSE
            CALL pw_copy(v_rspace%pw, coeff_rspace%pw)
         END IF
      END IF
      CALL pw_pool_give_back_pw(pw_pool, coeff_gspace%pw)
      DEALLOCATE (coeff_gspace)

      ! *** set up the rs grid at level igrid
      CALL rs_grid_create(rs_v, rs_desc)
      CALL rs_grid_zero(rs_v)
      CALL rs_pw_transfer(rs_v, coeff_rspace%pw, pw2rs)

      CALL pw_pool_give_back_pw(pw_pool, coeff_rspace%pw)
      DEALLOCATE (coeff_rspace)

      ! *** Now the potential is on the right grid => integration

      eps_rho_rspace = dft_control%qs_control%eps_rho_rspace

      !   *** Allocate work storage ***

      NULLIFY (hab, hab_sph, hdab, hdab_sph, hadb, pab, a_hdab, a_hdab_sph)
      nch_max = ncoset(lmax0)
      CALL reallocate(hab, 1, nch_max, 1, 1)
      CALL reallocate(hab_sph, 1, nch_max)
      CALL reallocate(hdab, 1, 3, 1, nch_max, 1, 1)
      CALL reallocate(hadb, 1, 3, 1, nch_max, 1, 1)
      CALL reallocate(hdab_sph, 1, 3, 1, nch_max)
      CALL reallocate(a_hdab, 1, 3, 1, 3, 1, nch_max, 1, 1)
      CALL reallocate(a_hdab_sph, 1, 3, 1, 3, 1, nch_max)
      CALL reallocate(pab, 1, nch_max, 1, 1)

      ncurr = -1

      grid_distributed = rs_v%desc%distributed

      DO ikind = 1, SIZE(atomic_kind_set, 1)
         NULLIFY (orb_basis_set, atom_list, harmonics)
         CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom_list, natom=nat)
         CALL get_qs_kind(qs_kind_set(ikind), &
                          basis_set=orb_basis_set, &
                          paw_atom=paw_atom, &
                          harmonics=harmonics)

         IF (.NOT. paw_atom) CYCLE

         NULLIFY (Qlm_gg, lmax, npgf)
         CALL get_rho0_mpole(rho0_mpole=rho0_mpole, ikind=ikind, &
                             l0_ikind=l0_ikind, Qlm_gg=Qlm_gg, &
                             rpgf0_s=rpgf0)

         CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
                                lmax=lmax, lmin=lmin, &
                                maxso=maxso, maxl=maxl, &
                                nset=nset, npgf=npgf)

         nsotot = maxso*nset
         ALLOCATE (intloc(nsotot, nsotot))

         ! Initialize the local KS integrals

         nch_ik = ncoset(l0_ikind)
         pab = 1.0_dp
         max_s_harm = harmonics%max_s_harm
         llmax = harmonics%llmax

         ALLOCATE (cg_list(2, nsoset(maxl)**2, max_s_harm), cg_n_list(max_s_harm))

         num_pe = para_env%num_pe
         mepos = para_env%mepos
         DO j = 0, num_pe-1
            bo = get_limit(nat, num_pe, j)
            IF (.NOT. grid_distributed .AND. j /= mepos) CYCLE

            DO iat = bo(1), bo(2)
               iatom = atom_list(iat)
               ra(:) = pbc(particle_set(iatom)%r, cell)

               NULLIFY (Qlm)
               CALL get_rho0_mpole(rho0_mpole=rho0_mpole, iat=iatom, Qlm_tot=Qlm)

               hab = 0.0_dp
               hdab = 0.0_dp
               intloc = 0._dp
               IF (use_virial) THEN
                  my_virial_a = 0.0_dp
                  my_virial_b = 0.0_dp
                  a_hdab = 0.0_dp
               END IF

               CALL integrate_pgf_product_rspace( &
                  l0_ikind, zet0, 0, 0, 0.0_dp, 0, &
                  ra, (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, rs_v, cell, &
                  cube_info(igrid), hab, pab, o1=0, o2=0, &
                  eps_gvg_rspace=eps_rho_rspace, &
                  calculate_forces=calculate_forces, &
                  hdab=hdab, hadb=hadb, &
                  collocate_rho0=.TRUE., rpgf0_s=rpgf0, &
                  use_virial=use_virial, my_virial_a=my_virial_a, my_virial_b=my_virial_b, &
                  a_hdab=a_hdab, use_subpatch=.TRUE., subpatch_pattern=0_int_8)

               ! Convert from cartesian to spherical
               DO lshell = 0, l0_ikind
                  DO is = 1, nso(lshell)
                     iso = is+nsoset(lshell-1)
                     hab_sph(iso) = 0.0_dp
                     hdab_sph(1:3, iso) = 0.0_dp
                     a_hdab_sph(1:3, 1:3, iso) = 0.0_dp
                     DO ic = 1, nco(lshell)
                        ico = ic+ncoset(lshell-1)
                        lx = indco(1, ico)
                        ly = indco(2, ico)
                        lz = indco(3, ico)

                        hab_sph(iso) = hab_sph(iso)+ &
                                       orbtramat(lshell)%c2s(is, ic)*hab(ico, 1)* &
                                       norm_l(lshell)/ &
                                       SQRT(c4pi*dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)/ &
                                            dfac(2*lshell+1))

                        IF (calculate_forces) THEN
                           hdab_sph(1:3, iso) = hdab_sph(1:3, iso)+ &
                                                orbtramat(lshell)%c2s(is, ic)*hdab(1:3, ico, 1)* &
                                                norm_l(lshell)/ &
                                                SQRT(c4pi*dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)/ &
                                                     dfac(2*lshell+1))
                        END IF
                        IF (use_virial) THEN
                           DO ii = 1, 3
                           DO i = 1, 3
                              a_hdab_sph(i, ii, iso) = a_hdab_sph(i, ii, iso)+ &
                                                       orbtramat(lshell)%c2s(is, ic)*a_hdab(i, ii, ico, 1)* &
                                                       norm_l(lshell)/ &
                                                       SQRT(c4pi*dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)/ &
                                                            dfac(2*lshell+1))
                           END DO
                           END DO
                        END IF

                     END DO ! ic
                  END DO ! is
               END DO ! lshell

               m1 = 0
               DO iset1 = 1, nset

                  m2 = 0
                  DO iset2 = 1, nset
                     CALL get_none0_cg_list(harmonics%my_CG, lmin(iset1), lmax(iset1), lmin(iset2), lmax(iset2), &
                                            max_s_harm, llmax, cg_list, cg_n_list, max_iso_not0_local)
                     n1 = nsoset(lmax(iset1))
                     DO ipgf1 = 1, npgf(iset1)
                        n2 = nsoset(lmax(iset2))
                        DO ipgf2 = 1, npgf(iset2)

                           DO iso = 1, MIN(nsoset(l0_ikind), max_iso_not0_local)
                              DO icg = 1, cg_n_list(iso)
                                 iso1 = cg_list(1, icg, iso)
                                 iso2 = cg_list(2, icg, iso)

                                 ig1 = iso1+n1*(ipgf1-1)+m1
                                 ig2 = iso2+n2*(ipgf2-1)+m2

                                 intloc(ig1, ig2) = intloc(ig1, ig2)+Qlm_gg(ig1, ig2, iso)*hab_sph(iso)

                              END DO ! icg
                           END DO ! iso

                        END DO ! ipgf2
                     END DO ! ipgf1
                     m2 = m2+maxso
                  END DO ! iset2
                  m1 = m1+maxso
               END DO ! iset1

               IF (grid_distributed) THEN
                  ! sum result over all processors
                  CALL mp_sum(intloc, para_env%group)
               END IF

               IF (j == mepos) THEN
                  rho_atom => rho_atom_set(iatom)
                  CALL get_rho_atom(rho_atom=rho_atom, ga_Vlocal_gb_h=int_local_h, ga_Vlocal_gb_s=int_local_s)
                  DO ispin = 1, nspins
                     int_local_h(ispin)%r_coef = int_local_h(ispin)%r_coef+intloc
                     int_local_s(ispin)%r_coef = int_local_s(ispin)%r_coef+intloc
                  END DO
               END IF

               IF (calculate_forces) THEN
                  force_tmp(1:3) = 0.0_dp
                  DO iso = 1, nsoset(l0_ikind)
                     force_tmp(1) = force_tmp(1)+Qlm(iso)*hdab_sph(1, iso)
                     force_tmp(2) = force_tmp(2)+Qlm(iso)*hdab_sph(2, iso)
                     force_tmp(3) = force_tmp(3)+Qlm(iso)*hdab_sph(3, iso)
                  END DO
                  force(ikind)%g0s_Vh_elec(1:3, iat) = force(ikind)%g0s_Vh_elec(1:3, iat)+force_tmp(1:3)
               END IF
               IF (use_virial) THEN
                  my_virial_a = 0.0_dp
                  DO iso = 1, nsoset(l0_ikind)
                     DO ii = 1, 3
                     DO i = 1, 3
                        virial%pv_virial(i, ii) = virial%pv_virial(i, ii)+Qlm(iso)*a_hdab_sph(i, ii, iso)
                     END DO
                     END DO
                  END DO
               END IF

            END DO
         END DO

         DEALLOCATE (intloc)
         DEALLOCATE (cg_list, cg_n_list)

      END DO ! ikind

      CALL rs_grid_release(rs_v)

      DEALLOCATE (hab, hdab, hadb, hab_sph, hdab_sph, pab, a_hdab, a_hdab_sph)

      CALL timestop(handle)

   END SUBROUTINE integrate_vhg0_rspace

END MODULE qs_rho0_ggrid
