!  Added module to KGEC for the calculation of other properties based on KG
! 
! Copyright (C) 2017- Lazaro Calderin and Valentin Karasiev
! 
! 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
! 
! 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 kgepsilon1

use kinds, ONLY      : DP
use qevars, ONLY     : pi
use kgecvars, ONLY   : nw, wgrid
use kgsigma2_w
use kgsigma2

implicit none

   private

   ! \epsilon_2 and its decomposition in intra-bands, degeneracies and 
   ! inter-bands contributions
   real(DP), allocatable, public :: epsilon1(:,:,:)       
   real(DP), allocatable, public :: epsilon1_intra(:,:,:)  
   real(DP), allocatable, public :: epsilon1_degen(:,:,:)  
   real(DP), allocatable, public :: epsilon1_inter(:,:,:) 

   ! Average traces
   real(DP), allocatable, public :: epsilon1_atrace(:)    
   real(DP), allocatable, public :: epsilon1_atrace_intra(:)     
   real(DP), allocatable, public :: epsilon1_atrace_degen(:)     
   real(DP), allocatable, public :: epsilon1_atrace_inter(:)     

   ! DC tensors
   real(DP), allocatable, public :: epsilon1_dc(:,:)       
   real(DP), allocatable, public :: epsilon1_dc_intra(:,:)  
   real(DP), allocatable, public :: epsilon1_dc_degen(:,:)  
   real(DP), allocatable, public :: epsilon1_dc_inter(:,:) 

   ! DC traces
   real(DP), public :: epsilon1_dc_atrace    
   real(DP), public :: epsilon1_dc_atrace_intra   
   real(DP), public :: epsilon1_dc_atrace_degen    
   real(DP), public :: epsilon1_dc_atrace_inter    


   public :: epsilon1_tensor,                         &   
             epsilon1_atrace_sub,                     &
             epsilon1_tensor_decomp,                  &
             epsilon1_atrace_decomp,                  &
             epsilon1_dc_tensor,                      &
             epsilon1_dc_atrace_sub,                  &
             epsilon1_dc_atrace_decomp,               &
             epsilon1_dc_tensor_decomp,               &
             epsilon1_tensor_sub_sigma2,              &
             epsilon1_atrace_sub_sigma2,              &
             epsilon1_tensor_decomp_sigma2,           &
             epsilon1_atrace_decomp_sigma2           
             

  integer :: iw, ix, ierr

contains

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

