!
! Copyright (C) 2017- Orbital-free DFT group at University of Florida
!
! This program is free software; you can redistribute it and/or modify 
! it under the terms of the GNU General Public License as published by 
! the Free Software Foundation; either version 2 of the License, or 
! any later version. See the file LICENSE in the root directory of the 
! present distribution, or http://www.gnu.org/copyleft/gpl.txt ,
! or contact developers via e-mail: calderin@lcalderin.net, or paper mail:
!
! Quantum Theory Project
! University of Florida
! P.O. Box 118435
! Gainesville, FL 32611
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
! 
! Authors: Lazaro Calderin and Valentin Karasiev
!-----------------------------------------------------------------------
! 


module apawgm
   ! Atomic Projector Augmented Waves Gradient Matrix elements (apawgm)
   ! Variables and subroutines for the calculation of the matrix elements of the gradient operator
   ! \nabla over atomic wave functions and pseudo wave functions.
   ! For PAW sets only
   !
   ! < \phi_i | \nabla | \phi_j >  is stored in the atwfc_grad_atwfc() matrix
   ! < \hat{\phi}_i | \nabla | \hat{\phi}_j >  in the pswfc_grad_pswfc() matrix

   use kinds, ONLY : DP

   ! Atomic Data
   USE atom,           ONLY : msh, rgrid
   !USE paw_onecenter,  ONLY : PAW_potential
   !USE paw_symmetry,   ONLY : PAW_symmetrize_ddd
   USE uspp_param,     ONLY : upf, nh, nhm, nbetam

   ! Real Space Unit cell
   USE ions_base,  ONLY : nat, ityp, tau, ntyp => nsp
   use cell_base,  ONLY : tpiba, tpiba2, omega

   use constants, ONLY : pi

   use qevars, ONLY : stdout

   implicit none
   private

   logical :: use_real_spherical_harm = .true.
   complex(DP), allocatable, public :: DG(:,:,:), psi_norm_correction_at(:,:)

   integer, public :: n_pro_type_tot, n_pro_tot

   integer, allocatable, public :: p_index_type(:), p_index_type_all(:),&
                                   p_index(:), plm_index(:,:,:), &
                                   p_index_row_start(:), p_index_row_end(:)
   logical :: indexes_set=.false.

   real(DP), allocatable :: Rd(:,:,:), R(:,:,:), pRd(:,:,:), pR(:,:,:)
   complex(DP) :: I_r(0:3,-3:3,0:3,-3:3,1:3), I_theta(0:3,-3:3,0:3,-3:3,1:3), I_phi(0:3,-3:3,0:3,-3:3,1:3)

   integer    :: it, l, lp, m, mp ! counters for types of atoms, angular momentum and magnetic quantum number
   integer    :: ierr

#ifdef __KGDEBUG
   integer ir
   character*256 filename
