! 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 kgepsilon2

use kinds, ONLY    : DP
use qevars, ONLY   : pi
use kgecvars, ONLY : nw, wgrid, de
use kgsigma1, ONLY : sigma1, sigma1_atrace, &
                      sigma1_intra, sigma1_degen, sigma1_inter, &
                      sigma1_atrace_intra, &
                      sigma1_atrace_degen, &
                      sigma1_atrace_inter

implicit none


   private

   ! \epsilon_2 and its decomposition in intra-bands, degeneracies and 
   ! inter-bands contributions
   real(DP), allocatable, public :: epsilon2(:,:,:)       
   real(DP), allocatable, public :: epsilon2_intra(:,:,:)  
   real(DP), allocatable, public :: epsilon2_degen(:,:,:)  
   real(DP), allocatable, public :: epsilon2_inter(:,:,:) 

   ! Average traces
   real(DP), allocatable, public :: epsilon2_atrace(:)    
   real(DP), allocatable, public :: epsilon2_atrace_intra(:)     
   real(DP), allocatable, public :: epsilon2_atrace_degen(:)     
   real(DP), allocatable, public :: epsilon2_atrace_inter(:)     

   public :: epsilon2_tensor,                         &   
             epsilon2_atrace_sub,                     &
             epsilon2_tensor_decomp,                  &
             epsilon2_atrace_decomp


  integer :: iw, ix, ierr

contains

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

subroutine epsilon2_tensor()

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

   do iw = 0, nw
      if ( wgrid(iw) > de ) &
         epsilon2(1:3,1:3, iw) = 4.0d0 * pi * sigma1( 1:3, 1:3, iw)  / wgrid(iw)
   enddo

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

   epsilon2_atrace(:) = & 
       ( epsilon2(1,1,:) + epsilon2(2,2,:) + epsilon2(3,3,:) ) / 3.0_dp

end subroutine epsilon2_tensor

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

subroutine epsilon2_tensor_decomp()

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

   ! Traces

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

   epsilon2_atrace_intra(:) = & 
       ( epsilon2_intra(1,1,:) + epsilon2_intra(2,2,:) &
                               + epsilon2_intra(3,3,:) ) / 3.0_dp


   ! dielectric tensor ( imaginary part ) degeneracies contribution

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

      if ( wgrid(iw) > de ) &
         epsilon2_degen(1:3,1:3, iw) = &
              4.0d0 * pi * sigma1_degen( 1:3, 1:3, iw)  / wgrid(iw)
   enddo

   ! Traces

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

   epsilon2_atrace_degen(:) = & 
       ( epsilon2_degen(1,1,:) + epsilon2_degen(2,2,:) &
                              + epsilon2_degen(3,3,:) ) / 3.0_dp

   ! dielectric tensor ( imaginary part ) inter-band contribution

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

   do iw = 0, nw
      if ( wgrid(iw) > de ) &
         epsilon2_inter(1:3,1:3, iw) = &
              4.0d0 * pi * sigma1_inter( 1:3, 1:3, iw)  / wgrid(iw)
   enddo

   ! Traces

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

   epsilon2_atrace_inter(:) = & 
       ( epsilon2_inter(1,1,:) + epsilon2_inter(2,2,:) &
                               + epsilon2_inter(3,3,:) ) / 3.0_dp

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

   epsilon2 = epsilon2_intra + epsilon2_degen  + epsilon2_inter

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

   epsilon2_atrace = epsilon2_atrace_intra + epsilon2_atrace_degen & 
                    + epsilon2_atrace_inter


end subroutine epsilon2_tensor_decomp

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

subroutine epsilon2_atrace_sub

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

   do iw = 0, nw
      if ( wgrid(iw) > de ) &
         epsilon2_atrace(iw) = 4.0d0 * pi * sigma1_atrace( iw )  / wgrid(iw)
   enddo

end subroutine epsilon2_atrace_sub

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

subroutine epsilon2_atrace_decomp()

  ! dielectric tensor ( imaginary part ) intra-band contribution

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

   do iw = 0, nw
      if ( wgrid(iw) > de ) &
         epsilon2_atrace_intra(iw) = 4.0d0 * pi * sigma1_atrace_intra( iw )  / wgrid(iw)
   enddo

   ! dielectric tensor ( imaginary part ) degeneracies contribution

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

   do iw = 0, nw
      if ( wgrid(iw) > de ) &
         epsilon2_atrace_degen(iw) = 4.0d0 * pi * sigma1_atrace_degen( iw )  / wgrid(iw)
   enddo

   ! dielectric tensor ( imaginary part ) inter-band contribution

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

   do iw = 0, nw
      if ( wgrid(iw) > de ) &
         epsilon2_atrace_inter(iw) = &
                            4.0d0 * pi * sigma1_atrace_inter( iw )  / wgrid(iw)
   enddo

   ! Total traces


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

   epsilon2_atrace = epsilon2_atrace_intra + epsilon2_atrace_degen &
                                           + epsilon2_atrace_inter


end subroutine epsilon2_atrace_decomp

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

end module kgepsilon2