subroutine epsilon1_tensor

   call sigma2_w_sub

   ! dielectric tensor ( real part )
   allocate( epsilon1(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor','allocating epsilon1', ABS(ierr) )

   do iw = 0, nw
         epsilon1(1:3,1:3, iw) = -4.0d0 * pi * sigma2_w( 1:3, 1:3, iw) 
   enddo

   do ix = 1, 3
      epsilon1(ix,ix,0:nw) = 1.0_dp + epsilon1(ix,ix,0:nw)
   enddo

   ! traces
   
   allocate( epsilon1_atrace(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor',&
                  'allocating epsilon1_atrace', ABS(ierr) )

   epsilon1_atrace(0:nw) = & 
       ( epsilon1(1,1,0:nw) + epsilon1(2,2,0:nw) + epsilon1(3,3,0:nw) ) / 3.0_dp

end subroutine epsilon1_tensor

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

subroutine epsilon1_tensor_decomp

   call sigma2_w_decomp

   ! dielectric tensor ( real part ) intra-band contribution
   allocate( epsilon1_intra(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor_decomp',&
                  'allocating epsilon1_intra', ABS(ierr) )
   do iw = 0, nw
         epsilon1_intra(1:3,1:3, iw) = &
              -4.0d0 * pi * sigma2_w_intra( 1:3, 1:3, iw)
   enddo

   do ix = 1, 3
      epsilon1_intra(ix,ix,0:nw) = 1.0_dp + epsilon1_intra(ix,ix,0:nw) 
   enddo

   ! dielectric tensor ( real part ) degeneracies contribution

   allocate( epsilon1_degen(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor_decomp',&
                  'allocating epsilon1_degen', ABS(ierr) )
   do iw = 0, nw

         epsilon1_degen(1:3,1:3, iw) = &
              -4.0d0 * pi * sigma2_w_degen( 1:3, 1:3, iw)
   enddo

   do ix = 1, 3
      epsilon1_degen(ix,ix,0:nw) = 1.0_dp + epsilon1_degen(ix,ix,0:nw) 
   enddo

   ! dielectric tensor ( real part ) inter-band contribution

   allocate( epsilon1_inter(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor_decomp',&
                  'allocating epsilon1_inter', ABS(ierr) )

   do iw = 0, nw
         epsilon1_inter(1:3,1:3, iw) = &
              -4.0d0 * pi * sigma2_w_inter( 1:3, 1:3, iw)
   enddo

   do ix = 1, 3
      epsilon1_inter(ix,ix,0:nw) = 1.0_dp + epsilon1_inter(ix,ix,0:nw) 
   enddo


   allocate( epsilon1(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor_decomp',&
                  'allocating epsilon1', ABS(ierr) )

   epsilon1 = epsilon1_intra + epsilon1_degen + epsilon1_inter


   ! Traces

   allocate( epsilon1_atrace_intra(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor_decomp',&
                  'allocating epsilon1_atrace_intra', ABS(ierr) )

   epsilon1_atrace_intra(0:nw) = & 
       ( epsilon1_intra(1,1,0:nw) + epsilon1_intra(2,2,0:nw) &
                               + epsilon1_intra(3,3,0:nw) ) / 3.0_dp


   allocate( epsilon1_atrace_degen(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor_decomp',&
                  'allocating epsilon1_atrace_degen', ABS(ierr) )

   epsilon1_atrace_degen(0:nw) = & 
       ( epsilon1_degen(1,1,0:nw) + epsilon1_degen(2,2,0:nw) &
                              + epsilon1_degen(3,3,0:nw) ) / 3.0_dp

   allocate( epsilon1_atrace_inter(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor_decomp',&
                  'allocating epsilon1_atrace_inter', ABS(ierr) )

   epsilon1_atrace_inter(0:nw) = & 
       ( epsilon1_inter(1,1,0:nw) + epsilon1_inter(2,2,0:nw) &
                               + epsilon1_inter(3,3,0:nw) ) / 3.0_dp


   allocate( epsilon1_atrace(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_tensor_decomp',&
                  'allocating epsilon1_atrace', ABS(ierr) )

   epsilon1_atrace = epsilon1_atrace_intra + epsilon1_atrace_degen & 
                                           + epsilon1_atrace_inter

end subroutine epsilon1_tensor_decomp

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

subroutine epsilon1_atrace_sub

   call sigma2_w_atrace_sub
 
   ! dielectric tensor ( real part )
   allocate( epsilon1_atrace(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_atrace',&
                  'allocating epsilon1_atrace', ABS(ierr) )

   do iw = 0, nw
      epsilon1_atrace(iw) = 1.0_dp - 4.0_dp * pi * sigma2_w_atrace( iw )
   enddo

end subroutine epsilon1_atrace_sub

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

subroutine epsilon1_atrace_decomp()

  call sigma2_w_atrace_decomp

  ! dielectric tensor ( real part ) intra-band contribution

   allocate( epsilon1_atrace_intra(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_atrace_decomp',&
                  'allocating epsilon1_atrace_intra', ABS(ierr) )

   do iw = 0, nw
      epsilon1_atrace_intra(iw) = - 4.0d0*pi*sigma2_w_atrace_intra(iw)   
   enddo

   ! dielectric tensor ( real part ) degeneracies contribution

   allocate( epsilon1_atrace_degen(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_atrace_decomp',&
                  'allocating epsilon1_atrace_degen', ABS(ierr) )

   do iw = 0, nw
         epsilon1_atrace_degen(iw) = - 4.0d0*pi*sigma2_w_atrace_degen(iw)
   enddo

   ! dielectric tensor ( real part ) inter-band contribution

   allocate( epsilon1_atrace_inter(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_atrace_decomp',&
                  'allocating epsilon1_atrace_inter', ABS(ierr) )

   do iw = 0, nw
         epsilon1_atrace_inter(iw) = &
                           - 4.0d0 * pi * sigma2_w_atrace_inter( iw )
   enddo

   allocate( epsilon1_atrace(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_atrace_decomp',&
                  'allocating epsilon1_atrace', ABS(ierr) )

   epsilon1_atrace = epsilon1_atrace_intra + epsilon1_atrace_degen &
                                           + epsilon1_atrace_inter &
                                           + 1.0_dp

end subroutine epsilon1_atrace_decomp

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

subroutine epsilon1_dc_tensor

   call sigma2_w_dc_sub

   ! dielectric tensor ( real part )
   allocate( epsilon1_dc(1:3,1:3), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_dc_tensor',&
                   'allocating epsilon1_dc', ABS(ierr) )

   epsilon1_dc(1:3,1:3) = -4.0_dp * pi * sigma2_w_dc( 1:3, 1:3) 

   do ix = 1, 3
      epsilon1_dc(ix,ix) = 1.0_dp + epsilon1_dc(ix,ix)
   enddo

   ! trace
   
   epsilon1_dc_atrace = & 
                1.0_dp - 4.0_dp * pi * sigma2_w_dc_atrace
 
end subroutine epsilon1_dc_tensor

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

subroutine epsilon1_dc_atrace_sub

   call sigma2_w_dc_atrace_sub
 
   epsilon1_dc_atrace = 1.0_dp - 4.0_dp * pi * sigma2_w_dc_atrace

end subroutine epsilon1_dc_atrace_sub

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

subroutine epsilon1_dc_atrace_decomp()

   call sigma2_w_dc_atrace_decomp

  ! dielectric tensor ( real part ) intra-band contribution

   epsilon1_dc_atrace_intra = - 4.0d0*pi*sigma2_w_dc_atrace_intra   

   ! dielectric tensor ( real part ) degeneracies contribution

   epsilon1_dc_atrace_degen = - 4.0d0*pi*sigma2_w_dc_atrace_degen

   ! dielectric tensor ( real part ) inter-band contribution

   epsilon1_dc_atrace_inter = &
                            - 4.0d0 * pi * sigma2_w_dc_atrace_inter

   ! Total traces

   epsilon1_dc_atrace = epsilon1_dc_atrace_intra + epsilon1_dc_atrace_degen &
                                           + epsilon1_dc_atrace_inter &
                                           + 1.0_dp


end subroutine epsilon1_dc_atrace_decomp

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

subroutine epsilon1_dc_tensor_decomp

   call sigma2_w_dc_decomp

   ! dielectric tensor ( real part ) intra-band contribution
   allocate( epsilon1_dc_intra(1:3,1:3), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_dc_tensor_decomp',&
                  'allocating epsilon1_dc_intra', ABS(ierr) )

   epsilon1_dc_intra(1:3,1:3) = &
              -4.0d0 * pi * sigma2_w_dc_intra( 1:3, 1:3)


   do ix = 1, 3
      epsilon1_dc_intra(ix,ix) = 1.0_dp + epsilon1_dc_intra(ix,ix)
   enddo

   ! Trace

   epsilon1_dc_atrace_intra = 1.0_dp - 4.0_dp * pi * sigma2_w_dc_atrace_intra  

   ! dielectric tensor ( real part ) degeneracies contribution

   allocate( epsilon1_dc_degen(1:3,1:3), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_dc_tensor_decomp',&
                  'allocating epsilon1_dc_degen', ABS(ierr) )

   epsilon1_dc_degen(1:3,1:3) = &
              -4.0d0 * pi * sigma2_w_dc_degen( 1:3, 1:3)

   do ix = 1, 3
      epsilon1_dc_degen(ix,ix) = 1.0_dp + epsilon1_dc_degen(ix,ix)
   enddo

   ! Trace

   epsilon1_dc_atrace_degen = & 
          1.0_dp - 4.0_dp * pi * sigma2_w_dc_atrace_degen


   ! dielectric tensor ( real part ) inter-band contribution

   allocate( epsilon1_dc_inter(1:3,1:3), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_dc_tensor_decomp',&
                  'allocating epsilon1_dc_inter', ABS(ierr) )

   epsilon1_dc_inter(1:3,1:3) = &
              -4.0d0 * pi * sigma2_w_dc_inter( 1:3, 1:3 )

   do ix = 1, 3
      epsilon1_dc_inter(ix,ix) = 1.0_dp + epsilon1_dc_inter(ix,ix)
   enddo

   ! Trace

   epsilon1_dc_atrace_inter = & 
         1.0_dp - 4.0_dp * pi * sigma2_w_dc_atrace_inter  


   allocate( epsilon1_dc(1:3,1:3), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon:epsilon_dc_tensor_decomp',&
                  'allocating epsilon1_dc', ABS(ierr) )

   epsilon1_dc = epsilon1_dc_intra + epsilon1_dc_degen + epsilon1_dc_inter

   epsilon1_dc_atrace = epsilon1_dc_atrace_intra + epsilon1_dc_atrace_degen & 
                                           + epsilon1_dc_atrace_inter

 end subroutine epsilon1_dc_tensor_decomp
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Calculating sigma2 from sigma2/w
!

subroutine epsilon1_tensor_sub_sigma2

   allocate( sigma2(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_sub_sigma2',&
                  'allocating sigma2', ABS(ierr) )



   allocate( sigma2_atrace(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_sub_sigma2',&
                  'allocating sigma2_atrace', ABS(ierr) )

   do iw=1,nw
      sigma2(:,:,iw)    = wgrid(iw) * sigma2_w(:,:,iw)
      sigma2_atrace(iw) = wgrid(iw) * sigma2_w_atrace(iw)
   enddo

end subroutine epsilon1_tensor_sub_sigma2

subroutine epsilon1_tensor_decomp_sigma2

   allocate( sigma2_intra(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_decomp_sigma2',&
                  'allocating sigma2_intra', ABS(ierr) )

   allocate( sigma2_degen(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_decomp_sigma2',&
                  'allocating sigma2_degen', ABS(ierr) )

   allocate( sigma2_inter(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_decomp_sigma2',&
                  'allocating sigma2_inter', ABS(ierr) )

   allocate( sigma2(1:3,1:3,0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_decomp_sigma2',&
                  'allocating sigma2', ABS(ierr) )

   allocate( sigma2_atrace_intra(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_decomp_sigma2',&
                  'allocating sigma2_atrace_intra', ABS(ierr) )

   allocate( sigma2_atrace_degen(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_decomp_sigma2',&
                  'allocating sigma2_atrace_degen', ABS(ierr) )

   allocate( sigma2_atrace_inter(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_decomp_sigma2',&
                  'allocating sigma2_atrace_inter', ABS(ierr) )

   allocate( sigma2_atrace(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_tensor_decomp_sigma2',&
                  'allocating sigma2_atrace', ABS(ierr) )


   do iw=1,nw
      sigma2_intra(:,:,iw)        = wgrid(iw) * sigma2_w_intra(:,:,iw)
      sigma2_degen(:,:,iw)        = wgrid(iw) * sigma2_w_degen(:,:,iw)
      sigma2_inter(:,:,iw)        = wgrid(iw) * sigma2_w_inter(:,:,iw)
      sigma2(:,:,iw)              = wgrid(iw) * sigma2_w(:,:,iw)
      sigma2_atrace_intra(iw) = wgrid(iw) * sigma2_w_atrace_intra(iw)
      sigma2_atrace_degen(iw) = wgrid(iw) * sigma2_w_atrace_degen(iw)
      sigma2_atrace_inter(iw) = wgrid(iw) * sigma2_w_atrace_inter(iw)
      sigma2_atrace(iw)       = wgrid(iw) * sigma2_w_atrace(iw)
   enddo

end subroutine epsilon1_tensor_decomp_sigma2

subroutine epsilon1_atrace_sub_sigma2

   allocate( sigma2_atrace(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_atrace_sub_sigma2',&
                  'allocating sigma2_atrace', ABS(ierr) )

   do iw=1,nw
      sigma2_atrace(iw)       = wgrid(iw) * sigma2_w_atrace(iw)
   enddo

end subroutine epsilon1_atrace_sub_sigma2

subroutine epsilon1_atrace_decomp_sigma2

   allocate( sigma2_atrace_intra(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_atrace_decomp_sigma2',&
                  'allocating sigma2_atrace_intra', ABS(ierr) )

   allocate( sigma2_atrace_degen(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_atrace_decomp_sigma2',&
                  'allocating sigma2_atrace_degen', ABS(ierr) )

   allocate( sigma2_atrace_inter(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_atrace_decomp_sigma2',&
                  'allocating sigma2_atrace_inter', ABS(ierr) )

   allocate( sigma2_atrace(0:nw), STAT=ierr )
   if (ierr/=0) &
      CALL errore('kgepsilon1:epsilon1_atrace_decomp_sigma2',&
                  'allocating sigma2_atrace', ABS(ierr) )


   do iw=1,nw
      sigma2_atrace_intra(iw) = wgrid(iw) * sigma2_w_atrace_intra(iw)
      sigma2_atrace_degen(iw) = wgrid(iw) * sigma2_w_atrace_degen(iw)
      sigma2_atrace_inter(iw) = wgrid(iw) * sigma2_w_atrace_inter(iw)
      sigma2_atrace(iw)       = wgrid(iw) * sigma2_w_atrace(iw)
   enddo

end subroutine epsilon1_atrace_decomp_sigma2

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

end module kgepsilon1