#endif   

   ! Public subroutines
   public :: use_real_spherical_harm, awfc_grad_awfc, check_p_pswfc, & 
             diff_awfc_grad_awfc, psi_norm_correction_paw_at, agm_free_memory

   ! Public variables
   !public ::atwfc_grad_atwf, pswfc_grad_pswfc, DG, psi_norm_correction_at
   !public :: n_pro_type_tot

 contains

     subroutine Rmatrices()
     ! Radial integrals R and pR defined as:
     ! R(it,p,p')  = \int_0^\infty r   R_{l(p)}(r) R_{l'(p')}(r) dr
     ! pR(it,p,p') = \int_0^\infty r^2 R_{l(p})(r) \frac{dR_{l'(p')}(r)}{dr} dr
     ! it = counter on atom types, p,p'= counter on projectors,
     ! l(p),l(p')= angular momentum of the p and p' projectors
     ! Notice that pswfc and aewfc are r*R or r* \pseudo R

     implicit none
!     real(DP), allocatable :: Rd(:,:,:,:), R(:,:,:,:), pRd(:,:,:,:), pR(:,:,:,:)

        integer               :: it     ! counter for type of atoms
        integer               :: ip, jp ! counter for projectors
        integer               :: ir     ! counter for radial grid points

        real(DP), allocatable :: dRdr(:), integrand(:)
        real(DP) :: integral

        !character(len=1024) :: filename

        allocate( Rd(1:ntyp,1:nbetam,1:nbetam), R(1:ntyp,1:nbetam,1:nbetam), &
                  pRd(1:ntyp,1:nbetam,1:nbetam), pR(1:ntyp,1:nbetam,1:nbetam), &
                                                                     STAT=ierr )
        if (ierr/=0) call errore('kgec:Rmatrices','allocating Rd, pRd, &
                                                           and/or pR',ABS(ierr))

        ! Radial integrals for all electron atomic orbitals

        do it = 1, ntyp

           if (.not.upf(it)%has_wfc) &
              call errore( 'kgec:vm','AE wavefunctions not in file', 1 )
           allocate( integrand(1:rgrid(it)%mesh), STAT=ierr )
           if (ierr/=0) call errore('kgec:Rmatrices','allocating integrand', &
                                                                      ABS(ierr))

           do ip=1, upf(it)%nbeta
              do jp=1, upf(it)%nbeta
                 integrand(1:rgrid(it)%mesh) = &
                                            upf(it)%aewfc(1:rgrid(it)%mesh,ip) &
                                            * upf(it)%aewfc(1:rgrid(it)%mesh,jp)

                 do ir=1, rgrid(it)%mesh
                    if ( rgrid(it)%r(ir) .gt. 0.0_DP ) &
                       integrand(ir) = integrand(ir)/rgrid(it)%r(ir)
                 enddo
                 call simpson(rgrid(it)%mesh, integrand, rgrid(it)%rab,integral)
                 R(it,ip,jp) = integral

              enddo
           enddo
           deallocate(integrand)
        enddo

        do it = 1, ntyp
           allocate( integrand(1:rgrid(it)%mesh), dRdr(1:rgrid(it)%mesh), &
                                                                     STAT=ierr )
           if (ierr/=0) call errore('kgec:Rmatrices','allocating &
                                               integrand and/or dRdr',ABS(ierr))

           do jp=1, upf(it)%nbeta
              call radial_gradient( upf(it)%aewfc(1:rgrid(it)%mesh,jp), &
                                                dRdr(1:rgrid(it)%mesh), &
                                          rgrid(it)%r, rgrid(it)%mesh, 0)

              do ir=1, rgrid(it)%mesh
                 if ( rgrid(it)%r(ir) .gt. 0.0_DP ) then
                    dRdr(ir) = dRdr(ir) - upf(it)%aewfc(ir,jp)/rgrid(it)%r(ir)
                 endif
              enddo

              do ip=1, upf(it)%nbeta

!                 write(filename,"('R_',i3.3,'_dRdr_',i3.3,'.dat')") ip,jp
!                 open(11,file=filename,action='write')
!                 do ir=1, rgrid(it)%mesh
!		             write(11,'(4e16.6)') rgrid(it)%r(ir), upf(it)%aewfc(ir,ip),dRdr(ir), upf(it)%aewfc(ir,ip)*dRdr(ir)
!                 enddo
!                 close(11)

                 integrand(1:rgrid(it)%mesh) = &
                                            upf(it)%aewfc(1:rgrid(it)%mesh,ip) &
                                            * dRdr(1:rgrid(it)%mesh)
                 call simpson(rgrid(it)%mesh, integrand, rgrid(it)%rab,integral)
                 Rd(it,ip,jp) = integral
              enddo
           enddo
           deallocate(integrand, dRdr)
        enddo


        ! Radial integrals for all electron atomic pseudo orbitals

        do it = 1, ntyp

           allocate( integrand(1:rgrid(it)%mesh), STAT=ierr )
           if (ierr/=0) call errore('kgec:Rmatrices','allocating integrand', &
                                                                      ABS(ierr))

           do ip=1, upf(it)%nbeta
              do jp=1, upf(it)%nbeta
                 integrand(1:rgrid(it)%mesh) = &
                                             upf(it)%pswfc(1:rgrid(it)%mesh,ip) &
                                           * upf(it)%pswfc(1:rgrid(it)%mesh,jp)
                 do ir=1, rgrid(it)%mesh
                    if ( rgrid(it)%r(ir) .gt. 0.0_DP ) &
                       integrand(ir) = integrand(ir)/rgrid(it)%r(ir)
                 enddo
                 call simpson(rgrid(it)%mesh, integrand, rgrid(it)%rab,integral)
                 pR(it,ip,jp) = integral
              enddo
           enddo

           deallocate(integrand)
        enddo


        do it = 1, ntyp
           allocate( integrand(1:rgrid(it)%mesh), dRdr(1:rgrid(it)%mesh), &
                                                                     STAT=ierr )
           if (ierr/=0) call errore('kgec','allocating integrand and or dRdr',&
                                                                     ABS(ierr))

           do jp=1, upf(it)%nbeta

              call radial_gradient( upf(it)%pswfc(1:rgrid(it)%mesh,jp), &
                                                dRdr(1:rgrid(it)%mesh), &
                                           rgrid(it)%r, rgrid(it)%mesh, 1)

              do ir=1, rgrid(it)%mesh
                 if ( rgrid(it)%r(ir) .gt. 0.0_DP ) then
                    dRdr(ir) = dRdr(ir) - upf(it)%pswfc(ir,jp)/rgrid(it)%r(ir)
                 endif
              enddo


              do ip=1, upf(it)%nbeta

!                  write(filename,"('pR_',i3.3,'_dpRdr_',i3.3,'.dat')") ip,jp
!                  open(11,file=filename,action='write')
!                  do ir=1, rgrid(it)%mesh
!		             write(11,'(4e16.6)') rgrid(it)%r(ir), upf(it)%pswfc(ir,ip),dRdr(ir),upf(it)%pswfc(ir,ip)*dRdr(ir)
!                  enddo
!                  close(11)

                 integrand(1:rgrid(it)%mesh) = &
                     upf(it)%pswfc(1:rgrid(it)%mesh,ip) * dRdr(1:rgrid(it)%mesh)
                 call simpson( rgrid(it)%mesh, integrand, rgrid(it)%rab, integral )
                 pRd(it,ip,jp) = integral

              enddo ! jp
           enddo ! ip

           deallocate(integrand,dRdr)
        enddo ! it

#ifdef __KGDEBUG

        open(222,file='R-pR.dat',action='write')
        write(222,*) &
        "l    l'     \int_0^\infty r ( R_l R_l' - \~R_l \~R_l' ) dr"
        do it = 1, ntyp
           do jp=1, upf(it)%nbeta
              do ip=1, upf(it)%nbeta
                 write(222,*) ip,jp, R(it,ip,jp)-pR(it,ip,jp)
              enddo
           enddo
        enddo
        close(222)

        open(222,file='Rd-pRd.dat',action='write')
        write(222,*) &
        "l    l'    \int_0^\infty r^2 ( R_l dR_l'/dr - \~R_l d \~R_l'/dr ) dr "
        do it = 1, ntyp
           do jp=1, upf(it)%nbeta
              do ip=1, upf(it)%nbeta
                 write(222,*) ip,jp, Rd(it,ip,jp)-pRd(it,ip,jp)
              enddo
           enddo
        enddo
        close(222)

#endif

     end subroutine Rmatrices


     subroutine check_p_pswfc()
     implicit none

        integer               :: it     ! counter on type of atoms
        integer               :: ip, jp ! counter on projectors

        real(DP), allocatable :: integrand(:)
        real(DP) :: integral

        write(stdout,*) ""
        write(stdout,'(A)') "     Checking the duality of projectors and pseudo orbitals:"


        do it = 1, ntyp

           write(stdout,*)      "     Atom type:", it
           write(stdout,'(A)')  &
           '      projector  l     pswfc     l      < proj | pswfc >'

           allocate( integrand(1:rgrid(it)%mesh), STAT=ierr )
           if (ierr/=0) call errore('kgec:Rmatrices','allocating integrand',ABS(ierr))

           do ip=1, upf(it)%nbeta
              do jp=1, upf(it)%nbeta

!exp(-rgrid(it)%r( 1:rgrid(it)%mesh ))*
!upf(it)%beta(1:rgrid(it)%mesh,ip)=sin( 2*Pi*ip/rgrid(it)%r( rgrid(it)%mesh )*rgrid(it)%r(1:rgrid(it)%mesh) )
!upf(it)%pswfc(1:rgrid(it)%mesh,jp)=sin( 2*Pi*jp/rgrid(it)%r( rgrid(it)%mesh )*rgrid(it)%r(1:rgrid(it)%mesh) )

#ifdef __KGDEBUG

                 write(filename,"('proj-pswfc_', i3.3 ,'_', i3.3 , '.dat')" ) &
                                                                           ip,jp
                 open( 12, file = filename, action = 'write' )
                 do ir=1, rgrid(it)%mesh
                    write(12,'(3e16.6)') rgrid(it)%r(ir), &
                                       upf(it)%beta(ir,ip)* upf(it)%pswfc(ir,jp)
                 enddo
                 close(12)

#endif

                 integrand(1:rgrid(it)%mesh) = & 
                                             upf(it)%beta(1:rgrid(it)%mesh,ip) &
                                            * upf(it)%pswfc(1:rgrid(it)%mesh,jp)
                 call simpson( rgrid(it)%mesh, integrand, rgrid(it)%rab, integral )

                 if ( upf(it)%lll(ip) == upf(it)%lll(jp) ) then
                    write(stdout,'(6x,1I4,7x,I1, 4x , 1I4,7x,I1, 9x, f10.6)') &
                         ip,upf(it)%lll(ip),jp,upf(it)%lll(jp), integral
                 else
                    write(stdout,'(6x,1I4,7x,I1, 4x , 1I4,7x,I1, 9x, A)') &
                         ip,upf(it)%lll(ip),jp,upf(it)%lll(jp), &
                         '  0.0_DP    (orthogonal by angular momentum)'
                 endif

              enddo
           enddo
           deallocate(integrand)
        enddo

     end subroutine check_p_pswfc


     subroutine Imatrices_csh
     ! I matrices using complex spherical harmonics
     implicit none

         I_r     = (0.0_DP,0.0_DP)
         I_theta = (0.0_DP,0.0_DP)
         I_phi   = (0.0_DP,0.0_DP)

         I_r(1,-1,0,0,1) = cmplx( 1.0_DP/sqrt(6.0_DP), 0.0_DP )
         I_r(1,1,0,0,1) = cmplx( -1.0_DP/sqrt(6.0_DP), 0.0_DP )
         I_r(0,0,1,-1,1) = cmplx( 1.0_DP/sqrt(6.0_DP), 0.0_DP )
         I_r(2,-2,1,-1,1) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,0,1,-1,1) = cmplx( -1.0_DP/sqrt(30.0_DP), 0.0_DP )
         I_r(2,-1,1,0,1) = cmplx( 1.0_DP/sqrt(10.0_DP), 0.0_DP )
         I_r(2,1,1,0,1) = cmplx( -1.0_DP/sqrt(10.0_DP), 0.0_DP )
         I_r(0,0,1,1,1) = cmplx( -1.0_DP/sqrt(6.0_DP), 0.0_DP )
         I_r(2,0,1,1,1) = cmplx( 1.0_DP/sqrt(30.0_DP), 0.0_DP )
         I_r(2,2,1,1,1) = cmplx( -1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(1,-1,2,-2,1) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(3,-3,2,-2,1) = cmplx( 3.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_r(3,-1,2,-2,1) = cmplx( -1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(1,0,2,-1,1) = cmplx( 1.0_DP/sqrt(10.0_DP), 0.0_DP )
         I_r(3,-2,2,-1,1) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(3,0,2,-1,1) = cmplx( -3.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_r(1,-1,2,0,1) = cmplx( -1.0_DP/sqrt(30.0_DP), 0.0_DP )
         I_r(1,1,2,0,1) = cmplx( 1.0_DP/sqrt(30.0_DP), 0.0_DP )
         I_r(3,-1,2,0,1) = cmplx( 3.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_r(3,1,2,0,1) = cmplx( -3.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_r(1,0,2,1,1) = cmplx( -1.0_DP/sqrt(10.0_DP), 0.0_DP )
         I_r(3,0,2,1,1) = cmplx( 3.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_r(3,2,2,1,1) = cmplx( -1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(1,1,2,2,1) = cmplx( -1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(3,1,2,2,1) = cmplx( 1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(3,3,2,2,1) = cmplx( -3.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_r(2,-2,3,-3,1) = cmplx( 3.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_r(2,-1,3,-2,1) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(2,-2,3,-1,1) = cmplx( -1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(2,0,3,-1,1) = cmplx( 3.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_r(2,-1,3,0,1) = cmplx( -3.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_r(2,1,3,0,1) = cmplx( 3.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_r(2,0,3,1,1) = cmplx( -3.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_r(2,2,3,1,1) = cmplx( 1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(2,1,3,2,1) = cmplx( -1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(2,2,3,3,1) = cmplx( -3.0_DP/sqrt(42.0_DP), 0.0_DP )

         I_r(1,-1,0,0,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(6.0_DP) )
         I_r(1,1,0,0,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(6.0_DP) )
         I_r(0,0,1,-1,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(6.0_DP) )
         I_r(2,-2,1,-1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(5.0_DP) )
         I_r(2,0,1,-1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(30.0_DP) )
         I_r(2,-1,1,0,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(10.0_DP) )
         I_r(2,1,1,0,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(10.0_DP) )
         I_r(0,0,1,1,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(6.0_DP) )
         I_r(2,0,1,1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(30.0_DP) )
         I_r(2,2,1,1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(5.0_DP) )
         I_r(1,-1,2,-2,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(5.0_DP) )
         I_r(3,-3,2,-2,2) = cmplx( 0.0_DP, 3.0_DP/sqrt(42.0_DP) )
         I_r(3,-1,2,-2,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(70.0_DP) )
         I_r(1,0,2,-1,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(10.0_DP) )
         I_r(3,-2,2,-1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(7.0_DP) )
         I_r(3,0,2,-1,2) = cmplx( 0.0_DP, 3.0_DP/sqrt(210.0_DP) )
         I_r(1,-1,2,0,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(30.0_DP) )
         I_r(1,1,2,0,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(30.0_DP) )
         I_r(3,-1,2,0,2) = cmplx( 0.0_DP, 3.0_DP/sqrt(105.0_DP) )
         I_r(3,1,2,0,2) = cmplx( 0.0_DP, 3.0_DP/sqrt(105.0_DP) )
         I_r(1,0,2,1,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(10.0_DP) )
         I_r(3,0,2,1,2) = cmplx( 0.0_DP, 3.0_DP/sqrt(210.0_DP) )
         I_r(3,2,2,1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(7.0_DP) )
         I_r(1,1,2,2,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(5.0_DP) )
         I_r(3,1,2,2,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(70.0_DP) )
         I_r(3,3,2,2,2) = cmplx( 0.0_DP, 3.0_DP/sqrt(42.0_DP) )
         I_r(2,-2,3,-3,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(42.0_DP) )
         I_r(2,-1,3,-2,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(7.0_DP) )
         I_r(2,-2,3,-1,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(70.0_DP) )
         I_r(2,0,3,-1,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(105.0_DP) )
         I_r(2,-1,3,0,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(210.0_DP) )
         I_r(2,1,3,0,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(210.0_DP) )
         I_r(2,0,3,1,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(105.0_DP) )
         I_r(2,2,3,1,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(70.0_DP) )
         I_r(2,1,3,2,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(7.0_DP) )
         I_r(2,2,3,3,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(42.0_DP) )

         I_r(1,0,0,0,3) = cmplx( 1.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_r(2,-1,1,-1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(0,0,1,0,3) = cmplx( 1.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_r(2,0,1,0,3) = cmplx( 2.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_r(2,1,1,1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(3,-2,2,-2,3) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(1,-1,2,-1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(3,-1,2,-1,3) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(1,0,2,0,3) = cmplx( 2.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_r(3,0,2,0,3) = cmplx( 3.0_DP/sqrt(35.0_DP), 0.0_DP )
         I_r(1,1,2,1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(3,1,2,1,3) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(3,2,2,2,3) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(2,-2,3,-2,3) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(2,-1,3,-1,3) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(2,0,3,0,3) = cmplx( 3.0_DP/sqrt(35.0_DP), 0.0_DP )
         I_r(2,1,3,1,3) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(2,2,3,2,3) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )

         I_theta(0,0,1,-1,1) = cmplx( -1.0_DP/sqrt(24.0_DP), 0.0_DP )
         I_theta(2,-2,1,-1,1) = cmplx( -1.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_theta(2,0,1,-1,1) = cmplx( -1.0_DP/sqrt(30.0_DP), 0.0_DP )
         I_theta(2,-1,1,0,1) = cmplx( -1.0_DP/sqrt(10.0_DP), 0.0_DP )
         I_theta(2,1,1,0,1) = cmplx( 1.0_DP/sqrt(10.0_DP), 0.0_DP )
         I_theta(0,0,1,1,1) = cmplx( 1.0_DP/sqrt(24.0_DP), 0.0_DP )
         I_theta(2,0,1,1,1) = cmplx( 1.0_DP/sqrt(30.0_DP), 0.0_DP )
         I_theta(2,2,1,1,1) = cmplx( 1.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_theta(1,-1,2,-2,1) = cmplx( 1.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_theta(3,-3,2,-2,1) = cmplx( 1.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_theta(3,-1,2,-2,1) = cmplx( 2.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(1,0,2,-1,1) = cmplx( -1.0_DP/sqrt(40.0_DP), 0.0_DP )
         I_theta(3,-2,2,-1,1) = cmplx( 1.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_theta(3,0,2,-1,1) = cmplx( -6.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_theta(1,-1,2,0,1) = cmplx( -3.0_DP/sqrt(30.0_DP), 0.0_DP )
         I_theta(1,1,2,0,1) = cmplx( 3.0_DP/sqrt(30.0_DP), 0.0_DP )
         I_theta(3,-1,2,0,1) = cmplx( -6.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_theta(3,1,2,0,1) = cmplx( 6.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_theta(1,0,2,1,1) = cmplx( 1.0_DP/sqrt(40.0_DP), 0.0_DP )
         I_theta(3,0,2,1,1) = cmplx( 6.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_theta(3,2,2,1,1) = cmplx( -1.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_theta(1,1,2,2,1) = cmplx( -1.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_theta(3,1,2,2,1) = cmplx( -2.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(3,3,2,2,1) = cmplx( -1.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_theta(2,-2,3,-3,1) = cmplx( -3.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_theta(2,-1,3,-2,1) = cmplx( 1.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_theta(0,0,3,-1,1) = cmplx( 7.0_DP/sqrt(336.0_DP), 0.0_DP )
         I_theta(2,-2,3,-1,1) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(2,0,3,-1,1) = cmplx( -13.0_DP/sqrt(1680.0_DP), 0.0_DP )
         I_theta(2,-1,3,0,1) = cmplx( -12.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_theta(2,1,3,0,1) = cmplx( 12.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_theta(0,0,3,1,1) = cmplx( -7.0_DP/sqrt(336.0_DP), 0.0_DP )
         I_theta(2,0,3,1,1) = cmplx( 13.0_DP/sqrt(1680.0_DP), 0.0_DP )
         I_theta(2,2,3,1,1) = cmplx( -4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(2,1,3,2,1) = cmplx( -1.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_theta(2,2,3,3,1) = cmplx( 3.0_DP/sqrt(168.0_DP), 0.0_DP )

         I_theta(0,0,1,-1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(24.0_DP) )
         I_theta(2,-2,1,-1,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(80.0_DP) )
         I_theta(2,0,1,-1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(30.0_DP) )
         I_theta(2,-1,1,0,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(10.0_DP) )
         I_theta(2,1,1,0,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(10.0_DP) )
         I_theta(0,0,1,1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(24.0_DP) )
         I_theta(2,0,1,1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(30.0_DP) )
         I_theta(2,2,1,1,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(80.0_DP) )
         I_theta(1,-1,2,-2,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(20.0_DP) )
         I_theta(3,-3,2,-2,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(42.0_DP) )
         I_theta(3,-1,2,-2,2) = cmplx( 0.0_DP, -2.0_DP/sqrt(70.0_DP) )
         I_theta(1,0,2,-1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(40.0_DP) )
         I_theta(3,-2,2,-1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(112.0_DP) )
         I_theta(3,0,2,-1,2) = cmplx( 0.0_DP, 6.0_DP/sqrt(210.0_DP) )
         I_theta(1,-1,2,0,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(30.0_DP) )
         I_theta(1,1,2,0,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(30.0_DP) )
         I_theta(3,-1,2,0,2) = cmplx( 0.0_DP, -6.0_DP/sqrt(105.0_DP) )
         I_theta(3,1,2,0,2) = cmplx( 0.0_DP, -6.0_DP/sqrt(105.0_DP) )
         I_theta(1,0,2,1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(40.0_DP) )
         I_theta(3,0,2,1,2) = cmplx( 0.0_DP, 6.0_DP/sqrt(210.0_DP) )
         I_theta(3,2,2,1,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(112.0_DP) )
         I_theta(1,1,2,2,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(20.0_DP) )
         I_theta(3,1,2,2,2) = cmplx( 0.0_DP, -2.0_DP/sqrt(70.0_DP) )
         I_theta(3,3,2,2,2) = cmplx( 0.0_DP, 1.0_DP/sqrt(42.0_DP) )
         I_theta(2,-2,3,-3,2) = cmplx( 0.0_DP, 3.0_DP/sqrt(168.0_DP) )
         I_theta(2,-1,3,-2,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(28.0_DP) )
         I_theta(0,0,3,-1,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(336.0_DP) )
         I_theta(2,-2,3,-1,2) = cmplx( 0.0_DP, 4.0_DP/sqrt(70.0_DP) )
         I_theta(2,0,3,-1,2) = cmplx( 0.0_DP, 13.0_DP/sqrt(1680.0_DP) )
         I_theta(2,-1,3,0,2) = cmplx( 0.0_DP, -12.0_DP/sqrt(210.0_DP) )
         I_theta(2,1,3,0,2) = cmplx( 0.0_DP, -12.0_DP/sqrt(210.0_DP) )
         I_theta(0,0,3,1,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(336.0_DP) )
         I_theta(2,0,3,1,2) = cmplx( 0.0_DP, 13.0_DP/sqrt(1680.0_DP) )
         I_theta(2,2,3,1,2) = cmplx( 0.0_DP, 4.0_DP/sqrt(70.0_DP) )
         I_theta(2,1,3,2,2) = cmplx( 0.0_DP, -1.0_DP/sqrt(28.0_DP) )
         I_theta(2,2,3,3,2) = cmplx( 0.0_DP, 3.0_DP/sqrt(168.0_DP) )

         I_theta(2,-1,1,-1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(0,0,1,0,3) = cmplx( 2.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_theta(2,0,1,0,3) = cmplx( -2.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_theta(2,1,1,1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(3,-2,2,-2,3) = cmplx( -2.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_theta(1,-1,2,-1,3) = cmplx( -3.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(3,-1,2,-1,3) = cmplx( 8.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(1,0,2,0,3) = cmplx( 6.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_theta(3,0,2,0,3) = cmplx( -6.0_DP/sqrt(35.0_DP), 0.0_DP )
         I_theta(1,1,2,1,3) = cmplx( -3.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(3,1,2,1,3) = cmplx( 8.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(3,2,2,2,3) = cmplx( -2.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_theta(2,-2,3,-2,3) = cmplx( 4.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_theta(2,-1,3,-1,3) = cmplx( -16.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(2,0,3,0,3) = cmplx( 12.0_DP/sqrt(35.0_DP), 0.0_DP )
         I_theta(2,1,3,1,3) = cmplx( -16.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(2,2,3,2,3) = cmplx( 4.0_DP/sqrt(7.0_DP), 0.0_DP )

         I_phi(0,0,1,-1,1) = cmplx( 3.0_DP/sqrt(24.0_DP), 0.0_DP )
         I_phi(2,-2,1,-1,1) = cmplx( -5.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_phi(0,0,1,1,1) = cmplx( -3.0_DP/sqrt(24.0_DP), 0.0_DP )
         I_phi(2,2,1,1,1) = cmplx( 5.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_phi(1,-1,2,-2,1) = cmplx( 5.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_phi(3,-3,2,-2,1) = cmplx( -7.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_phi(1,0,2,-1,1) = cmplx( 5.0_DP/sqrt(40.0_DP), 0.0_DP )
         I_phi(3,-2,2,-1,1) = cmplx( -7.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_phi(1,0,2,1,1) = cmplx( -5.0_DP/sqrt(40.0_DP), 0.0_DP )
         I_phi(3,2,2,1,1) = cmplx( 7.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_phi(1,1,2,2,1) = cmplx( -5.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_phi(3,3,2,2,1) = cmplx( 7.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_phi(2,-2,3,-3,1) = cmplx( 21.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_phi(2,-1,3,-2,1) = cmplx( 7.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_phi(0,0,3,-1,1) = cmplx( 7.0_DP/sqrt(336.0_DP), 0.0_DP )
         I_phi(2,0,3,-1,1) = cmplx( 35.0_DP/sqrt(1680.0_DP), 0.0_DP )
         I_phi(0,0,3,1,1) = cmplx( -7.0_DP/sqrt(336.0_DP), 0.0_DP )
         I_phi(2,0,3,1,1) = cmplx( -35.0_DP/sqrt(1680.0_DP), 0.0_DP )
         I_phi(2,1,3,2,1) = cmplx( -7.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_phi(2,2,3,3,1) = cmplx( -21.0_DP/sqrt(168.0_DP), 0.0_DP )

         I_phi(0,0,1,-1,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(24.0_DP) )
         I_phi(2,-2,1,-1,2) = cmplx( 0.0_DP, -5.0_DP/sqrt(80.0_DP) )
         I_phi(0,0,1,1,2) = cmplx( 0.0_DP, -3.0_DP/sqrt(24.0_DP) )
         I_phi(2,2,1,1,2) = cmplx( 0.0_DP, -5.0_DP/sqrt(80.0_DP) )
         I_phi(1,-1,2,-2,2) = cmplx( 0.0_DP, -5.0_DP/sqrt(20.0_DP) )
         I_phi(3,-3,2,-2,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(42.0_DP) )
         I_phi(1,0,2,-1,2) = cmplx( 0.0_DP, -5.0_DP/sqrt(40.0_DP) )
         I_phi(3,-2,2,-1,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(112.0_DP) )
         I_phi(1,0,2,1,2) = cmplx( 0.0_DP, -5.0_DP/sqrt(40.0_DP) )
         I_phi(3,2,2,1,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(112.0_DP) )
         I_phi(1,1,2,2,2) = cmplx( 0.0_DP, -5.0_DP/sqrt(20.0_DP) )
         I_phi(3,3,2,2,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(42.0_DP) )
         I_phi(2,-2,3,-3,2) = cmplx( 0.0_DP, -21.0_DP/sqrt(168.0_DP) )
         I_phi(2,-1,3,-2,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(28.0_DP) )
         I_phi(0,0,3,-1,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(336.0_DP) )
         I_phi(2,0,3,-1,2) = cmplx( 0.0_DP, -35.0_DP/sqrt(1680.0_DP) )
         I_phi(0,0,3,1,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(336.0_DP) )
         I_phi(2,0,3,1,2) = cmplx( 0.0_DP, -35.0_DP/sqrt(1680.0_DP) )
         I_phi(2,1,3,2,2) = cmplx( 0.0_DP, -7.0_DP/sqrt(28.0_DP) )
         I_phi(2,2,3,3,2) = cmplx( 0.0_DP, -21.0_DP/sqrt(168.0_DP) )

    end subroutine Imatrices_csh


    subroutine Imatrices_rsh
    ! I matrices using Real Spherical Harmonics

         I_r     = (0.0_DP,0.0_DP)
         I_theta = (0.0_DP,0.0_DP)
         I_phi   = (0.0_DP,0.0_DP)

         I_r(0,0,1,1,1) = cmplx( 1.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_r(1,-1,2,-2,1) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(1,0,2,1,1) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(1,1,0,0,1) = cmplx( 1.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_r(1,1,2,0,1) = cmplx( -1.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_r(1,1,2,2,1) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,-2,1,-1,1) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,-2,3,-3,1) = cmplx( 3.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_r(2,-2,3,-1,1) = cmplx( -1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(2,-1,3,-2,1) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(2,0,1,1,1) = cmplx( -1.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_r(2,0,3,1,1) = cmplx( 6.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_r(2,1,1,0,1) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,1,3,0,1) = cmplx( -3.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_r(2,1,3,2,1) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(2,2,1,1,1) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,2,3,1,1) = cmplx( -1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(2,2,3,3,1) = cmplx( 3.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_r(3,-3,2,-2,1) = cmplx( 3.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_r(3,-2,2,-1,1) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(3,-1,2,-2,1) = cmplx( -1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(3,0,2,1,1) = cmplx( -3.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_r(3,1,2,0,1) = cmplx( 6.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_r(3,1,2,2,1) = cmplx( -1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(3,2,2,1,1) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(3,3,2,2,1) = cmplx( 3.0_DP/sqrt(42.0_DP), 0.0_DP )

         I_r(0,0,1,-1,2) = cmplx( 1.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_r(1,-1,0,0,2) = cmplx( 1.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_r(1,-1,2,0,2) = cmplx( -1.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_r(1,-1,2,2,2) = cmplx( -1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(1,0,2,-1,2) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(1,1,2,-2,2) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,-2,1,1,2) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,-2,3,1,2) = cmplx( -1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(2,-2,3,3,2) = cmplx( -3.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_r(2,-1,1,0,2) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,-1,3,0,2) = cmplx( -3.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_r(2,-1,3,2,2) = cmplx( -1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(2,0,1,-1,2) = cmplx( -1.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_r(2,0,3,-1,2) = cmplx( 6.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_r(2,1,3,-2,2) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(2,2,1,-1,2) = cmplx( -1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,2,3,-3,2) = cmplx( 3.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_r(2,2,3,-1,2) = cmplx( 1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(3,-3,2,2,2) = cmplx( 3.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_r(3,-2,2,1,2) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(3,-1,2,0,2) = cmplx( 6.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_r(3,-1,2,2,2) = cmplx( 1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(3,0,2,-1,2) = cmplx( -3.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_r(3,1,2,-2,2) = cmplx( -1.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(3,2,2,-1,2) = cmplx( -1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(3,3,2,-2,2) = cmplx( -3.0_DP/sqrt(42.0_DP), 0.0_DP )

         I_r(0,0,1,0,3) = cmplx( 1.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_r(1,-1,2,-1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(1,0,0,0,3) = cmplx( 1.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_r(1,0,2,0,3) = cmplx( 2.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_r(1,1,2,1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,-2,3,-2,3) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(2,-1,1,-1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,-1,3,-1,3) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(2,0,1,0,3) = cmplx( 2.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_r(2,0,3,0,3) = cmplx( 3.0_DP/sqrt(35.0_DP), 0.0_DP )
         I_r(2,1,1,1,3) = cmplx( 1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_r(2,1,3,1,3) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(2,2,3,2,3) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(3,-2,2,-2,3) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_r(3,-1,2,-1,3) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(3,0,2,0,3) = cmplx( 3.0_DP/sqrt(35.0_DP), 0.0_DP )
         I_r(3,1,2,1,3) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_r(3,2,2,2,3) = cmplx( 1.0_DP/sqrt(7.0_DP), 0.0_DP )

         I_theta(0,0,1,1,1) = cmplx( 1.0_DP/sqrt(12.0_DP), 0.0_DP )
         I_theta(0,0,3,1,1) = cmplx( -7.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_theta(1,-1,2,-2,1) = cmplx( 1.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_theta(1,0,2,1,1) = cmplx( 1.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_theta(1,1,2,0,1) = cmplx( -3.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_theta(1,1,2,2,1) = cmplx( 1.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_theta(2,-2,1,-1,1) = cmplx( 1.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_theta(2,-2,3,-3,1) = cmplx( 3.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_theta(2,-2,3,-1,1) = cmplx( -4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(2,-1,3,-2,1) = cmplx( 1.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_theta(2,0,1,1,1) = cmplx( 1.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_theta(2,0,3,1,1) = cmplx( 13.0_DP/sqrt(840.0_DP), 0.0_DP )
         I_theta(2,1,1,0,1) = cmplx( -1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(2,1,3,0,1) = cmplx( -12.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_theta(2,1,3,2,1) = cmplx( 1.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_theta(2,2,1,1,1) = cmplx( 1.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_theta(2,2,3,1,1) = cmplx( -4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(2,2,3,3,1) = cmplx( 3.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_theta(3,-3,2,-2,1) = cmplx( 1.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_theta(3,-2,2,-1,1) = cmplx( -1.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_theta(3,-1,2,-2,1) = cmplx( 2.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(3,0,2,1,1) = cmplx( 6.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_theta(3,1,2,0,1) = cmplx( -12.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_theta(3,1,2,2,1) = cmplx( 2.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(3,2,2,1,1) = cmplx( -1.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_theta(3,3,2,2,1) = cmplx( 1.0_DP/sqrt(42.0_DP), 0.0_DP )

         I_theta(0,0,1,-1,2) = cmplx( 1.0_DP/sqrt(12.0_DP), 0.0_DP )
         I_theta(0,0,3,-1,2) = cmplx( -7.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_theta(1,-1,2,0,2) = cmplx( -3.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_theta(1,-1,2,2,2) = cmplx( -1.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_theta(1,0,2,-1,2) = cmplx( 1.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_theta(1,1,2,-2,2) = cmplx( 1.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_theta(2,-2,1,1,2) = cmplx( 1.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_theta(2,-2,3,1,2) = cmplx( -4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(2,-2,3,3,2) = cmplx( -3.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_theta(2,-1,1,0,2) = cmplx( -1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(2,-1,3,0,2) = cmplx( -12.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_theta(2,-1,3,2,2) = cmplx( -1.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_theta(2,0,1,-1,2) = cmplx( 1.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_theta(2,0,3,-1,2) = cmplx( 13.0_DP/sqrt(840.0_DP), 0.0_DP )
         I_theta(2,1,3,-2,2) = cmplx( 1.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_theta(2,2,1,-1,2) = cmplx( -1.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_theta(2,2,3,-3,2) = cmplx( 3.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_theta(2,2,3,-1,2) = cmplx( 4.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(3,-3,2,2,2) = cmplx( 1.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_theta(3,-2,2,1,2) = cmplx( -1.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_theta(3,-1,2,0,2) = cmplx( -12.0_DP/sqrt(210.0_DP), 0.0_DP )
         I_theta(3,-1,2,2,2) = cmplx( -2.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(3,0,2,-1,2) = cmplx( 6.0_DP/sqrt(105.0_DP), 0.0_DP )
         I_theta(3,1,2,-2,2) = cmplx( 2.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(3,2,2,-1,2) = cmplx( 1.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_theta(3,3,2,-2,2) = cmplx( -1.0_DP/sqrt(42.0_DP), 0.0_DP )

         I_theta(0,0,1,0,3) = cmplx( 2.0_DP/sqrt(3.0_DP), 0.0_DP )
         I_theta(1,-1,2,-1,3) = cmplx( 3.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(1,0,2,0,3) = cmplx( 6.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_theta(1,1,2,1,3) = cmplx( 3.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(2,-2,3,-2,3) = cmplx( 4.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_theta(2,-1,1,-1,3) = cmplx( -1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(2,-1,3,-1,3) = cmplx( 16.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(2,0,1,0,3) = cmplx( -2.0_DP/sqrt(15.0_DP), 0.0_DP )
         I_theta(2,0,3,0,3) = cmplx( 12.0_DP/sqrt(35.0_DP), 0.0_DP )
         I_theta(2,1,1,1,3) = cmplx( -1.0_DP/sqrt(5.0_DP), 0.0_DP )
         I_theta(2,1,3,1,3) = cmplx( 16.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(2,2,3,2,3) = cmplx( 4.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_theta(3,-2,2,-2,3) = cmplx( -2.0_DP/sqrt(7.0_DP), 0.0_DP )
         I_theta(3,-1,2,-1,3) = cmplx( -8.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(3,0,2,0,3) = cmplx( -6.0_DP/sqrt(35.0_DP), 0.0_DP )
         I_theta(3,1,2,1,3) = cmplx( -8.0_DP/sqrt(70.0_DP), 0.0_DP )
         I_theta(3,2,2,2,3) = cmplx( -2.0_DP/sqrt(7.0_DP), 0.0_DP )

         I_phi(0,0,1,1,1) = cmplx( 3.0_DP/sqrt(12.0_DP), 0.0_DP )
         I_phi(0,0,3,1,1) = cmplx( 7.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_phi(1,-1,2,-2,1) = cmplx( 5.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_phi(1,0,2,1,1) = cmplx( 5.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_phi(1,1,2,2,1) = cmplx( 5.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_phi(2,-2,1,-1,1) = cmplx( -5.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_phi(2,-2,3,-3,1) = cmplx( 21.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_phi(2,-1,3,-2,1) = cmplx( 7.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_phi(2,0,3,1,1) = cmplx( 35.0_DP/sqrt(840.0_DP), 0.0_DP )
         I_phi(2,1,3,2,1) = cmplx( 7.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_phi(2,2,1,1,1) = cmplx( -5.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_phi(2,2,3,3,1) = cmplx( 21.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_phi(3,-3,2,-2,1) = cmplx( -7.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_phi(3,-2,2,-1,1) = cmplx( -7.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_phi(3,2,2,1,1) = cmplx( -7.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_phi(3,3,2,2,1) = cmplx( -7.0_DP/sqrt(42.0_DP), 0.0_DP )

         I_phi(0,0,1,-1,2) = cmplx( 3.0_DP/sqrt(12.0_DP), 0.0_DP )
         I_phi(0,0,3,-1,2) = cmplx( 7.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_phi(1,-1,2,2,2) = cmplx( -5.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_phi(1,0,2,-1,2) = cmplx( 5.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_phi(1,1,2,-2,2) = cmplx( 5.0_DP/sqrt(20.0_DP), 0.0_DP )
         I_phi(2,-2,1,1,2) = cmplx( -5.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_phi(2,-2,3,3,2) = cmplx( -21.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_phi(2,-1,3,2,2) = cmplx( -7.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_phi(2,0,3,-1,2) = cmplx( 35.0_DP/sqrt(840.0_DP), 0.0_DP )
         I_phi(2,1,3,-2,2) = cmplx( 7.0_DP/sqrt(28.0_DP), 0.0_DP )
         I_phi(2,2,1,-1,2) = cmplx( 5.0_DP/sqrt(80.0_DP), 0.0_DP )
         I_phi(2,2,3,-3,2) = cmplx( 21.0_DP/sqrt(168.0_DP), 0.0_DP )
         I_phi(3,-3,2,2,2) = cmplx( -7.0_DP/sqrt(42.0_DP), 0.0_DP )
         I_phi(3,-2,2,1,2) = cmplx( -7.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_phi(3,2,2,-1,2) = cmplx( 7.0_DP/sqrt(112.0_DP), 0.0_DP )
         I_phi(3,3,2,-2,2) = cmplx( 7.0_DP/sqrt(42.0_DP), 0.0_DP )

    end subroutine Imatrices_rsh


    subroutine awfc_grad_awfc( )
    ! Gradient matrix elements over atomic orbitals     (awfc_grad_awfc)
    ! Gradient matrix elements over atomic pseudorbital (pswfc_grad_pswfc)

    ! Not in used replaced by diff_* to minimize the problem with spurious
    ! oscillations in the atomic waves and projectors 
    
     implicit none

        integer :: it, ip1, ip2
        integer :: il1, il2, im1, im2, ipall1, ipall2
        
        complex(DP), allocatable ::atwfc_grad_atwfc(:,:,:), pswfc_grad_pswfc(:,:,:)

        if (use_real_spherical_harm) then 
           call Imatrices_rsh
        else
           call Imatrices_csh
        endif 

        call Rmatrices
        call set_indexes

        allocate( atwfc_grad_atwfc( 1:3, 1:n_pro_type_tot, 1:n_pro_type_tot ), STAT=ierr )
        if (ierr/=0) call errore('kgec:awfc_grad_awfc','allocating atwfc_grad_atwfc',ABS(ierr))

        allocate( pswfc_grad_pswfc( 1:3, 1:n_pro_type_tot, 1:n_pro_type_tot ), STAT=ierr )
        if (ierr/=0) call errore('kgec:awfc_grad_awfc','allocating pswfc_gradpstwfc',ABS(ierr))

       ! Matrix elements of the gradient operator over the atomic orbitals (atwfc_grad_atwfc)
       ! stored on collective counters on projectors (beta or kb in QE) ordered by type of atoms as
       ! in becp (=<beta|\psi>), which inherites that from vkb (see init_us_2.f90)


        do it = 1, ntyp

            do ip1 = 1, upf(it)%nbeta
               il1 = upf(it)%lll(ip1)

               do im1 = -il1, il1
                  ipall1 = plm_index( it, ip1, im1)

                  do ip2 = 1, upf(it)%nbeta
                     il2 = upf(it)%lll(ip2)

                     do im2 = -il2, il2
                        ipall2 = plm_index( it, ip2, im2)

                        atwfc_grad_atwfc( 1:3, ipall2, ipall1 ) = &
                          Rd(it,ip2,ip1) * I_r(il2,im2,il1,im1,1:3) &
                           + R(it,ip2,ip1) * (   I_theta(il2,im2,il1,im1,1:3) &
                                               + I_phi  (il2,im2,il1,im1,1:3)   )

                     enddo
                  enddo

               enddo
            enddo

        enddo


        ! Matrix elements of the gradient operator over the atomic pseudo orbitals (pswfc_grad_pswfc)
        ! storaged on collective counters on projectors (beta or kb in QE) ordered by type of atoms as
        ! in becp (=<beta|\psi>), which inherites that from vkb (see init_us_2.f90)

        do it  = 1, ntyp

           do ip1 = 1, upf(it)%nbeta
              il1 = upf(it)%lll(ip1)

              do im1 = -il1, il1
                 ipall1 = plm_index( it, ip1, im1 )

                 do ip2 = 1, upf(it)%nbeta
                    il2 = upf(it)%lll(ip2)

                    do im2 = -il2, il2
                       ipall2 = plm_index( it, ip2, im2 )

                       pswfc_grad_pswfc( 1:3, ipall2, ipall1 ) = &
                          pRd(it,ip2,ip1) * I_r(il2,im2,il1,im1,1:3) &
                            + pR(it,ip2,ip1) * (   I_theta(il2,im2,il1,im1,1:3) &
                                                 + I_phi  (il2,im2,il1,im1,1:3)   )

                    enddo
                 enddo

              enddo
           enddo

        enddo


#ifdef __KGDEBUG

        open(11,file="Dx.dat",action='write')
        write(11,*) "#  <\phi|\nabla_x|\phi> - <\~\phi|nabla_x|\~\phi> "
        open(12,file="Dy.dat",action='write')
        write(12,*) " # <\phi|\nabla_y|\phi> - <\~\phi|nabla_y|\~\phi> "
        open(13,file="Dz.dat",action='write')
        write(13,*) " # <\phi|\nabla_z|\phi> - <\~\phi|nabla_z|\~\phi> "



        do it  = 1, ntyp

           do ip2 = 1, upf(it)%nbeta
              il2 = upf(it)%lll(ip2)

              do im2 = -il2, il2
                 ipall2 = plm_index( it, ip2, im2 )


                 do ip1 = 1, upf(it)%nbeta
                    il1 = upf(it)%lll(ip1)

                    do im1 = -il1, il1
                       ipall1 = plm_index( it, ip1, im1 )

                       write(11,'(2i4,2x,(2g14.6))') ipall1, ipall2, atwfc_grad_atwfc( 1, ipall1, ipall2 ) - pswfc_grad_pswfc( 1, ipall1, ipall2 )
                       write(12,'(2i4,2x,(2g14.6))') ipall1, ipall2, atwfc_grad_atwfc( 2, ipall1, ipall2 ) - pswfc_grad_pswfc( 2, ipall1, ipall2 )
                       write(13,'(2i4,2x,(2g14.6))') ipall1, ipall2, atwfc_grad_atwfc( 3, ipall1, ipall2 ) - pswfc_grad_pswfc( 3, ipall1, ipall2 )

                    enddo
                 enddo
              enddo
           enddo


        enddo
        close(11)
        close(12)
        close(13)


        open(21,file="I-x.dat",action='write')
        write(21,*) "#  I_r I_theta I_phi (x components)"
        open(22,file="I-y.dat",action='write')
        write(22,*) "# I_r I_theta I_phi (y components)"
        open(23,file="I-z.dat",action='write')
        write(23,*) "# I_r I_theta I_phi (z components)"

        ipall1=0 ! dummy for ilm collective index
        do il1=0, 3
           do im1=-il1, il1
              ipall1=ipall1+1
              ipall2=0           ! dummy for ilm collective index
              do il2=0, 3
                 do im2=-il2, il2
                    ipall2=ipall2+1

                       write(21,'(6i3,2x,(3(2g13.6)))') ipall1, ipall2, il1, im1, il2, im2, I_r(il1,im1,il2,im2,1), I_theta(il1,im1,il2,im2,1), I_phi(il1,im1,il2,im2,1)
                       write(22,'(6i3,2x,(3(2g13.6)))') ipall1, ipall2, il1, im1, il2, im2, I_r(il1,im1,il2,im2,2), I_theta(il1,im1,il2,im2,2), I_phi(il1,im1,il2,im2,2)
                       write(23,'(6i3,2x,(3(2g13.6)))') ipall1, ipall2, il1, im1, il2, im2, I_r(il1,im1,il2,im2,3), I_theta(il1,im1,il2,im2,3), I_phi(il1,im1,il2,im2,3)

                 enddo
              enddo
           enddo
        enddo

        close(21)
        close(22)
        close(23)

#endif

    end subroutine awfc_grad_awfc


    subroutine diff_awfc_grad_awfc( )
    !
    ! Difference between gradient matrix elements over atomic orbitals
    !  DG = awfc_grad_awfc - pswfc_grad_pswfc
    !
    implicit none

        integer :: it, ip1, ip2
        integer :: il1, il2, im1, im2, ipall1, ipall2


        if ( use_real_spherical_harm ) then 
           call Imatrices_rsh
        else
           call Imatrices_csh
        endif

        call Rmatrices

        call set_indexes


       ! Matrix  of the elements of the gradient operator over the atomic orbitals
       ! atwfc_grad_atwfc - pswfc_grad_pswfc,
       ! stored on collective counters on projectors (beta or kb in QE) ordered by type of atoms as
       ! in becp (=<beta|\psi>), which inherites that from vkb (see init_us_2.f90)

        allocate( DG(1:3,n_pro_type_tot, n_pro_type_tot) )
        DG(1:3,n_pro_type_tot, n_pro_type_tot) = cmplx( 0.0_DP, 0.0_DP )

        ipall1 = 0
        ipall2 = 0

        do it = 1, ntyp

            do ip1 = 1, upf(it)%nbeta
               il1 = upf(it)%lll(ip1)

               do im1    = -il1, il1
                  ipall1 = plm_index(it,ip1,im1)

                  do ip2 = 1, upf(it)%nbeta
                     il2 = upf(it)%lll(ip2)

                     do im2    = -il2, il2
                        ipall2 = plm_index(it,ip2,im2)

                        DG( 1:3, ipall2, ipall1 ) = &
                               ( Rd(it,ip2,ip1) - pRd(it,ip2,ip1) ) * I_r(il2,im2,il1,im1,1:3) &
                             + ( R(it,ip2,ip1) - pR(it,ip2,ip1) ) &
                               * ( I_theta(il2,im2,il1,im1,1:3) &
                                    + I_phi(il2,im2,il1,im1,1:3) )

                     enddo ! im2
                  enddo ! im1

               enddo ! ip2
            enddo ! ip1

        enddo ! it


#ifdef __KGDEBUG

        open(21,file="I-x.dat",action='write')
        write(21,*) "#  I_r I_theta I_phi (x components)"
        open(22,file="I-y.dat",action='write')
        write(22,*) "# I_r I_theta I_phi (y components)"
        open(23,file="I-z.dat",action='write')
        write(23,*) "# I_r I_theta I_phi (z components)"

        ipall1=0 ! dummy for ilm collective index
        do il1=0, 3
           do im1=-il1, il1
              ipall1=ipall1+1
              ipall2=0           ! dummy for ilm collective index
              do il2=0, 3
                 do im2=-il2, il2
                    ipall2=ipall2+1

                       write(21,'(6i3,2x,(3(2g12.6)))') ipall1, ipall2, il1, im1, il2, im2, I_r(il1,im1,il2,im2,1), I_theta(il1,im1,il2,im2,1), I_phi(il1,im1,il2,im2,1)
                       write(22,'(6i3,2x,(3(2g12.6)))') ipall1, ipall2, il1, im1, il2, im2, I_r(il1,im1,il2,im2,2), I_theta(il1,im1,il2,im2,2), I_phi(il1,im1,il2,im2,2)
                       write(23,'(6i3,2x,(3(2g12.6)))') ipall1, ipall2, il1, im1, il2, im2, I_r(il1,im1,il2,im2,3), I_theta(il1,im1,il2,im2,3), I_phi(il1,im1,il2,im2,3)

                 enddo
              enddo
           enddo
        enddo

        close(21)
        close(22)
        close(23)

        open(11,file="Dx.dat",action='write')
        write(11,*) "#  <\phi|\nabla_x|\phi> - <\~\phi|nabla_x|\~\phi> "
        open(12,file="Dy.dat",action='write')
        write(12,*) " # <\phi|\nabla_y|\phi> - <\~\phi|nabla_y|\~\phi> "
        open(13,file="Dz.dat",action='write')
        write(13,*) " # <\phi|\nabla_z|\phi> - <\~\phi|nabla_z|\~\phi> "


        do it = 1, ntyp

           do ip2 = 1, upf(it)%nbeta
              il2 = upf(it)%lll(ip2)

              do im2 = -il2, il2
                 ipall2 = plm_index( it, ip2, im2 )

                 do ip1 = 1, upf(it)%nbeta
                    il1 = upf(it)%lll(ip1)

                    do im1 = -il1, il1
                       ipall1 = plm_index( it, ip1, im1 )

                       write(11,'(2i4,2x,(2g14.6))') ipall1, ipall2, DG( 1, ipall1, ipall2 )
                       write(12,'(2i4,2x,(2g14.6))') ipall1, ipall2, DG( 2, ipall1, ipall2 )
                       write(13,'(2i4,2x,(2g14.6))') ipall1, ipall2, DG( 3, ipall1, ipall2 )

                    enddo
                 enddo
              enddo
           enddo


        enddo
        close(11)
        close(12)
        close(13)

#endif

    end subroutine diff_awfc_grad_awfc

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   subroutine psi_norm_correction_paw_at( )
   !
   ! ( < Raplm| Rap'l'm'> - <pseudo Raplm| pseudo Rap'l'm'> ) <Ylm|Yl'm'>
   !

!use uspp, ONLY : qq  or qq_nt from (6.2 on)

   implicit none

      integer :: it, il1, il2, im1, im2, iaplm1, iaplm2, ip1, ip2
      real(DP) :: integral
      real(DP), allocatable :: integrand(:)
      !real(DP) :: RR, pRpR

!integer :: ih, jh

      call set_indexes

      allocate( psi_norm_correction_at(1:n_pro_type_tot,1:n_pro_type_tot), STAT=ierr )
      if (ierr/=0) call errore('kgec:awfc_grad_awfc_2','allocating psi_norm',ABS(ierr))

      psi_norm_correction_at = 0.0_dp

      do it = 1, ntyp

!jh=0

         allocate( integrand(1:rgrid(it)%mesh), STAT=ierr )
         if (ierr/=0) call errore('kgec:psi_norm_correction_paw_at','allocating integrand',ABS(ierr))


         do ip1 = 1, upf(it)%nbeta
            il1 = upf(it)%lll(ip1)
            do im1 = -il1, il1
               iaplm1 = plm_index( it, ip1, im1 )

!jh=jh+1
!ih=0

               do ip2 = 1, upf(it)%nbeta
                  il2 = upf(it)%lll(ip2)
                  do im2 = -il2, il2
                     iaplm2 = plm_index( it, ip2, im2 )

!ih=ih+1

                     ! < Rapl| Rap'l' >
                     !integrand( 1:rgrid(it)%mesh ) = upf(it)%aewfc(1:rgrid(it)%mesh,ip1) &
                     !                                * upf(it)%aewfc(1:rgrid(it)%mesh,ip2)
                     !call simpson( rgrid(it)%mesh, integrand, rgrid(it)%rab, integral )
                     !RR = integral



                     ! < pseudo Rapl| pseudo Rap'l' >
                     !integrand( 1:rgrid(it)%mesh ) = upf(it)%pswfc(1:rgrid(it)%mesh,ip1) &
                     !                                * upf(it)%pswfc(1:rgrid(it)%mesh,ip2)
                     !call simpson( rgrid(it)%mesh, integrand, rgrid(it)%rab, integral )
                     !pRpR = integral

                     !if ( il1==il2 .and. im1==im2 ) &
                     !psi_norm_correction_at( iaplm1, iaplm2 ) = RR - pRpR

                     integrand =     upf(it)%aewfc(1:rgrid(it)%mesh,ip1) &
                                   * upf(it)%aewfc(1:rgrid(it)%mesh,ip2) &
                                 -   upf(it)%pswfc(1:rgrid(it)%mesh,ip1) &
                                   * upf(it)%pswfc(1:rgrid(it)%mesh,ip2)

                     call simpson( rgrid(it)%mesh, integrand, rgrid(it)%rab, integral )

                     if ( il1==il2 .and. im1==im2 ) then
                       psi_norm_correction_at( iaplm2, iaplm1 ) = integral !qq(ih,jh,it) !integral
                     endif

                  enddo ! im2
               enddo ! ip2

            enddo ! im1
         enddo ! ip1

         deallocate( integrand )

      enddo ! it

#ifdef __KGDEBUG
      open(555,file='psi_norm_correction_at.dat',action='write')
      do ip2 = 1, n_pro_type_tot
      do ip1 = ip2, n_pro_type_tot
         write(555,*) ip1, ip2, real(psi_norm_correction_at(ip1,ip2)), aimag(psi_norm_correction_at(ip1,ip2))
      enddo
      enddo
      close(555)
#endif

   end subroutine psi_norm_correction_paw_at

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

     subroutine set_indexes
     implicit none
        integer :: ia, it, ip, il, im, nblock 

        ! Get size of the gradient operator matrices over the collective index
        ! and allocate them. Map all the projector to the collective index

        if ( indexes_set ) return

        ! Mapping of ( it, il, im ) to a collective index: plm_index
        ! Colective index of type of atoms and projectors (type, projector, l, m): p_index_type(it)
        allocate( p_index_type_all( 0:ntyp ) )
        allocate( p_index_type(0:ntyp) )
        allocate( plm_index( 1:ntyp, 1:nbetam, -3:3 ) )
        p_index_type     = 0
        n_pro_type_tot   = 0
        p_index_type_all = 0
        p_index_type_all(0) = 1
        plm_index           = 0

        do it = 1, ntyp
           p_index_type(it) = 0
           do ip = 1, upf(it)%nbeta
              il = upf(it)%lll(ip)
              do im = -il, il
                 p_index_type(it) = p_index_type(it) + 1 
                 n_pro_type_tot   = n_pro_type_tot + 1
                 plm_index(it,ip,im) = n_pro_type_tot
              enddo
              p_index_type_all(it) = n_pro_type_tot
           enddo
        enddo


        ! Collective index (p_index) of atoms and projectors ( atoms, projectors, l, m)
        ! First determine the size of p_index
        n_pro_tot     = 0 ! Total number of projecctors for all atoms (not all types)

        do it = 1, ntyp
           do ia = 1, nat
              if ( ityp(ia) == it ) then
                 do ip = p_index_type_all(it-1), p_index_type_all(it)
                    n_pro_tot = n_pro_tot + 1
                 enddo
              endif
            enddo
        enddo

       allocate( p_index( n_pro_tot) )
       allocate( p_index_row_start( n_pro_tot) )
       allocate( p_index_row_end  ( n_pro_tot) )
       ! Fill up p_index
       n_pro_tot     = 0
       nblock        = 0
       do it = 1, ntyp
       do ia = 1, nat
          if ( ityp(ia) == it ) then
            nblock = n_pro_tot
            do ip = p_index_type_all(it-1), p_index_type_all(it)
               n_pro_tot = n_pro_tot + 1
               p_index( n_pro_tot ) = ip
               p_index_row_start( n_pro_tot ) = nblock + &
               merge(1, p_index_type_all(it-1)+1, it==1 )
               p_index_row_end  ( n_pro_tot ) = nblock + &
               ( p_index_type_all(it) - merge(0,p_index_type_all(it-1), it==1) )
            enddo
          endif
        enddo
        enddo

        indexes_set=.true.

     end subroutine set_indexes

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

     subroutine agm_free_memory
        if ( allocated(Rd) )                   deallocate( Rd )
        if ( allocated(DG) )                   deallocate( DG )
        if (allocated(psi_norm_correction_at)) deallocate( psi_norm_correction_at )
        if (allocated(p_index_type))           deallocate( p_index_type )
        if (allocated(plm_index))              deallocate( plm_index    )
        if (allocated(p_index))                deallocate( p_index      )
     end subroutine agm_free_memory


end module apawgm
