!
! 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 kgsigma1
! Kubo-Greenwood conductivity \sigma_1

use kinds, ONLY    : DP
use qevars
use kgecvars, ONLY : deltarep, deltawidth, nw, wmin, wmax, wgrid, dw, sa, sg, &
                     psi_grad_psi, iaux, de, sigma1_notintra, AU_TO_OHMM_INV, &
                     nbnds_local, nbnds_per_process, nbnds_per_group,         &
                     my_rank, my_rank_old, my_group, dc

implicit none

   ! Internal units : atomic Ha
   ! Note on multipliying by the prefactor 2 Pi/ omega for sigma1 in a.u.
   ! - The 2 went into the wg (the combined fermi-dirac and k-weighting factor)
   ! The Pi cancels the Pi in the normalization of the Lorentzian, and its taken
   ! care of also for the Gaussian
   
   ! Gradient matrix elements must be supplied as input
   ! real(DP), allocatable    :: psi_grad_psi(:,:,:,:)

   private

   ! \sigma_1 and its decomposition in intra-bands, degeneracies and 
   ! inter-bands contributions
   real(DP), allocatable, public :: sigma1(:,:,:)       
   real(DP), allocatable, public :: sigma1_intra(:,:,:)  
   real(DP), allocatable, public :: sigma1_degen(:,:,:)  
   real(DP), allocatable, public :: sigma1_inter(:,:,:) 

   ! Average traces
   real(DP), allocatable, public :: sigma1_atrace(:)    
   real(DP), allocatable, public :: sigma1_atrace_intra(:)     
   real(DP), allocatable, public :: sigma1_atrace_degen(:)     
   real(DP), allocatable, public :: sigma1_atrace_inter(:)     

   ! DC components
   real(DP), public :: sigma1_dc(1:3,1:3)
   real(DP), public :: sigma1_dc_intra(1:3,1:3)    
   real(DP), public :: sigma1_dc_degen(1:3,1:3)    
   real(DP), public :: sigma1_dc_inter(1:3,1:3)    

   real(DP), public :: sigma1_dc_atrace            ! - DC average trace  
   real(DP), public :: sigma1_dc_atrace_intra      
   real(DP), public :: sigma1_dc_atrace_degen
   real(DP), public :: sigma1_dc_atrace_inter


   public :: frequency_grid,                          &   
             check_delta_sub,                         &
             !  
             ! TENSORS
             ! 
             sigma1_approx_1lorentzian,               &
             sigma1_approx_2lorentzian,               &
             sigma1_approx_2lorentzian_DC,            &
             ! 
             sigma1_approx_1gaussian,                 &
             sigma1_approx_2gaussian,                 &
             sigma1_approx_2gaussian_DC,              &
             !
             sigma1_exact_1lorentzian,                &
             sigma1_exact_2lorentzian,                & 
             sigma1_exact_lorentzian_DC,              &
             !
             sigma1_exact_1gaussian,                  &
             sigma1_exact_2gaussian,                  &
             sigma1_exact_gaussian_DC,                &
             !
             sigma1_exact_decomp_1lorentzian,         &
             sigma1_exact_decomp_2lorentzian,         &
             sigma1_exact_decomp_lorentzian_DC,       &
             !
             sigma1_exact_decomp_1gaussian,           &
             sigma1_exact_decomp_2gaussian,           &
             sigma1_exact_decomp_gaussian_DC,         &
             ! 
             ! TRACES
             ! 
             sigma1_atrace_exact_1lorentzian,         &
             sigma1_atrace_exact_2lorentzian,         &
             sigma1_atrace_exact_lorentzian_DC,       &
             !
             sigma1_atrace_exact_1gaussian,           &
             sigma1_atrace_exact_2gaussian,           &
             sigma1_atrace_exact_gaussian_DC,         &
             !
             sigma1_atrace_exact_decomp_1lorentzian,  &
             sigma1_atrace_exact_decomp_2lorentzian,  &
             sigma1_atrace_exact_decomp_lorentzian_DC, &
             !
             sigma1_atrace_exact_decomp_1gaussian,    &
             sigma1_atrace_exact_decomp_2gaussian,    &
             sigma1_atrace_exact_decomp_gaussian_DC,  &
             !
             sigma1_atrace_approx_1lorentzian,        &
             sigma1_atrace_approx_2lorentzian,        &
             sigma1_atrace_approx_2lorentzian_DC,     &
             !
             sigma1_atrace_approx_1gaussian,          &
             sigma1_atrace_approx_2gaussian,          &
             sigma1_atrace_approx_2gaussian_DC !,       &
             !  
!             sigma1_dc_all_deltarep


   ! private variables
   integer :: iw                          ! Frequency index
   integer :: ik, ib1, ib2, ibb1          ! counters on k-points and bands
   integer :: ig                          ! counter on plane waves
   integer :: ix1, ix2                    ! labels x, y an z

   real(DP) :: focc, dfde

   real(DP) :: aux, aux2, ee, eem, eep
   real(DP) :: psi_grad_psi_aux(3), maux(3,3)

   integer  :: ios , ierr ! Input and memory allocation error status variables


   contains

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

   subroutine frequency_grid()
   !
   ! Frequency grid
   ! Input units: eV    Output Units: Ha

      if ( nw == 0 ) then
         dw = 0.0_DP
      else
         dw   = ( wmax - wmin ) / dble(nw)  ! Frecuency step
      endif

      allocate( wgrid(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating wgrid', abs(ierr))
      
      ! Frequency grid in eV
      do iw = 0, nw
         wgrid(iw) = wmin + iw * dw
      enddo


      write(stdout,*) '    Frequency grid:'
      write(stdout,*) "       Frequency step (eV)       :", dw
      write(stdout,*) "       Frequency steps           :", nw
      write(stdout,'(a, f10.4,a,f10.4 )') &
                 "        Frequency range (eV)      :", wgrid(0),  ' to ',wgrid(nw)

     ! Change units from eV to Ha
     wgrid = wgrid / AUTOEV
     dw    = dw    / AUTOEV

   end subroutine frequency_grid

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

   subroutine check_delta_sub()
   ! 
   ! Calculations to compare lorentzians and gaussians as delta-function repr.
   ! 
   
   real(DP) :: lp, gp, gae
   real(DP) :: loren1, loren1a, loren2, loren3, gauss1a, gauss1, gauss2, gauss3



      ! 
      ! Calculations to compare lorentzians and gaussians as delta-function repr.
      ! 
      ! (using Lorentzian and Gaussians with the same width )

      sa  = 0.5_dp * deltawidth / AUTOEV       ! Lorentzian half-width in Ha :
                                               !  sa/2 / ( x^2 + sa^2/4 ) / pi

      lp  = sa / pi                            ! Lorentzian prefactor  
      

      gae =  deltawidth / AUTOEV               ! Gaussian exponent (inverse)
                                               ! exp(- x^2/gae^2 ) / gae sqrt(pi)  

      gp  = 1.0_dp / ( gae * sqrt(pi) )        ! Gaussian prefactor 

      gae = 1.0_dp / ( gae * gae )             ! Inverse of the exponent squared             


      IF(IONODE) THEN
      open(121,file='delta-lor-vs-gau-same-width.dat', action='write')

      do iw = 1, nw
         ee = wgrid(iw)
         write(121,*) wgrid(iw)*AUTOEV, &
              lp / (ee*ee + sa*sa) * AU_TO_OHMM_INV, &
              dexp(-gae*ee*ee)*gp  * AU_TO_OHMM_INV 
         enddo
         close(121)

         open(121,file='sigma1-atrace-lor-vs-gau-same-width.dat', action='write')
         write(121,'(A,f10.6,A)'     ) &
         '#      lorentzian deltawidth=', deltawidth, 'eV'
         write(121,'(A,f10.6,A)'     ) &
         '#      gaussian   deltawidth=', deltawidth, 'eV'
         write(121,'(A)'             ) &
         '#      hbar omega in eV, conductivities in 1/(ohm m)'
         write(121,'(A)'             ) &
         '#      hbar omega           Exact 1 Lor &
         &       Exact 2 Lor          Appr 1 Lor          Appr 2 Lor &
         Exact 1 Gau          Exact 2 Gau         Appr 1 Gau          Exact 2 Gau'
  

      ENDIF ! inode

      do iw = 1, nw

         loren1 = 0.0_DP
         loren1a = 0.0_DP
         loren2 = 0.0_DP
         loren3 = 0.0_DP
         gauss1 = 0.0_DP
         gauss1a = 0.0_DP
         gauss2 = 0.0_DP
         gauss3 = 0.0_DP

         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1  = ibb1 + nbnds_per_process * my_rank_old &
                           + nbnds_per_group   * my_group

               do ib2 = 1, nbnd

                  if( sigma1_notintra .and. ib2 == ib1 ) cycle

                  aux = 0.0_DP
                  do ix1 = 1, 3
                     aux = aux + real( conjg( psi_grad_psi(ix1,ib2,ibb1,ik) ) &
                                 * psi_grad_psi(ix1,ib2,ibb1,ik) )
                  enddo

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  if( abs(ee) <=  de ) then
                     if ( sigma1_notintra ) cycle
                     focc =1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss)+1.0_DP)
                     dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP
                  else
                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee
                  endif

                  ! Conductivity, exact formula with a Lorentzian
                  loren1  = loren1 + aux * dfde /( eem*eem + sa*sa )
                  
                  ! Conductivity, exact formula with two Lorentzian
                  loren1a = loren1a &
                           + aux * dfde  &
                              * (   1.0_dp / (eem*eem + sa*sa)       &
                                  + 1.0_dp / (eep*eep + sa*sa) )

                  ! Conductivity, approx formula with a Lorentzian
                  loren2 = loren2 + aux*( wg(ib2,ik) - wg(ib1,ik) ) &
                                                /( eem*eem + sa*sa )/(wgrid(iw))

                  ! Conductivity, approx formula with sum of two Lorentzian
                  loren3 = loren3 &
                           + aux*( wg(ib2,ik) - wg(ib1,ik) ) * 4.0_DP &
                            * ee / ( ( eem*eem + sa*sa ) * ( eep*eep + sa*sa ) )


                  ! Conductivity, exact formula with a Gaussian
                  gauss1  = gauss1  + aux * dfde * exp(-eem*eem*gae)

                  ! Conductivity, exact formula with sum of two Gaussians
                  gauss1a = gauss1a + aux * dfde &
                                      * ( exp(-eem*eem*gae) + exp(-eep*eep*gae) )


                  ! Conductivity, approx formula with a Gaussian
                  gauss2 = gauss2 + aux*( wg(ib2,ik) - wg(ib1,ik) ) &
                                        /(wgrid(iw)) * ( exp(-eem*eem*gae) )

                  ! Conductivity, approx formula with sum of two Gaussian
                  gauss3 = gauss3 &
                           + aux*( wg(ib2,ik) - wg(ib1,ik) ) /(wgrid(iw)) &
                              * ( exp(-eem*eem*gae)-exp(-eep*eep*gae) )
  
                 enddo ! ib2
            enddo    ! ib1

         enddo ! ik

         call mp_sum( loren1,  inter_bgrp_comm ) ! reduce over bands (nbnd)
         call mp_sum( loren1a, inter_bgrp_comm )
         call mp_sum( loren2,  inter_bgrp_comm )
         call mp_sum( loren3,  inter_bgrp_comm )
         call mp_sum( gauss1,  inter_bgrp_comm )
         call mp_sum( gauss1a, inter_bgrp_comm )
         call mp_sum( gauss2,  inter_bgrp_comm )
         call mp_sum( gauss3,  inter_bgrp_comm )

         call mp_sum( loren1,  inter_pool_comm ) ! reduce over k (nks)
         call mp_sum( loren1a, inter_pool_comm )
         call mp_sum( loren2,  inter_pool_comm )
         call mp_sum( loren3,  inter_pool_comm )
         call mp_sum( gauss1,  inter_pool_comm )
         call mp_sum( gauss1a, inter_pool_comm )
         call mp_sum( gauss2,  inter_pool_comm )
         call mp_sum( gauss3,  inter_pool_comm )

         loren1  = pi * lp * loren1 /omega/3.0_DP * AU_TO_OHMM_INV
         loren1a = pi * lp * loren1a/omega/6.0_DP * AU_TO_OHMM_INV
         loren2  = pi * lp * loren2 /omega/3.0_DP * AU_TO_OHMM_INV
         loren3  = pi * lp * loren3 /omega/6.0_DP * AU_TO_OHMM_INV

         gauss1  = pi * gp * gauss1 /omega/3.0_DP * AU_TO_OHMM_INV
         gauss1a = pi * gp * gauss1a/omega/6.0_DP * AU_TO_OHMM_INV
         gauss2  = pi * gp * gauss2 /omega/3.0_DP * AU_TO_OHMM_INV
         gauss3  = pi * gp * gauss3 /omega/6.0_DP * AU_TO_OHMM_INV

         IF(IONODE) THEN
            write(121,'(1p,9es20.7e3)') wgrid(iw)*AUTOEV, &
                                        loren1, loren1a, loren2, loren3, &
                                        gauss1, gauss1a, gauss2, gauss3
         ENDIF ! ionode

      enddo ! iw

      IF(IONODE) THEN
        close(121)
      ENDIF ! ionode

      ! 
      ! Calculations to compare lorentzians and gaussians as delta-function repr.
      ! 
      ! (using Lorentzian and Gaussians of the same FWHM )

      sa  = 0.5_dp * deltawidth / AUTOEV       ! Lorentzian half-width in Ha :
                                               !  sa/2 / ( x^2 + sa^2/4 ) / pi

      lp  = sa / pi                            ! Lorentzian prefactor  
      
      gae  = 0.5_dp * deltawidth  &            ! Gaussian exponent to get the same
            /( AUTOEV * sqrt(log(2.0_dp)) )    ! FWHM as the Lorentzian
 
      gp  = 1.0_dp / ( gae * sqrt(pi) )        ! Gaussian prefactor
      
      gae = 1.0_dp / (gae*gae)            


      IF(IONODE) THEN
      open(121,file='delta-lor-vs-gau.dat', action='write')

      do iw = 1, nw
         ee = wgrid(iw)
         write(121,*) wgrid(iw)*AUTOEV, &
              lp / (ee*ee + sa*sa) * AU_TO_OHMM_INV, &
              dexp(-gae*ee*ee)*gp  * AU_TO_OHMM_INV
         enddo
         close(121)

         open(121,file='sigma1-atrace-lor-vs-gau-same-fwhm.dat', action='write')
         write(121,'(A,f10.6,A)'     ) '#      lorentzian deltawidth=', deltawidth, 'eV'
         write(121,'(A,f10.6,A)'     ) '#      gaussian   deltawidth=', sqrt(1.0_dp/gae)*AUTOEV, 'eV'
         write(121,'(A)'             ) '#      hbar omega in eV, conductivities in 1/(ohm m)'
         write(121,'(A)'             ) &
         '#      hbar omega           Exact 1 Lor &
         &       Exact 2 Lor          Appr 1 Lor          Appr 2 Lor&
         Exact 1 Gau          Exact 2 Gau         Appr 1 Gau          Exact 2 Gau'
      ENDIF ! inode

      do iw = 1, nw

         loren1  = 0.0_DP
         loren1a = 0.0_DP
         loren2  = 0.0_DP
         loren3  = 0.0_DP
         gauss1  = 0.0_DP
         gauss1a = 0.0_DP
         gauss2  = 0.0_DP
         gauss3  = 0.0_DP

         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1  = ibb1 + nbnds_per_process * my_rank_old &
                           + nbnds_per_group   * my_group

               do ib2 = 1, nbnd

                  if( sigma1_notintra .and. ib2 == ib1 ) cycle

                  aux = 0.0_DP
                  do ix1 = 1, 3
                     aux = aux + real( conjg( psi_grad_psi(ix1,ib2,ibb1,ik) ) &
                                 * psi_grad_psi(ix1,ib2,ibb1,ik) )
                  enddo

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  if( abs(ee) <=  de ) then
                     if ( sigma1_notintra ) cycle
                     focc =1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss)+1.0_DP)
                     dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP
                  else
                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee
                  endif

                  ! Conductivity, exact formula with a Lorentzian
                  loren1  = loren1 + aux * dfde /( eem*eem + sa*sa )
                  
                  ! Conductivity, exact formula with two Lorentzian
                  loren1a = loren1a &
                           + aux * dfde  &
                              * (   1.0_dp / (eem*eem + sa*sa)       &
                                  + 1.0_dp / (eep*eep + sa*sa) )

                  ! Conductivity, approx formula with a Lorentzian
                  loren2 = loren2 + aux*( wg(ib2,ik) - wg(ib1,ik) ) &
                                                /( eem*eem + sa*sa )/(wgrid(iw))

                  ! Conductivity, approx formula with sum of two Lorentzian
                  loren3 = loren3 &
                           + aux*( wg(ib2,ik) - wg(ib1,ik) ) * 4.0_DP &
                            * ee / ( ( eem*eem + sa*sa ) * ( eep*eep + sa*sa ) )


                  ! Conductivity, exact formula with a Gaussian
                  gauss1  = gauss1  + aux * dfde * exp(-eem*eem*gae)

                  ! Conductivity, exact formula with sum of two Gaussians
                  gauss1a = gauss1a + aux * dfde &
                                      * ( exp(-eem*eem*gae) + exp(-eep*eep*gae) )


                  ! Conductivity, approx formula with a Gaussian
                  gauss2 = gauss2 + aux*( wg(ib2,ik) - wg(ib1,ik) ) &
                                        /(wgrid(iw)) * ( exp(-eem*eem*gae) )

                  ! Conductivity, approx formula with sum of two Gaussian
                  gauss3 = gauss3 &
                           + aux*( wg(ib2,ik) - wg(ib1,ik) ) /(wgrid(iw)) &
                              * ( exp(-eem*eem*gae)-exp(-eep*eep*gae) )
  
                 enddo ! ib2
            enddo    ! ib1

         enddo ! ik

         call mp_sum( loren1,  inter_bgrp_comm ) ! reduce over bands (nbnd)
         call mp_sum( loren1a, inter_bgrp_comm )
         call mp_sum( loren2,  inter_bgrp_comm )
         call mp_sum( loren3,  inter_bgrp_comm )
         call mp_sum( gauss1,  inter_bgrp_comm )
         call mp_sum( gauss1a, inter_bgrp_comm )
         call mp_sum( gauss2,  inter_bgrp_comm )
         call mp_sum( gauss3,  inter_bgrp_comm )

         call mp_sum( loren1,  inter_pool_comm ) ! reduce over k (nks)
         call mp_sum( loren1a, inter_pool_comm )
         call mp_sum( loren2,  inter_pool_comm )
         call mp_sum( loren3,  inter_pool_comm )
         call mp_sum( gauss1,  inter_pool_comm )
         call mp_sum( gauss1a, inter_pool_comm )
         call mp_sum( gauss2,  inter_pool_comm )
         call mp_sum( gauss3,  inter_pool_comm )

         loren1  = pi * lp * loren1 /omega/3.0_DP * AU_TO_OHMM_INV
         loren1a = pi * lp * loren1a/omega/6.0_DP * AU_TO_OHMM_INV
         loren2  = pi * lp * loren2 /omega/3.0_DP * AU_TO_OHMM_INV
         loren3  = pi * lp * loren3 /omega/6.0_DP * AU_TO_OHMM_INV

         gauss1  = pi * gp * gauss1 /omega/3.0_DP * AU_TO_OHMM_INV
         gauss1a = pi * gp * gauss1a/omega/6.0_DP * AU_TO_OHMM_INV
         gauss2  = pi * gp * gauss2 /omega/3.0_DP * AU_TO_OHMM_INV
         gauss3  = pi * gp * gauss3 /omega/6.0_DP * AU_TO_OHMM_INV

         IF(IONODE) THEN
            write(121,'(1p,9es20.7e3)') wgrid(iw)*AUTOEV, &
                                        loren1, loren1a, loren2, loren3, &
                                        gauss1, gauss1a, gauss2, gauss3
         ENDIF ! ionode

      enddo ! iw

      IF(IONODE) THEN
        close(121)
      ENDIF ! ionode

      ! 
      ! Calculations to compare lorentzians and gaussians as delta-function repr.
      ! 
      ! (using Lorentzian and Gaussians of the same heights )
   
      sa  = 0.5_dp * deltawidth / AUTOEV       ! Lorentzian half-width in Ha :
                                               !  sa/2 / ( x^2 + sa^2/4 ) / pi

      lp  = sa / pi                            ! Lorentzian prefactor  
      
      gae  = 0.5_dp * deltawidth &             ! Gaussian exponent to get the same
            / (AUTOEV * sqrt(pi))              ! height as the Lorentzian

      gp  = 1.0_dp / ( gae * sqrt(pi) )        ! Gaussian prefactor

      gae = 1.0_dp / (gae*gae)


      IF(IONODE) THEN
         open(121,file='delta-lor-vs-gau-same-height.dat', action='write')
         do iw = 1, nw
            ee = wgrid(iw)
            write(121,*) wgrid(iw)*AUTOEV, &
              lp / (ee*ee + sa*sa) * AU_TO_OHMM_INV , &
              dexp(-gae*ee*ee)*gp  * AU_TO_OHMM_INV 
         enddo
         close(121)
      ENDIF



      IF(IONODE) THEN
         open(121,file='sigma1-atrace-lor-vs-gau-same-height.dat', action='write')
         write(121,'(A,f10.6,A)'     ) '#      lorentzian deltawidth=', deltawidth, 'eV'
         write(121,'(A,f10.6,A)'     ) '#      gaussian   deltawidth=', sqrt(1.0_dp/gae)*AUTOEV, 'eV'
         write(121,'(A)'             ) '#      hbar omega in eV, conductivities in 1/(ohm m)'
         write(121,'(A)'             ) '#      hbar omega           Exact 1 Lor &
         &       Exact 2 Lor          Appr 1 Lor          Appr 2 Lor&
         &         Exact 1 Gau          Exact 2 Gau         Appr 1 Gau          Exact 2 Gau'
      ENDIF ! inode

      do iw = 1, nw

         loren1     = 0.0_DP
         loren1a   = 0.0_DP
         loren2     = 0.0_DP
         loren3     = 0.0_DP
         gauss1   = 0.0_DP
         gauss1a = 0.0_DP
         gauss2   = 0.0_DP
         gauss3   = 0.0_DP

         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1  = ibb1 + nbnds_per_process * my_rank_old &
                           + nbnds_per_group   * my_group

               do ib2 = 1, nbnd

                  if( sigma1_notintra .and. ib2 == ib1 ) cycle

                  aux = 0.0_DP
                  do ix1 = 1, 3
                     aux = aux + real( conjg( psi_grad_psi(ix1,ib2,ibb1,ik) ) &
                                 * psi_grad_psi(ix1,ib2,ibb1,ik) )
                  enddo

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  if( abs(ee) <=  de ) then
                     if ( sigma1_notintra ) cycle
                     focc =1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss)+1.0_DP)
                     dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP
                  else
                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee
                  endif  

                  ! Conductivity, exact formula with a Lorentzian
                  loren1  = loren1 + aux * dfde /( eem*eem + sa*sa )
                  
                  ! Conductivity, exact formula with two Lorentzian
                  loren1a = loren1a &
                           + aux * dfde  &
                              * (   1.0_dp / (eem*eem + sa*sa)       &
                                  + 1.0_dp / (eep*eep + sa*sa) )

                  ! Conductivity, approx formula with a Lorentzian
                  loren2 = loren2 + aux*( wg(ib2,ik) - wg(ib1,ik) ) &
                                                /( eem*eem + sa*sa )/(wgrid(iw))

                  ! Conductivity, approx formula with sum of two Lorentzian
                  loren3 = loren3 &
                           + aux*( wg(ib2,ik) - wg(ib1,ik) ) * 4.0_DP &
                            * ee / ( ( eem*eem + sa*sa ) * ( eep*eep + sa*sa ) )


                  ! Conductivity, exact formula with a Gaussian
                  gauss1  = gauss1  + aux * dfde * exp(-eem*eem*gae)


                  ! Conductivity, exact formula with sum of twho Gaussians
                  gauss1a = gauss1a + aux * dfde &
                                      * ( exp(-eem*eem*gae) + exp(-eep*eep*gae) )

                  ! Conductivity, approx formula with a Gaussian
                  gauss2 = gauss2 + aux*( wg(ib2,ik) - wg(ib1,ik) ) &
                                        /(wgrid(iw)) * ( exp(-eem*eem*gae) )

                  ! Conductivity, approx formula with sum of two Gaussian
                  gauss3 = gauss3 &
                           + aux*( wg(ib2,ik) - wg(ib1,ik) ) /(wgrid(iw)) &
                              * ( exp(-eem*eem*gae)-exp(-eep*eep*gae) )
  
                 enddo ! ib2
            enddo    ! ib1

         enddo ! ik

         call mp_sum( loren1,  inter_bgrp_comm ) ! reduce over bands (nbnd)
         call mp_sum( loren1a, inter_bgrp_comm )
         call mp_sum( loren2,  inter_bgrp_comm )
         call mp_sum( loren3,  inter_bgrp_comm )
         call mp_sum( gauss1,  inter_bgrp_comm )
         call mp_sum( gauss1a, inter_bgrp_comm )
         call mp_sum( gauss2,  inter_bgrp_comm )
         call mp_sum( gauss3,  inter_bgrp_comm )

         call mp_sum( loren1,  inter_pool_comm ) ! reduce over k (nks)
         call mp_sum( loren1a, inter_pool_comm )
         call mp_sum( loren2,  inter_pool_comm )
         call mp_sum( loren3,  inter_pool_comm )
         call mp_sum( gauss1,  inter_pool_comm )
         call mp_sum( gauss1a, inter_pool_comm )
         call mp_sum( gauss2,  inter_pool_comm )
         call mp_sum( gauss3,  inter_pool_comm )

         loren1  = pi * lp * loren1 /omega/3.0_DP * AU_TO_OHMM_INV
         loren1a = pi * lp * loren1a/omega/6.0_DP * AU_TO_OHMM_INV
         loren2  = pi * lp * loren2 /omega/3.0_DP * AU_TO_OHMM_INV
         loren3  = pi * lp * loren3 /omega/6.0_DP * AU_TO_OHMM_INV

         gauss1  = pi * gp * gauss1 /omega/3.0_DP * AU_TO_OHMM_INV
         gauss1a = pi * gp * gauss1a/omega/6.0_DP * AU_TO_OHMM_INV
         gauss2  = pi * gp * gauss2 /omega/3.0_DP * AU_TO_OHMM_INV
         gauss3  = pi * gp * gauss3 /omega/6.0_DP * AU_TO_OHMM_INV

         IF(IONODE) THEN
            write(121,'(1p,9es20.7e3)') wgrid(iw)*AUTOEV, &
                                        loren1, loren1a, loren2, loren3, &
                                        gauss1, gauss1a, gauss2, gauss3
         ENDIF ! ionode

     enddo ! iw

     IF(IONODE) THEN
        close(121)
     ENDIF ! ionode

   end subroutine check_delta_sub ! check delta function representation

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

   !===========================================================================
   !               Full Conductivity tensor (\sigma_1)
   !===========================================================================
   !
   ! Two choices for the \sigma_1 formula: 
   ! 1) With the 1/w factor          (approximated formula)
   ! 2) With the 1/(e_n-e_n') factor (exact formula)
   !


   !----------------------------------------------------------------------------
   subroutine sigma1_approx_1lorentzian

      ! Lorentzian delta function
      ! (sa / Pi) / ( (ei - ej - omega)^2 + sa^2 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      ! So we only have sa as prefactor

      sa   = 0.5_dp * deltawidth / AUTOEV ! Lorentzian half-width in Ha

      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )


      ! Avoid division by zero
      iw   = 0
      iaux = 0
      do while ( wgrid(iw) < 1.0D-12 )
         iw = iw + 1      
      enddo 
      iaux = iw

      if ( iaux /= 0 ) then
         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
         write(stdout,*) "    Conductivity for zero frequency can not" 
         write(stdout,*) "    be calculated using the KG approximated formula"
         write(stdout,*) "    with one Lorentzian representing the Dirac delta"
         write(stdout,*) "    function." 
         write(stdout,*) "      Calculation will start at", wgrid(iaux)," Ha." 
         !write(stdout,*) "    ================================================"

         if ( dc ) then

            write(stdout,*) ""
            !write(stdout,*) "    ================================================"
            !write(stdout,*) "    WARNING:" 
            write(stdout,*) "    dc is set to TRUE, hence the DC component will be"
            write(stdout,*) "    calculated using the analytical limit for the "
            write(stdout,*) "    approximated formula and two Lorentzians."
            write(stdout,*) "    ================================================"

         else

            write(stdout,*) ""    
            !write(stdout,*) "    ================================================"
            !write(stdout,*) "    WARNING:" 
            write(stdout,*) "    Set dc=.true. to calculate the DC component with"
            write(stdout,*) "    the analytical limit of the approximated formula"
            write(stdout,*) "    with two Lorenziants."
            write(stdout,*) "    ================================================"

         endif

      endif

      do iw = iaux, nw
         maux(1:3,1:3) = 0.0_DP

         do ix1 = 1, 3
         do ix2 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1  = ibb1 + nbnds_per_process * my_rank_old &
                              + nbnds_per_group   * my_group

               do ib2 = 1, nbnd

                  if ( ib2 == ib1 ) cycle
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha

                  maux(ix2,ix1) = maux(ix2,ix1)                                 &
                                  + ( wg(ib2,ik) - wg(ib1,ik) )                 &
                                    * real(conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                           *     psi_grad_psi(ix2,ib2,ibb1,ik)) &   
                                              /   ( eem*eem + sa*sa )         

               enddo ! ib2
               enddo    ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)
         
         sigma1(1:3,1:3,iw) = sa * maux(1:3,1:3) / ( omega * wgrid(iw) )

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', ABS(ierr) )

    
      sigma1_atrace(0:nw) = ( sigma1(1,1,0:nw) + & 
                              sigma1(2,2,0:nw) + &
                              sigma1(3,3,0:nw) ) / 3.0_DP

   end subroutine sigma1_approx_1lorentzian

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

   subroutine sigma1_approx_2lorentzian

      ! Lorentzian delta function
      ! (sa / Pi) / ( (ei - ej - omega)^2 + sa^2 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      ! So up to here we only have sa as prefactor

      ! Use s(w) = ( s(w)+s(-w) ) / 2 to get
      ! ( 1/( (e-w)^2 + sa^2 ) - 1/( (e+w)^2 + sa^2 ) ) / w =
      ! 4 * e / ( ((e-w)^2 + sa^2)* ((e+w)^2 + sa^2 ) ), which changes
      ! the prefactor to 2 sa
      ! but summing over ib1 and ib2=ib1+1 we have 4 sa as the final
      ! prefactor
 
      sa   = 0.5_dp * deltawidth / AUTOEV ! Lorentzian half-width in Ha
      aux  = 4.0_DP * sa
      
      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )

      do iw = 0, nw
         maux(1:3,1:3) = 0.0_DP

         do ix1 = 1, 3
         do ix2 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1  = ibb1 + nbnds_per_process * my_rank_old &
                              + nbnds_per_group   * my_group

               do ib2 = ib1 + 1, nbnd
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  maux(ix2,ix1) = maux(ix2,ix1)                                &
                                  + ( wg(ib2,ik) - wg(ib1,ik) )                &
                                    * real(conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                           *     psi_grad_psi(ix2,ib2,ibb1,ik)) &   
                                        * ee / (   ( eem*eem + sa*sa )         &
                                                 * ( eep*eep + sa*sa ) )

               enddo ! ib2
               enddo    ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)
         
         sigma1(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', ABS(ierr) )

    
      sigma1_atrace(0:nw) = ( sigma1(1,1,0:nw) + & 
                              sigma1(2,2,0:nw) + &
                              sigma1(3,3,0:nw) ) / 3.0_DP

   end subroutine sigma1_approx_2lorentzian

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

   subroutine sigma1_approx_2lorentzian_DC

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      sa  = 0.5_DP * deltawidth / AUTOEV ! Lorentzian half-width in Ha
      aux = 2.0_DP * sa                  ! Prefactor from lim w->0
   
      aux = 2.0_DP * aux                 ! Twice the sum ib1, ib2=ib1+1  
      
      
      maux(1:3,1:3) = 0.0_DP

      do ix1 = 1, 3
         do ix2 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1  = ibb1 + nbnds_per_process * my_rank_old &
                              + nbnds_per_group   * my_group

               do ib2 = ib1 + 1, nbnd

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  maux(ix2,ix1) = maux(ix2,ix1)                                &
                                  + ( wg(ib2,ik) - wg(ib1,ik) )                &
                                    * real(conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                           *     psi_grad_psi(ix2,ib2,ibb1,ik)) &   
                                        * ee / (   ( ee*ee + sa*sa )         &
                                                 * ( ee*ee + sa*sa ) )

               enddo ! ib2
               enddo    ! ib1

            enddo ! ik

         enddo ! ix2
      enddo ! ix1

      call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)
         
      sigma1_dc(1:3,1:3) = aux * maux(1:3,1:3) / omega
      sigma1_dc_atrace   = (   sigma1_dc(1,1) &
                             + sigma1_dc(2,2) &
                             + sigma1_dc(3,3) )/3.0_dp

   end subroutine sigma1_approx_2lorentzian_DC

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

   subroutine sigma1_approx_1gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV       ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg             ! pi * 1/ (sg * sqrt(pi) ) 
                                        ! The pi comes form KG formula
                                        ! The 2 in KG goes into the wg 
                                        ! factors

      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )
                                        ! The 1/2 comes from (s(w)+s(-w))/2
      ! Avoid division by zero
      iw   = 0
      iaux = 0
      do while ( wgrid(iw) < 1.0D-12 )
         iw = iw + 1      
      enddo 
      iaux = iw

      if ( iaux /= 0 ) then
         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
         write(stdout,*) "    Conductivity for zero frequency can not" 
         write(stdout,*) "    be calculated using the KG approximated formula"
         write(stdout,*) "    with one Gaussian representing the Dirac delta"
         write(stdout,*) "    function." 
         write(stdout,*) "      Calculation will start at", wgrid(iaux)," Ha." 
         !write(stdout,*) "    ================================================"

         if ( dc ) then

            write(stdout,*) ""
            !write(stdout,*) "    ================================================"
            !write(stdout,*) "    WARNING:" 
            write(stdout,*) "    dc is set to TRUE, hence the DC component will be"
            write(stdout,*) "    calculated using the analytical limit for the "
            write(stdout,*) "    approximated formula and two Gaussians."
            write(stdout,*) "    ================================================"

         else

            write(stdout,*) ""    
            !write(stdout,*) "    ================================================"
            !write(stdout,*) "    WARNING:" 
            write(stdout,*) "    Set dc=.true. to calculate the DC component with"
            write(stdout,*) "    the analytical limit of the approximated formula"
            write(stdout,*) "    with two Gaussians."
            write(stdout,*) "    ================================================"

         endif

      endif

      do iw = iaux, nw

         do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = 1, nbnd
                   
                  if ( ib2 == ib1 ) cycle
                   
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha

                  maux(ix2, ix1) = maux(ix2,ix1)                               &
                              +  ( wg(ib2,ik) - wg(ib1,ik) )/wgrid(iw)         &
                                * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))   &
                                        * psi_grad_psi(ix2,ib2,ibb1,ik)      ) &
                                          * exp(-eem*eem/(sg*sg))

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', ABS(ierr) )

    
      sigma1_atrace(0:nw) = ( sigma1(1,1,0:nw) + & 
                              sigma1(2,2,0:nw) + &
                              sigma1(3,3,0:nw) ) / 3.0_DP

   end subroutine sigma1_approx_1gaussian

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

   subroutine sigma1_approx_2gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV       ! Gaussian width in Ha
      !aux  =  0.5_dp * sqrt(pi) / sg   ! pi * 1/2 * 1/ (sg * sqrt(pi) ) 
                                        ! The 1/2 comes from (s(w)+s(-w))/2
                                        ! The pi comes form KG formula
                                        ! The 2 in KG goes into the wg             
                                        ! factors                                        
      aux  =  sqrt(pi) / sg             ! Factor of two to account for 
                                        ! adding ib1, ib2=ib1+1
                                     

      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )
                                        ! The 1/2 comes from (s(w)+s(-w))/2
      ! Avoid division by zero
      iw   = 0
      iaux = 0
      do while ( wgrid(iw) < 1.0D-12 )
         iw = iw + 1      
      enddo 
      iaux = iw

      if ( iaux /= 0 ) then
         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
         write(stdout,*) "    Conductivity for zero frequency can not" 
         write(stdout,*) "    be calculated using the KG approximated formula"
         write(stdout,*) "    without taking proper analytical limits."
         write(stdout,*) "    Calculation will start at", wgrid(iaux)," Ha." 
         write(stdout,*) "    ================================================"
      endif

      if ( dc ) then

         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
         write(stdout,*) "    dc is set to TRUE, hence the DC component with"
         write(stdout,*) "    the choosen formula and Dirac delta function"
         write(stdout,*) "    representation will be calculated and reported"
         write(stdout,*) "    in this output." 
         write(stdout,*) "    ================================================"

      else
    
         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
         write(stdout,*) "    Set dc=.true. to calculate the DC component with"
         write(stdout,*) "    the choosen formula and Dirac delta function"
         write(stdout,*) "    representation. " 
         write(stdout,*) "    ================================================"

      endif

      do iw = iaux, nw

         do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = ib1 + 1, nbnd
               
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  maux(ix2, ix1) = maux(ix2,ix1)                                &
                              +  ( wg(ib2,ik) - wg(ib1,ik) )                    &
                                * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))    &
                                        * psi_grad_psi(ix2,ib2,ibb1,ik)       ) &
                            * ( exp(-eem*eem/(sg*sg)) - exp(-eep*eep/(sg*sg)) )

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1(1:3,1:3,iw) = aux * maux(1:3,1:3) / ( omega * wgrid(iw) )

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', ABS(ierr) )

    
      sigma1_atrace(0:nw) = ( sigma1(1,1,0:nw) + & 
                              sigma1(2,2,0:nw) + &
                              sigma1(3,3,0:nw) ) / 3.0_DP

   end subroutine sigma1_approx_2gaussian

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

   subroutine sigma1_approx_2gaussian_DC

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV         ! Gaussian width in Ha
      aux  =  2.0_dp * sqrt(pi) &         ! pi * 1/2 *( 1/ (sg * sqrt(pi) ) ) 
              / (sg*sg*sg)                ! 4 / sg^2
                                          ! The 1/2 comes from (s(w)+s(-w))/2
                                          ! The pi comes form KG formula
                                          ! The 2 in KG goes into the wg 
                                          ! factors                                        
                                          ! The 4/sg^2 comes from w->0 limit
      aux = 2.0_DP * aux                  ! Factor of two to account for the
                                          ! sum ib1,ib2=ib1+1
                                          

         do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = ib1 + 1, nbnd
               
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  maux(ix2, ix1) = maux(ix2,ix1)                                &
                              +  ( wg(ib2,ik) - wg(ib1,ik) )                    &
                                * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))    &
                                        * psi_grad_psi(ix2,ib2,ibb1,ik)       ) &
                                          *  ee * exp(-ee*ee/(sg*sg))


               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_dc(1:3,1:3) = aux * maux(1:3,1:3) / omega
         sigma1_dc_atrace   = (   sigma1_dc(1,1) &
                                + sigma1_dc(2,2) &
                                + sigma1_dc(3,3) )/3.0_DP

   end subroutine sigma1_approx_2gaussian_DC
   
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   subroutine sigma1_exact_1lorentzian

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )

      sa   = 0.5_dp * deltawidth / AUTOEV  ! Lorentzian half-width in Ha

      do iw = 0, nw

         do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       
               do ib2 = 1, nbnd

                  if ( sigma1_notintra .and. ib2 == ib1 ) cycle
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha

                  if( ib2 == ib1 .or. abs(ee) <=  de ) then
                     focc =1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss)+1.0_DP)
                     dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss * 2.0_DP
                  endif

                  if( abs(ee) > de ) &
                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  maux(ix2, ix1) = maux(ix2,ix1)                                &
                                 + dfde                                         &
                                   * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                      *          psi_grad_psi(ix2,ib2,ibb1,ik) )&
                                                 / ( eem*eem + sa*sa )         

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1(1:3,1:3,iw) = sa * maux(1:3,1:3) / omega

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', ABS(ierr) )

    
      sigma1_atrace(0:nw) = ( sigma1(1,1,0:nw) + & 
                              sigma1(2,2,0:nw) + &
                              sigma1(3,3,0:nw) ) / 3.0_DP

   end subroutine sigma1_exact_1lorentzian

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

   subroutine sigma1_exact_2lorentzian

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )


      sa   = 0.5_dp * deltawidth / AUTOEV  ! Lorentzian half-width in Ha

      ! aux = 0.5 * sa (from 1/2 ( s(w) + s(-w) )
      ! aux = 2 * aux to sum over ib1, ib2+1 => aux = sa

      do iw = 0, nw

         do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       
               do ib2 = ib1, nbnd

                  if ( sigma1_notintra .and. ib2 == ib1 ) cycle
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  if( ib2 == ib1 .or. abs(ee) <=  de ) then
                     focc =1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss)+1.0_DP)
                     dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP
                  endif

                  if( abs(ee) > de ) &
                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee


                  maux(ix2, ix1) = maux(ix2,ix1)                               &
                                 + dfde                                        &
                                   * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                      *          psi_grad_psi(ix2,ib2,ibb1,ik) )&
                                        * ( 1.0_DP/( eem*eem + sa*sa )         &
                                            + 1.0_DP/( eep*eep + sa*sa ) )

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1(1:3,1:3,iw) = sa * maux(1:3,1:3) / omega

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', ABS(ierr) )

    
      sigma1_atrace(0:nw) = ( sigma1(1,1,0:nw) + & 
                              sigma1(2,2,0:nw) + &
                              sigma1(3,3,0:nw) ) / 3.0_DP

   end subroutine sigma1_exact_2lorentzian

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

   subroutine sigma1_exact_lorentzian_DC

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      sa   = 0.5_dp * deltawidth / AUTOEV  ! Lorentzian half-width in Ha

      do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       
               do ib2 = ib1, nbnd

                  if ( sigma1_notintra .and. ib2 == ib1 ) cycle
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if( ib2 == ib1 .or. abs(ee) <=  de ) then
                     focc =1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss)+1.0_DP)
                     dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP
                  endif

                  if( abs(ee) > de ) &
                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  ! Factor of two above accounts for the sum ib1, ib2=ib1+1   
                  if ( ib2 /= ib1 ) dfde = 2.0_DP * dfde
                  

                  maux(ix2, ix1) = maux(ix2,ix1)                                &
                                 + dfde                                         &
                                   * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                      *          psi_grad_psi(ix2,ib2,ibb1,ik) )&
                                        /( ee*ee + sa*sa )
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix2
      enddo ! ix1

      call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)


      sigma1_dc(1:3,1:3) = sa * maux(1:3,1:3) / omega
      sigma1_dc_atrace   = (    sigma1_dc(1,1) &
                              + sigma1_dc(2,2) &
                              + sigma1_dc(3,3) )/3.0_DP

   end subroutine sigma1_exact_lorentzian_DC



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

   subroutine sigma1_exact_1gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV        ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg              !  pi * (1 / (sg * sqrt(pi) ) 
                                         ! The pi comes form KG formula
                                         ! The 2 in KG goes into the wg factors                                        

      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )

      do iw = 0, nw

         do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group               

               do ib2 = 1, nbnd

                  if ( sigma1_notintra .and. ib2 == ib1 ) cycle
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha

                  if ( ib2 == ib1 .or. abs(ee) <= de ) then
                     focc = 1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP)
                     dfde =-wk(ik)*focc*( focc - 1.0_DP ) / degauss * 2.0_DP
                  endif
                  
                  if( abs(ee) > de ) &
                      dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  maux(ix2,ix1) = maux(ix2,ix1)                                 &
                                + dfde                                          &
                                  * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))  &
                                    *           psi_grad_psi( ix2,ib2,ibb1,ik) )&
                                      * exp(-eem*eem/(sg*sg))                   
                                          
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

          enddo ! ix1
          enddo ! ix2

          call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
          call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

          sigma1(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', ABS(ierr) )

    
      sigma1_atrace(0:nw) = ( sigma1(1,1,0:nw) + & 
                              sigma1(2,2,0:nw) + &
                              sigma1(3,3,0:nw) ) / 3.0_DP

   end subroutine sigma1_exact_1gaussian 

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

   subroutine sigma1_exact_2gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV        ! Gaussian width in Ha
      aux  =  0.5_dp * sqrt(pi) / sg     ! pi * 1/2 * 1/ (sg * sqrt(pi) ) 
                                         ! The 1/2 comes from (s(w)+s(-w))/2
                                         ! The pi comes form KG formula
                                         ! The 2 in KG goes into the wg 
                                         ! factors                                        
      aux = 2.0_DP * aux   ! Factor of two to sum over ib1,ib2=ib1+1


      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )

      do iw = 0, nw

         do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group               

               do ib2 = ib1, nbnd

                  if ( sigma1_notintra .and. ib2 == ib1 ) cycle
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  if( ib2 == ib1 .or. abs(ee) <= de ) then
                     focc = 1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP)
                     dfde =-wk(ik)*focc*( focc - 1.0_DP ) / degauss * 2.0_DP
                  endif

                  if( abs(ee) > de ) &
                      dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee
 
                  maux(ix2,ix1) = maux(ix2,ix1)                                &
                                + dfde                                         &
                                  * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))  &
                                    *           psi_grad_psi( ix2,ib2,ibb1,ik) )&
                                      * ( exp(-eem*eem/(sg*sg))                &
                                          + exp(-eep*eep/(sg*sg)) )

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

          enddo ! ix1
          enddo ! ix2

          call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
          call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

          sigma1(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', ABS(ierr) )

    
      sigma1_atrace(0:nw) = ( sigma1(1,1,0:nw) + & 
                              sigma1(2,2,0:nw) + &
                              sigma1(3,3,0:nw) ) / 3.0_DP

   end subroutine sigma1_exact_2gaussian 

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

   subroutine sigma1_exact_gaussian_DC

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV        ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg              !  pi * (1 / (sg * sqrt(pi) ) 
                                         ! The pi comes form KG formula
                                         ! The 2 in KG goes into the wg 
                                         ! factors                                        

         do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group               

               do ib2 = ib1, nbnd

                  if ( sigma1_notintra .and. ib2 == ib1 ) cycle
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if ( ib2 == ib1 .or. abs(ee) <= de ) then
                     focc = 1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP)
                     dfde =-wk(ik)*focc*( focc - 1.0_DP ) / degauss * 2.0_DP
                  endif
                  
                  if( abs(ee) > de ) &
                      dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  ! Factor of two to account for the sum ib1, ib2=ib1+1
                  if ( ib1 /=  ib2 ) dfde = 2.0_DP * dfde

                  maux(ix2,ix1) = maux(ix2,ix1)                                 &
                                + dfde                                          &
                                  * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))  &
                                    *           psi_grad_psi( ix2,ib2,ibb1,ik) )&
                                      * exp(-ee*ee/(sg*sg))                   
                                          
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

          enddo ! ix1
          enddo ! ix2

          call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
          call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_dc(1:3,1:3) = aux * maux(1:3,1:3) / omega
         sigma1_dc_atrace   = ( sigma1_dc(1,1) + sigma1_dc(2,2) &
                                                      + sigma1_dc(3,3) )/3.0_DP

   end subroutine sigma1_exact_gaussian_DC 

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



!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! SUBROUTINES FOR DECOMPOSITION IN INTRA, INTER and DEGENERATE CONTRIBUTIONS
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   subroutine sigma1_exact_decomp_1lorentzian

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      sa   = 0.5_dp * deltawidth / AUTOEV     ! Lorentzian half-width in Ha

      ! Intra bands contribution

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

      do iw = 0, nw
         eem =   wgrid(iw)                       ! in Ha

         do ix1 = 1, 3
         do ix2 = 1, 3

            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  focc =  1.0_DP/(dexp((et(ib1,ik)-e_f)/degauss)+1.0_DP)
                  dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) /degauss * 2.0_DP

                  maux(ix2,ix1) = maux(ix2,ix1)                                &
                                 + dfde                                        &
                                   *real( conjg(psi_grad_psi(ix1,ib1,ibb1,ik)) &
                                     *          psi_grad_psi(ix2,ib1,ibb1,ik) )& 
                                       /( eem*eem + sa*sa )       

               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_intra(1:3,1:3,iw) =  sa * maux(1:3,1:3) / omega

      enddo ! iw
      ! End intra band contributions

      ! Degeneracies contribution
      allocate( sigma1_degen(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_degen', &
                                                                      ABS(ierr))
      do iw = 0, nw

         do ix1 = 1, 3
         do ix2 = 1, 3

            maux(ix2,ix1)=0.0_DP
            
            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = 1, nbnd

                  if ( ib2 == ib1 ) cycle

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha

                  if( abs(ee) <=  de ) then
                     focc = 1.0_DP/( dexp( (et(ib2,ik)-e_f)/degauss ) + 1.0_DP )
                     dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) /degauss * 2.0_DP

                     maux(ix2,ix1) = maux(ix2,ix1)                              &
                                  + dfde                                        &
                                    *real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                       *         psi_grad_psi(ix2,ib2,ibb1,ik) )&
                                          / ( eem*eem + sa*sa )
                  endif

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_degen(1:3,1:3,iw) = sa * maux(1:3,1:3) / omega


      enddo ! iw
      ! End degeneracies contribution

      ! Inter bands contribution
      allocate( sigma1_inter(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_inter', &
                                                                      ABS(ierr))
      do iw = 0, nw 

         do ix1 = 1, 3
         do ix2 = 1, 3

            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = 1, nbnd

                  if ( ib2 == ib1 ) cycle

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  if ( abs(ee) <= de ) cycle

                  eem = ee - wgrid(iw)                       ! in Ha

                  dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  maux(ix2,ix1) = maux(ix2,ix1)                                &
                                  + dfde                                       &
                                    *real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))&
                                      *       psi_grad_psi( ix2,ib2,ibb1,ik ) )&
                                        / ( eem*eem + sa*sa )

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_inter(1:3,1:3,iw) = sa * maux(1:3,1:3) / omega

      enddo ! iw


      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )
      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))
      allocate( sigma1_atrace_degen(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_degen', &
                                                                      ABS(ierr))
      allocate( sigma1_atrace_inter(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_inter', &
                                                                      ABS(ierr))
                                                                            
      sigma1(1:3,1:3,0:nw) =   sigma1_intra(1:3,1:3,0:nw) &
                               + sigma1_degen(1:3,1:3,0:nw) &
                               + sigma1_inter(1:3,1:3,0:nw)

      allocate( sigma1_atrace_intra(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_intra', &
                                                                      ABS(ierr))
      sigma1_atrace_intra(0:nw) = ( sigma1_intra(1,1,0:nw) + &
                    sigma1_intra(2,2,0:nw) + sigma1_intra(3,3,0:nw) )/3.0_DP

      sigma1(1:3,1:3,0:nw) =   sigma1_degen(1:3,1:3,0:nw) &
                               + sigma1_inter(1:3,1:3,0:nw)
      
      sigma1_atrace(0:nw) = ( sigma1(1,1,0:nw) + sigma1(2,2,0:nw) &
                                                   + sigma1(3,3,0:nw) )/3.0_DP

      sigma1_atrace_degen(0:nw) = ( sigma1_degen(1,1,0:nw) + &
                    sigma1_degen(2,2,0:nw) + sigma1_degen(3,3,0:nw) )/3.0_DP
      sigma1_atrace_inter(0:nw) = ( sigma1_inter(1,1,0:nw) + &
                    sigma1_inter(2,2,0:nw) + sigma1_inter(3,3,0:nw) )/3.0_DP


   end subroutine sigma1_exact_decomp_1lorentzian

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

   subroutine sigma1_exact_decomp_2lorentzian

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant

      sa   = 0.5_dp * deltawidth / AUTOEV     ! Lorentzian half-width in Ha
      !aux  = 0.5_dp * sa                      ! Prefactor including the 1/2 from
                                              ! ( 1/( (e-w)^2 + sa^2/4 ) 
                                              !   + 1/( (e+w)^2 + sa^2/4 ) )/2

      !aux = 2.0_DP * aux = sa (Factor of two to sum over ib1,ib2=ib1+1) 

      ! Intra bands contribution

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

      do iw = 0, nw
         eem = wgrid(iw)                       ! in Ha

         do ix1 = 1, 3
         do ix2 = 1, 3

            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  focc =  1.0_DP/(dexp((et(ib1,ik)-e_f)/degauss)+1.0_DP)
                  dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) /degauss * 2.0_DP

                  maux(ix2,ix1) = maux(ix2,ix1)                                &
                                 + dfde                                        &
                                   *real( conjg(psi_grad_psi(ix1,ib1,ibb1,ik))  &
                                     *          psi_grad_psi( ix2,ib1,ibb1,ik) )& 
                                       * ( 1.0_DP/( eem*eem + sa*sa ) )       

               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_intra(1:3,1:3,iw) = sa * maux(1:3,1:3) / omega

      enddo ! iw
      ! End intra band contributions


      ! Degeneracies contribution
      allocate( sigma1_degen(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_degen', &
                                                                      ABS(ierr))


      do iw = 0, nw

         do ix1 = 1, 3
         do ix2 = 1, 3

            maux(ix2,ix1)=0.0_DP
            
            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = ib1 + 1, nbnd

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  if( abs(ee) <=  de ) then
                     focc = 1.0_DP/( exp( (et(ib2,ik)-e_f)/degauss ) + 1.0_DP )
                     dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) /degauss * 2.0_DP

                     maux(ix2,ix1) = maux(ix2,ix1)                              &
                                  + dfde                                        &
                                    *real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                       *         psi_grad_psi(ix2,ib2,ibb1,ik) )&
                                         * ( 1.0_DP/( eem*eem + sa*sa )+ &
                                             1.0_DP/( eep*eep + sa*sa ) )
                  endif

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_degen(1:3,1:3,iw) = sa * maux(1:3,1:3) / omega

      enddo ! iw
      ! End degeneracies contribution

      ! Inter bands contribution
      allocate( sigma1_inter(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_inter', &
                                                                      ABS(ierr))
      do iw = 0, nw 

         do ix1 = 1, 3
         do ix2 = 1, 3

            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = ib1 + 1, nbnd

                  if ( ib2 == ib1 ) cycle

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  if ( abs(ee) <= de ) cycle

                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  maux(ix2,ix1) = maux(ix2,ix1)                                &
                                  + dfde                                       &
                                    *real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))&
                                      *       psi_grad_psi( ix2,ib2,ibb1,ik ) )&
                                        * ( 1.0_DP/( eem*eem + sa*sa )         &
                                            + 1.0_DP/( eep*eep + sa*sa ) )

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_inter(1:3,1:3,iw) = sa * maux(1:3,1:3) / omega

      enddo ! iw


      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )
      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      sigma1(1:3,1:3,0:nw) =    sigma1_degen(1:3,1:3,0:nw) &
                              + sigma1_inter(1:3,1:3,0:nw)

      sigma1(1:3,1:3,0:nw) =    sigma1(1:3,1:3,0:nw)       &
                                 + sigma1_intra(1:3,1:3,0:nw) 

      allocate( sigma1_atrace_intra(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_intra', &
                                                                      ABS(ierr))

      sigma1_atrace_intra(0:nw) = (   sigma1_intra(1,1,0:nw) &
                                       + sigma1_intra(2,2,0:nw) &
                                       + sigma1_intra(3,3,0:nw) )/3.0_DP

      sigma1_atrace(0:nw) = (   sigma1(1,1,0:nw) &
                              + sigma1(2,2,0:nw) &
                              + sigma1(3,3,0:nw) )/3.0_DP

      allocate( sigma1_atrace_degen(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_degen', &
                                                                      ABS(ierr))
      allocate( sigma1_atrace_inter(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_inter', &
                                                                      ABS(ierr))

      sigma1_atrace_degen(0:nw) = (   sigma1_degen(1,1,0:nw) &
                                    + sigma1_degen(2,2,0:nw) &
                                    + sigma1_degen(3,3,0:nw) )/3.0_DP
                                    
      sigma1_atrace_inter(0:nw) = (   sigma1_inter(1,1,0:nw) &
                                    + sigma1_inter(2,2,0:nw) &
                                    + sigma1_inter(3,3,0:nw) )/3.0_DP

   end subroutine sigma1_exact_decomp_2lorentzian

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

   subroutine sigma1_exact_decomp_lorentzian_DC

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      sa   = 0.5_dp * deltawidth / AUTOEV  ! Lorentzian half-width in Ha

      ! Intra bands contributions

      do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       

                  focc =1.0_DP/(dexp((et(ib1,ik)-e_f)/degauss)+1.0_DP)
                  dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP

                  maux(ix2, ix1) = maux(ix2,ix1)                                &
                                 + dfde                                         &
                                   * real( conjg(psi_grad_psi(ix1,ib1,ibb1,ik)) &
                                      *          psi_grad_psi(ix2,ib1,ibb1,ik) )
                                        
               enddo ! ib1

            enddo ! ik

         enddo ! ix2
      enddo ! ix1

      call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

      sigma1_dc_intra(1:3,1:3) = maux(1:3,1:3) / omega / sa
      sigma1_dc_atrace_intra   = (    sigma1_dc_intra(1,1) &
                                    + sigma1_dc_intra(2,2) &
                                    + sigma1_dc_intra(3,3) )/3.0_DP

      ! Degeneracies contributions
      aux = 2.0_DP * sa             ! Factor of 2 to sum over ib1, ib2=ib1+1

      do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       
               do ib2 = ib1+1, nbnd

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if( abs(ee) >  de ) cycle

                  focc =1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss)+1.0_DP)
                  dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP
 
                  maux(ix2, ix1) = maux(ix2,ix1)                               &
                                 + dfde                                        &
                                   * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                      *          psi_grad_psi(ix2,ib2,ibb1,ik) )&
                                        /( ee*ee + sa*sa )
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix2
      enddo ! ix1

      call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)


      sigma1_dc_degen(1:3,1:3) = aux * maux(1:3,1:3) / omega
      sigma1_dc_atrace_degen   = (    sigma1_dc_degen(1,1) &
                                    + sigma1_dc_degen(2,2) &
                                    + sigma1_dc_degen(3,3) )/3.0_DP

      ! Inter band contributions

      do ix1 = 1, 3
         do ix2 = 1, 3
            maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       
               do ib2 = ib1+1, nbnd
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if ( abs(ee) <= de ) cycle

                  dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee    

                  maux(ix2, ix1) = maux(ix2,ix1)                               &
                                 + dfde                                        &
                                   * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                      *          psi_grad_psi(ix2,ib2,ibb1,ik) )&
                                        /( ee*ee + sa*sa )
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix2
      enddo ! ix1

      call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)


      sigma1_dc_inter(1:3,1:3) = aux * maux(1:3,1:3) / omega
      sigma1_dc_atrace_inter   = (    sigma1_dc_inter(1,1) &
                                    + sigma1_dc_inter(2,2) &
                                    + sigma1_dc_inter(3,3) )/3.0_DP

      sigma1_dc(1:3,1:3) =   sigma1_dc_intra(1:3,1:3) &
                           + sigma1_dc_degen(1:3,1:3) & 
                           + sigma1_dc_inter(1:3,1:3)

      sigma1_dc_atrace   =   sigma1_dc_atrace_intra   &
                           + sigma1_dc_atrace_degen   & 
                           + sigma1_dc_atrace_inter

   end subroutine sigma1_exact_decomp_lorentzian_DC

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

   subroutine sigma1_exact_decomp_1gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV       ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg             ! pi / ( sg * sqrt(pi) ) 


      ! Intra bands contribution
      
      allocate( sigma1_intra(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_intra', &
                                                                      ABS(ierr))

      do iw = 0, nw

         eem = wgrid(iw)                       ! in Ha

         do ix1 = 1, 3
            do ix2 = 1, 3
               maux(ix2,ix1) = 0.0_DP

               do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                     focc = 1.0_DP / ( dexp((et(ib1,ik)-e_f)/degauss) + 1.0_DP )
                     dfde =-wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP

                     maux(ix2, ix1) = maux(ix2,ix1)                            &
                                 + dfde                                        &
                                   *real( conjg(psi_grad_psi(ix1,ib1,ibb1,ik))  &
                                          *     psi_grad_psi(ix2,ib1,ibb1,ik) ) &
                                     * ( exp(-eem*eem/(sg*sg)) )

                  enddo    ! ib1

               enddo ! ik

            enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_intra(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega

      enddo ! iw
      ! End intra bands contribution

      ! Degeneracies contribution
      allocate( sigma1_degen(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_degen', &
                                                                      ABS(ierr))

      do iw = 0, nw

         do ix1 = 1, 3
            do ix2 = 1, 3
               maux(ix2,ix1) = 0.0_DP

               do ik = 1, nks
               
               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group 

                  do ib2 = 1, nbnd

                     if ( ib2 == ib1 ) cycle

                     ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                     eem = ee - wgrid(iw)                       ! in Ha
                     eep = ee + wgrid(iw)                       ! in Ha

                     if( abs(ee) <=  de ) then
                        focc =1.0_DP/( dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP )
                        dfde =-wk(ik)*focc*( focc - 1.0_DP ) / degauss * 2.0_DP
                        maux(ix2,ix1) = maux(ix2,ix1)                          &
                                  + dfde                                       &
                                  * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                          *     psi_grad_psi(ix2,ib2,ibb1,ik) )&
                                    * ( exp(-eem*eem/(sg*sg))  )
                     endif

                  enddo ! ib2
                  enddo ! ib1

               enddo ! ik

            enddo ! ix1
         enddo    ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_degen(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega

      enddo ! iw
      ! End degeneracies contribution

      ! Inter band contributions
      allocate( sigma1_inter(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_inter', &
                                                                      ABS(ierr))

      do iw = 0, nw

         do ix1 = 1, 3
            do ix2 = 1, 3
               maux(ix2,ix1) = 0.0_DP

               do ik = 1, nks
  
                   do ibb1 = 1, nbnds_local
                      ib1 = ibb1 + nbnds_per_process * my_rank_old &
                                 + nbnds_per_group   * my_group

                     do ib2 = 1, nbnd

                        if ( ib2 == ib1 ) cycle

                        ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                        if ( abs(ee) <= de ) cycle

                        eem = ee - wgrid(iw)                       ! in Ha
                        eep = ee + wgrid(iw)                       ! in Ha

                        dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                        maux(ix2, ix1) = maux(ix2,ix1)                         &
                                + dfde                                         &
                                  *real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))  &
                                      *        psi_grad_psi( ix2,ib2,ibb1,ik ))&
                                        * (  exp(-eem*eem/(sg*sg))   )          
                     enddo ! ib2
                  enddo    ! ib1

               enddo ! ik

            enddo ! ix1
         enddo    ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_inter(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega

      enddo ! iw
      ! End inter band contributions

      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )
      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      sigma1(1:3,1:3,0:nw) =    sigma1_degen(1:3,1:3,0:nw) &
                              + sigma1_inter(1:3,1:3,0:nw)
      sigma1(1:3,1:3,0:nw) =    sigma1(1:3,1:3,0:nw)       &
                                 + sigma1_intra(1:3,1:3,0:nw) 

      allocate( sigma1_atrace_intra(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_intra', &
                                                                      ABS(ierr))

      sigma1_atrace_intra(0:nw) = (   sigma1_intra(1,1,0:nw) &
                                       + sigma1_intra(2,2,0:nw) &
                                       + sigma1_intra(3,3,0:nw) )/3.0_DP

      sigma1_atrace(0:nw) = (   sigma1(1,1,0:nw) &
                              + sigma1(2,2,0:nw) &
                              + sigma1(3,3,0:nw) )/3.0_DP

      allocate( sigma1_atrace_degen(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_degen', &
                                                                      ABS(ierr))
      allocate( sigma1_atrace_inter(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_inter', &
                                                                      ABS(ierr))

      sigma1_atrace_degen(0:nw) = (   sigma1_degen(1,1,0:nw) &
                                    + sigma1_degen(2,2,0:nw) &
                                    + sigma1_degen(3,3,0:nw) )/3.0_DP
                                    
      sigma1_atrace_inter(0:nw) = (   sigma1_inter(1,1,0:nw) &
                                    + sigma1_inter(2,2,0:nw) &
                                    + sigma1_inter(3,3,0:nw) )/3.0_DP

   end subroutine sigma1_exact_decomp_1gaussian 

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

   subroutine sigma1_exact_decomp_2gaussian
      
      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV       ! Gaussian width in Ha
      aux =           sqrt(pi) / sg    ! pi / (sg * sqrt(pi) ) 
      !aux  =  0.5_dp * sqrt(pi) / sg    ! pi * 1/2 * 1/ (sg * sqrt(pi) ) 
                                        ! The 1/2 comes from (s(w)+s(-w))/2
      
      ! aux = 2 * aux to sum over ib1,ib2=ib1+1 so we have only sqrt(pi)/sg     


      ! Intra bands contribution
      
      allocate( sigma1_intra(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_intra', &
                                                                      ABS(ierr))

      do iw = 0, nw

         eem = wgrid(iw)                       ! in Ha

         do ix1 = 1, 3
            do ix2 = 1, 3
               maux(ix2,ix1) = 0.0_DP

               do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                     focc = 1.0_DP / ( dexp((et(ib1,ik)-e_f)/degauss) + 1.0_DP )
                     dfde =-wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP

                     maux(ix2, ix1) = maux(ix2,ix1)                             &
                                 + dfde                                         &
                                   *real( conjg(psi_grad_psi(ix1,ib1,ibb1,ik))  &
                                          *     psi_grad_psi(ix2,ib1,ibb1,ik) ) &
                                     * ( exp(-eem*eem/(sg*sg)) )

                  enddo    ! ib1

               enddo ! ik

            enddo ! ix1
         enddo ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_intra(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega

      enddo ! iw
      ! End intra bands contribution

      ! Degeneracies contribution
      allocate( sigma1_degen(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_degen', &
                                                                      ABS(ierr))

      ! aux already takes into account twice the sum over ib1, ib2=ib1+1

      do iw = 0, nw

         do ix1 = 1, 3
            do ix2 = 1, 3
               maux(ix2,ix1) = 0.0_DP

               do ik = 1, nks
               
               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group 

                  do ib2 = ib1 + 1, nbnd
                  
                     ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                     eem = ee - wgrid(iw)                       ! in Ha
                     eep = ee + wgrid(iw)                       ! in Ha

                     if( abs(ee) <=  de ) then
                        focc =1.0_DP/( dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP )
                        dfde =-wk(ik)*focc*( focc - 1.0_DP ) / degauss * 2.0_DP

                        maux(ix2,ix1) = maux(ix2,ix1)                          &
                                   + dfde                                      &
                                   * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))&
                                          *     psi_grad_psi(ix2,ib2,ibb1,ik) )&
                                     * (   exp(-eem*eem/(sg*sg))               &
                                         + exp(-eep*eep/(sg*sg)) )
                     endif

                  enddo ! ib2
                  enddo ! ib1

               enddo ! ik

            enddo ! ix1
         enddo    ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_degen(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega


      enddo ! iw
      ! End degeneracies contribution

      ! Inter band contributions
      allocate( sigma1_inter(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_inter', &
                                                                      ABS(ierr))

      do iw = 0, nw

         do ix1 = 1, 3
            do ix2 = 1, 3
               maux(ix2,ix1) = 0.0_DP

               do ik = 1, nks
  
                   do ibb1 = 1, nbnds_local
                      ib1 = ibb1 + nbnds_per_process * my_rank_old &
                                 + nbnds_per_group   * my_group

                     do ib2 = ib1 + 1, nbnd

                        ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                        if ( abs(ee) <= de ) cycle

                        eem = ee - wgrid(iw)                       ! in Ha
                        eep = ee + wgrid(iw)                       ! in Ha

                        dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                        maux(ix2, ix1) = maux(ix2,ix1)                         &
                                + dfde                                         &
                                  *real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))  &
                                      *        psi_grad_psi( ix2,ib2,ibb1,ik ))&
                                        * (  exp(-eem*eem/(sg*sg))             &
                                             + exp(-eep*eep/(sg*sg)) )

                     enddo ! ib2
                  enddo    ! ib1

               enddo ! ik

            enddo ! ix1
         enddo    ! ix2

         call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

         sigma1_inter(1:3,1:3,iw) = aux * maux(1:3,1:3) / omega

      enddo ! iw
      ! End inter band contributions

      allocate( sigma1(1:3,1:3,0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1', ABS(ierr) )

      sigma1(1:3,1:3,0:nw) =    sigma1_intra(1:3,1:3,0:nw) &
                              + sigma1_degen(1:3,1:3,0:nw) &
                              + sigma1_inter(1:3,1:3,0:nw) 

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))
      sigma1_atrace(0:nw) = (   sigma1(1,1,0:nw) &
                              + sigma1(2,2,0:nw) &
                              + sigma1(3,3,0:nw) )/3.0_DP

      allocate( sigma1_atrace_intra(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_intra', &
                                                                      ABS(ierr))

      sigma1_atrace_intra(0:nw) = (   sigma1_intra(1,1,0:nw) &
                                    + sigma1_intra(2,2,0:nw) &
                                    + sigma1_intra(3,3,0:nw) )/3.0_DP

      allocate( sigma1_atrace_degen(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_degen', &
                                                                      ABS(ierr))
      sigma1_atrace_degen(0:nw) = (   sigma1_degen(1,1,0:nw) &
                                    + sigma1_degen(2,2,0:nw) &
                                    + sigma1_degen(3,3,0:nw) )/3.0_DP
                                    
      allocate( sigma1_atrace_inter(0:nw), STAT=ierr )
      if (ierr/=0) CALL errore('kgsigma1','allocating sigma1_atrace_inter', &
                                                                      ABS(ierr))

      sigma1_atrace_inter(0:nw) = (   sigma1_inter(1,1,0:nw) &
                                    + sigma1_inter(2,2,0:nw) &
                                    + sigma1_inter(3,3,0:nw) )/3.0_DP


   end subroutine sigma1_exact_decomp_2gaussian 

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

   subroutine sigma1_exact_decomp_gaussian_DC

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV        ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg              !  pi * (1 / (sg * sqrt(pi) ) 
                                         ! The pi comes form KG formula
                                         ! The 2 in KG goes into the wg 
                                         ! factors
      ! Intra bands contributions
       
      do ix1 = 1, 3
      do ix2 = 1, 3
         maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group               

                  focc = 1.0_DP/(dexp((et(ib1,ik)-e_f)/degauss) + 1.0_DP)
                  dfde =-wk(ik)*focc*( focc - 1.0_DP ) / degauss * 2.0_DP
                  
                  maux(ix2,ix1) = maux(ix2,ix1)                                 &
                                + dfde                                          &
                                  * real( conjg(psi_grad_psi(ix1,ib1,ibb1,ik))  &
                                    *           psi_grad_psi( ix2,ib1,ibb1,ik) )&
                                      * exp(-ee*ee/(sg*sg))                   
                                          
               enddo ! ib1

            enddo ! ik

      enddo ! ix1
      enddo ! ix2

      call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

      sigma1_dc_intra(1:3,1:3) = aux * maux(1:3,1:3) / omega
      sigma1_dc_atrace_intra   = (   sigma1_dc_intra(1,1) &
                                   + sigma1_dc_intra(2,2) &
                                   + sigma1_dc_intra(3,3) )/3.0_DP

      ! Degeneracies contributions

      aux = 2.0_DP * aux                 ! Factor of 2 to sum over 
                                         ! ib1, ib2=ib1+1                                        
       
      do ix1 = 1, 3
      do ix2 = 1, 3
         maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group               

               do ib2 = ib1+1, nbnd
                                    
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if ( abs(ee) > de ) cycle

                  focc = 1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP)
                  dfde =-wk(ik)*focc*( focc - 1.0_DP ) / degauss * 2.0_DP
                  
                  maux(ix2,ix1) = maux(ix2,ix1)                                 &
                                + dfde                                          &
                                  * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))  &
                                    *           psi_grad_psi( ix2,ib2,ibb1,ik) )&
                                      * exp(-ee*ee/(sg*sg))                   
                                          
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

       enddo ! ix1
       enddo ! ix2

       call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
       call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

       sigma1_dc_degen(1:3,1:3) = aux * maux(1:3,1:3) / omega
       sigma1_dc_atrace_degen   = (   sigma1_dc_degen(1,1) &
                                    + sigma1_dc_degen(2,2) &
                                    + sigma1_dc_degen(3,3) )/3.0_DP


      ! Inter bands contributions
       
      do ix1 = 1, 3
      do ix2 = 1, 3
         maux(ix2,ix1) = 0.0_DP

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group               

               do ib2 = ib1+1, nbnd

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if ( abs(ee) <= de ) cycle

                  dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  maux(ix2,ix1) = maux(ix2,ix1)                                 &
                                + dfde                                          &
                                  * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))  &
                                    *           psi_grad_psi( ix2,ib2,ibb1,ik) )&
                                      * exp(-ee*ee/(sg*sg))                   
                                          
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

      enddo ! ix1
      enddo ! ix2

      call mp_sum( maux, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( maux, inter_pool_comm ) ! reduce on k (nks)

      sigma1_dc_inter(1:3,1:3) = aux * maux(1:3,1:3) / omega
      sigma1_dc_atrace_inter   = (   sigma1_dc_inter(1,1) &
                                   + sigma1_dc_inter(2,2) &
                                   + sigma1_dc_inter(3,3) )/3.0_DP

      sigma1_dc(1:3,1:3) =   sigma1_dc_intra(1:3,1:3)  &
                            + sigma1_dc_degen(1:3,1:3) & 
                            + sigma1_dc_inter(1:3,1:3)

      sigma1_dc_atrace   =   sigma1_dc_atrace_intra    &
                            + sigma1_dc_atrace_degen   & 
                            + sigma1_dc_atrace_inter


   end subroutine sigma1_exact_decomp_gaussian_DC 

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


   !===========================================================================
   !                     Average trace of sigma1 = tr(sigma1)/3
   !===========================================================================
   !
   ! Two choices for the sigma1 formula: 
   ! 1) With the 1/w factor (approximated formula)
   ! 2) With the 1/(e_n-e_n') factor (exact formula)
   !
   
   subroutine sigma1_atrace_approx_1lorentzian
      ! Lorentzian delta function
      ! (sa / Pi) / ( (ei - ej - omega)^2 + sa^2 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant

      sa   = 0.5_dp * deltawidth / AUTOEV     ! Lorentzian half-width in Ha


      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      ! Avoid division by zero
      iw   = 0
      do while ( wgrid(iw) < 1.0D-12 )
         iw = iw + 1      
      enddo 
      iaux = iw


      if ( iaux /= 0 ) then
         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
         write(stdout,*) "    Conductivity for zero frequency can not" 
         write(stdout,*) "    be calculated using the KG approximated formula"
         write(stdout,*) "    with one Lorentzian representing the Dirac delta"
         write(stdout,*) "    function." 
         write(stdout,*) "      Calculation will start at", wgrid(iaux)," Ha." 
         !write(stdout,*) "    ================================================"

         if ( dc ) then

            write(stdout,*) ""
            !write(stdout,*) "    ================================================"
            !write(stdout,*) "    WARNING:" 
            write(stdout,*) "    dc is set to TRUE, hence the DC component will be"
            write(stdout,*) "    calculated using the analytical limit for the "
            write(stdout,*) "    approximated formula and two Lorentzians."
            write(stdout,*) "    ================================================"

         else

            write(stdout,*) ""    
            !write(stdout,*) "    ================================================"
            !write(stdout,*) "    WARNING:" 
            write(stdout,*) "    Set dc=.true. to calculate the DC component with"
            write(stdout,*) "    the analytical limit of the approximated formula"
            write(stdout,*) "    with two Lorenziants."
            write(stdout,*) "    ================================================"

         endif

      endif



      do iw = iaux, nw

      aux2 = 0.0_DP

      do ix1 = 1, 3
  
         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1  = ibb1 + nbnds_per_process * my_rank_old &
                           + nbnds_per_group   * my_group

            do ib2 = 1, nbnd

                if ( ib2 == ib1 ) cycle

                ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                eem = ee - wgrid(iw)                       ! in Ha

                aux2 = aux2                                                  &
                        + ( ( wg(ib2,ik) - wg(ib1,ik) )                      &
                             *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )    &
                              *       psi_grad_psi( ix1,ib2,ibb1,ik )  )   ) &
                                       * 1.0_DP / ( eem*eem + sa*sa )
                                                

            enddo ! ib2
            enddo ! ib1

         enddo ! ik

      enddo    ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_atrace(iw) = sa * aux2 / ( 3.0_DP * omega * wgrid(iw) )

      enddo ! iw

   end subroutine sigma1_atrace_approx_1lorentzian

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

   subroutine sigma1_atrace_approx_2lorentzian
      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant

      sa   = 0.5_dp * deltawidth / AUTOEV     ! Lorentzian half-width in Ha

      ! Use ( 1/( (e-w)^2 + sa^2 ) - 1/( (e+w)^2 + sa^2 ) ) / (2 w) =
      ! 2 * e / ( ((e-w)^2 + sa^2)* ((e+w)^2 + sa^2 ) ), for which
      aux  = 2.0_DP * sa

      aux = 2.0_DP * aux                      ! Factor of 2 to sum over
                                              ! ib1, ib2 = ib1+1

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      do iw = 0, nw

      aux2 =  0.0_DP

      do ix1 = 1, 3
  
         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1  = ibb1 + nbnds_per_process * my_rank_old &
                           + nbnds_per_group   * my_group

            do ib2 = ib1 + 1, nbnd

               ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
               eem = ee - wgrid(iw)                       ! in Ha
               eep = ee + wgrid(iw)                       ! in Ha

               aux2 = aux2                                                   &
                        + ( ( wg(ib2,ik) - wg(ib1,ik) )                      &
                             *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )    &
                              *       psi_grad_psi( ix1,ib2,ibb1,ik )  )   ) &
                                       * ee / ( ( eem*eem + sa*sa ) *        &
                                                ( eep*eep + sa*sa ) )

            enddo ! ib2
            enddo ! ib1

         enddo ! ik

      enddo    ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_atrace(iw) = aux * aux2 / ( 3.0_DP * omega )

      enddo ! iw

   end subroutine sigma1_atrace_approx_2lorentzian

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

   subroutine sigma1_atrace_approx_2lorentzian_DC

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      sa   = 0.5_DP * deltawidth / AUTOEV ! Lorentzian half-width in Ha
      aux  = 2.0_DP * sa                  ! Prefactor from lim w->0
      aux  = 2.0_DP * aux                 ! Twice the sum ib1, ib2=ib1+1  
      
      
      aux2 = 0.0_DP

      do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1  = ibb1 + nbnds_per_process * my_rank_old &
                              + nbnds_per_group   * my_group

               do ib2 = ib1 + 1, nbnd

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  aux2 = aux2                                                   &
                                  + ( wg(ib2,ik) - wg(ib1,ik) )                 &
                                    * real(conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                           *     psi_grad_psi(ix1,ib2,ibb1,ik)) &   
                                        * ee / (   ( ee*ee + sa*sa )            &
                                                 * ( ee*ee + sa*sa ) )

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

      enddo ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)
         
      sigma1_dc_atrace = aux * aux2 / ( 3.0_DP * omega )

   end subroutine sigma1_atrace_approx_2lorentzian_DC

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

   subroutine sigma1_atrace_approx_1gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )


      sg   =  deltawidth / AUTOEV        ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg              ! pi / (sg * sqrt(pi) )


      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      ! Avoid division by zero
      iw   = 0
      iaux = 0
      do while ( wgrid(iw) < 1.0D-12 )
         iw = iw + 1
      enddo 
      iaux = iw

      if ( iaux /= 0 ) then
         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
         write(stdout,*) "    Conductivity for zero frequency can not" 
         write(stdout,*) "    be calculated using the KG approximated formula"
         write(stdout,*) "    with one Gaussian representing the Dirac delta"
         write(stdout,*) "    function." 
         write(stdout,*) "      Calculation will start at", wgrid(iaux)," Ha." 
         !write(stdout,*) "    ================================================"

         if ( dc ) then

            write(stdout,*) ""
            !write(stdout,*) "    ================================================"
            !write(stdout,*) "    WARNING:" 
            write(stdout,*) "    dc is set to TRUE, hence the DC component will be"
            write(stdout,*) "    calculated using the analytical limit for the "
            write(stdout,*) "    approximated formula and two Gaussians."
            write(stdout,*) "    ================================================"

         else

            write(stdout,*) ""    
            !write(stdout,*) "    ================================================"
            !write(stdout,*) "    WARNING:" 
            write(stdout,*) "    Set dc=.true. to calculate the DC component with"
            write(stdout,*) "    the analytical limit of the approximated formula"
            write(stdout,*) "    with two Gaussians."
            write(stdout,*) "    ================================================"

         endif

      endif


      do iw = iaux, nw

      aux2 = 0.0_DP
 
      do ix1 = 1, 3

         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1  = ibb1 + nbnds_per_process * my_rank_old &
                           + nbnds_per_group   * my_group

            do ib2 = 1, nbnd

                if ( ib2 == ib1 ) cycle

                ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                eem = ee - wgrid(iw)                       ! in Ha
                eep = ee + wgrid(iw)                       ! in Ha

                aux2 = aux2                                           &
                       +  ( wg(ib2,ik) - wg(ib1,ik) )                 &
                          *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )&
                              *       psi_grad_psi( ix1,ib2,ibb1,ik ))&
                            * exp(-eem*eem/(sg*sg))

             enddo ! ib2
             enddo ! ib1

         enddo ! ik

      enddo ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_atrace(iw) = aux * aux2 / (3.0_DP * omega * wgrid(iw))

      enddo ! iw

   end subroutine sigma1_atrace_approx_1gaussian

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

   subroutine sigma1_atrace_approx_2gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )


      sg   =  deltawidth / AUTOEV        ! Gaussian width in Ha
      !aux  =  0.5_dp * sqrt(pi) / sg     ! pi * 1/2 * 1/ (sg * sqrt(pi) )
                                         ! The 1/2 comes from (s(w)+s(-w))/2
      aux  =  sqrt(pi) / sg              ! Factor of two for the sum
                                         ! ib1, ib2=ib1+1

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      ! Avoid division by zero
      iw   = 0
      iaux = 0
      do while ( wgrid(iw) < 1.0D-12 )
         iw = iw + 1      
      enddo 
      iaux = iw

      if ( iaux /= 0 ) then
         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
	 write(stdout,*) "    Conductivity for zero frequency can not" 
         write(stdout,*) "    be calculated using the KG approximated formula"
         write(stdout,*) "    without taking proper analytical limits."
         write(stdout,*) "    Calculation will start at", wgrid(iaux)," Ha." 
         write(stdout,*) "    ================================================"
      endif

      if ( dc ) then

         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
         write(stdout,*) "    dc is set to TRUE, hence the DC component with"
         write(stdout,*) "    the choosen formula and Dirac delta function"
         write(stdout,*) "    representation will be calculated and reported"
         write(stdout,*) "    in this output." 
         write(stdout,*) "    ================================================"

      else
    
         write(stdout,*) ""
         write(stdout,*) "    ================================================"
         write(stdout,*) "    WARNING:" 
         write(stdout,*) "    Set dc=.true. to calculate the DC component with"
         write(stdout,*) "    the choosen formula and Dirac delta function"
         write(stdout,*) "    representation. " 
         write(stdout,*) "    ================================================"

      endif

      do iw = iaux, nw

      aux2 = 0.0_DP

      do ix1 = 1, 3

         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1  = ibb1 + nbnds_per_process * my_rank_old &
                           + nbnds_per_group   * my_group

            do ib2 = ib1 + 1, nbnd

                ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                eem = ee - wgrid(iw)                       ! in Ha
                eep = ee + wgrid(iw)                       ! in Ha

                aux2 = aux2                                                    &
                       +  ( wg(ib2,ik) - wg(ib1,ik) )                          &
                          *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )         &
                             *       psi_grad_psi( ix1,ib2,ibb1,ik )        )  &
                            * ( exp(-eem*eem/(sg*sg)) - exp(-eep*eep/(sg*sg)) )

             enddo ! ib2
             enddo    ! ib1

         enddo ! ik

      enddo ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_atrace(iw) = aux * aux2 / ( 3.0_DP * omega * wgrid(iw) )

      enddo ! iw

   end subroutine sigma1_atrace_approx_2gaussian

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

   subroutine sigma1_atrace_approx_2gaussian_DC


      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV         ! Gaussian width in Ha
      aux  =  2.0_dp * sqrt(pi) &         ! pi * 1/2 *( 1/ (sg * sqrt(pi) ) ) 
              / (sg*sg*sg)                ! 4 / sg^2
                                          ! The 1/2 comes from (s(w)+s(-w))/2
                                          ! The pi comes form KG formula
                                          ! The 2 in KG goes into the wg 
                                          ! factors                                        
                                          ! The 4/sg^2 comes from w->0 limit
      aux = 2.0_DP * aux                  ! Factor of two to account for the
                                          ! sum ib1,ib2=ib1+1
                                          

         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = ib1 + 1, nbnd

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  aux2 = aux2                                                   &
                              +  ( wg(ib2,ik) - wg(ib1,ik) )                    &
                                * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))    &
                                        * psi_grad_psi(ix1,ib2,ibb1,ik)       ) &
                                          *  ee * exp(-ee*ee/(sg*sg))


               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_dc_atrace = aux * aux2 / ( 3.0_DP * omega )


   end subroutine sigma1_atrace_approx_2gaussian_DC
   
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   subroutine sigma1_atrace_exact_1lorentzian

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant


      sa   = 0.5_dp * deltawidth / AUTOEV  ! Lorentzian half-width in Ha
 
      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgcond:1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      do iw = 0, nw

      aux2 = 0.0_DP

      do ix1 = 1, 3

         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1 = ibb1 + nbnds_per_process * my_rank_old &
                          + nbnds_per_group   * my_group

            do ib2 = 1, nbnd

                if ( sigma1_notintra .and. ib2 == ib1 ) cycle

                ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                eem = ee - wgrid(iw)                       ! in Ha
                eep = ee + wgrid(iw)                       ! in Ha

                if( ib2 == ib1 .or. abs(ee) <= de ) then
                   focc = 1.0_DP/( dexp((et(ib2,ik)-e_f)/degauss ) + 1.0_DP )
                   dfde =-wk(ik) * focc * ( focc - 1.0_DP ) / degauss *2.0_DP
                endif

                if( abs(ee) >  de ) &
                   dfde =( wg(ib2,ik) - wg(ib1,ik) )/ ee


                aux2 = aux2                                                    &
                          + dfde                                               &
                            * conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )         &
                              *       psi_grad_psi( ix1,ib2,ibb1,ik )          &
                                *  1.0_DP/( eem*eem + sa*sa )                 

             enddo ! ib2
             enddo ! ib1

         enddo ! ik

      enddo ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_atrace(iw) = sa * aux2 / ( 3.0_DP * omega )

      enddo ! iw

      sigma1_dc_atrace = sigma1_atrace(0)

   end subroutine sigma1_atrace_exact_1lorentzian

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

   subroutine sigma1_atrace_exact_2lorentzian

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant


      sa   = 0.5_dp * deltawidth / AUTOEV  ! Lorentzian half-width in Ha
      !aux  = 0.5_dp * sa                   ! Prefactor including the 1/2 from
                                           ! ( 1/( (e-w)^2 + sa^2/4 ) 
                                           !   + 1/( (e+w)^2 + sa^2/4 ) )/2
      ! aux = 2 * aux to account for sum over ib1, ib2=ib1+1 => aux = sa

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgcond:2','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      do iw = 0, nw

      aux2 = 0.0_DP

      do ix1 = 1, 3

         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1 = ibb1 + nbnds_per_process * my_rank_old &
                          + nbnds_per_group   * my_group

            do ib2 = ib1, nbnd

                if ( sigma1_notintra .and. ib2 == ib1 ) cycle

                ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                eem = ee - wgrid(iw)                       ! in Ha
                eep = ee + wgrid(iw)                       ! in Ha

                if( ib2 == ib1 .or. abs(ee) <= de ) then
                   focc = 1.0_DP/( dexp((et(ib2,ik)-e_f)/degauss ) + 1.0_DP )
                   dfde =-wk(ik) * focc * ( focc - 1.0_DP ) / degauss *2.0_DP
                endif

                if( abs(ee) > de ) &
                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee


                aux2 = aux2                                                    &
                          + dfde                                               &
                            * conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )         &
                              *       psi_grad_psi( ix1,ib2,ibb1,ik )          &
                                * ( 1.0_DP/( eem*eem + sa*sa )                 &
                                    + 1.0_DP/( eep*eep + sa*sa ) )

             enddo ! ib2
             enddo ! ib1

         enddo ! ik

      enddo ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_atrace(iw) = sa * aux2 / (3.0_DP * omega)

      enddo ! iw

   end subroutine sigma1_atrace_exact_2lorentzian

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

   subroutine sigma1_atrace_exact_lorentzian_DC

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      sa   = 0.5_dp * deltawidth / AUTOEV  ! Lorentzian half-width in Ha

      aux2 = 0.0_DP
      do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       
               do ib2 = 1, nbnd

                  if ( sigma1_notintra .and. ib2 == ib1 ) cycle
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if( abs(ee) <=  de ) then
                     focc =1.0_DP/(dexp((et(ib1,ik)-e_f)/degauss)+1.0_DP)
                     dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP
                  endif

                  if( abs(ee) > de ) &
                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  aux2 = aux2                                                   &
                                 + dfde                                         &
                                   * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                      *          psi_grad_psi(ix1,ib2,ibb1,ik) )&
                                        /( ee*ee + sa*sa )
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

      enddo ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)


      sigma1_dc_atrace = sa * aux2 / ( 3.0_DP * omega )

   end subroutine sigma1_atrace_exact_lorentzian_DC

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

   subroutine sigma1_atrace_exact_1gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )


      sg   =  deltawidth / AUTOEV        ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg              ! pi / (sg * sqrt(pi) ) 

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      do iw = 0, nw

      aux2 = 0.0_DP

      do ix1 = 1, 3

         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1 = ibb1 + nbnds_per_process * my_rank_old &
                          + nbnds_per_group   * my_group

            do ib2 = 1, nbnd

               if ( sigma1_notintra .and. ib2 == ib1 ) cycle

               ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
               eem = ee - wgrid(iw)                       ! in Ha

               if( ib2 == ib1 .or. abs(ee) <= de ) then
                  focc =  1.0_DP/( dexp((et(ib2,ik)-e_f)/degauss ) + 1.0_DP )
                  dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP
               endif

               if( ib1 /= ib2 .and. abs(ee) > de ) &
                  dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

               aux2 = aux2                                                     &
                       +   dfde                                                &
                           *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )        &
                               *       psi_grad_psi( ix1,ib2,ibb1,ik )       ) &
                            *  exp(-eem*eem/(sg*sg)) 

            enddo ! ib2
            enddo ! ib1

         enddo ! ik

      enddo    ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_atrace(iw) = aux * aux2 / (3.0_DP * omega)

      enddo ! iw

   end subroutine sigma1_atrace_exact_1gaussian 

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

   subroutine sigma1_atrace_exact_2gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )


      sg   =  deltawidth / AUTOEV        ! Gaussian width in Ha
      !aux  =  sqrt(pi) / sg              ! pi / (sg * sqrt(pi) ) 
      !aux  =  0.5_dp * sqrt(pi) / sg     ! 1/2 from (s(w)+s(-w))/2 
                                         ! Factor of two to sum over
      aux  = sqrt(pi) / sg               ! ib1, ib2=ib1+1


      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      do iw = 0, nw

      aux2 = 0.0_DP

      do ix1 = 1, 3

         do ik = 1, nks

            do ibb1 = 1, nbnds_local
               ib1 = ibb1 + nbnds_per_process * my_rank_old &
                          + nbnds_per_group   * my_group

            do ib2 = ib1, nbnd

               if ( sigma1_notintra .and. ib2 == ib1 ) cycle

               ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
               eem = ee - wgrid(iw)                       ! in Ha
               eep = ee + wgrid(iw)                       ! in Ha

               if( ib2 == ib1 .or. abs(ee) <= de ) then
                  focc =  1.0_DP/( dexp((et(ib2,ik)-e_f)/degauss ) + 1.0_DP )
                  dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP
               endif


               if( ib1 /= ib2 .and. abs(ee) > de ) &
                  dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

               aux2 = aux2                                                     &
                       +   dfde                                                &
                           *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )        &
                               *       psi_grad_psi( ix1,ib2,ibb1,ik )       ) &
                            * ( exp(-eem*eem/(sg*sg)) + exp(-eep*eep/(sg*sg)) )

            enddo ! ib2
            enddo ! ib1

         enddo ! ik

      enddo    ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_atrace(iw) = aux * aux2 / ( 3.0_DP * omega )

      enddo ! iw

   end subroutine sigma1_atrace_exact_2gaussian 

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

   subroutine sigma1_atrace_exact_gaussian_DC


      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )

      sg   =  deltawidth / AUTOEV        ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg              !  pi * (1 / (sg * sqrt(pi) ) 
                                         ! The pi comes form KG formula
                                         ! The 2 in KG goes into the wg 
                                         ! factors                                        

         aux2 = 0.0_DP
         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group               

               do ib2 = ib1, nbnd

                  if ( sigma1_notintra .and. ib2 == ib1 ) cycle
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if ( ib2 == ib1 .or. abs(ee) <= de ) then
                     focc = 1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP)
                     dfde =-wk(ik)*focc*( focc - 1.0_DP ) / degauss * 2.0_DP
                  endif
                  
                  if( abs(ee) > de ) &
                      dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  ! Factor of two to account for the sum ib1, ib2=ib1+1
                  if ( ib1 /=  ib2 ) dfde = 2.0_DP * dfde


                  aux2 = aux2                                 &
                                + dfde                                          &
                                  * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik))  &
                                    *           psi_grad_psi( ix1,ib2,ibb1,ik) )&
                                      * exp(-ee*ee/(sg*sg))                   
                                          
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

          enddo ! ix2

          call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
          call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_dc_atrace = aux * aux2 / ( 3.0_DP * omega )

   end subroutine sigma1_atrace_exact_gaussian_DC 

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

   subroutine sigma1_atrace_exact_decomp_1lorentzian

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant

      sa   = 0.5_dp * deltawidth / AUTOEV     ! Lorentzian half-width in Ha

      ! Intra bands contributions
      
      allocate( sigma1_atrace_intra(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgcond:3','allocating sigma1_atrace', &
                                                                      ABS(ierr))
      do iw = 0, nw
         eem =   wgrid(iw)                       ! in Ha
         aux2 = 0.0_DP 
 
         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  focc = 1.0_DP / ( dexp((et(ib1,ik)-e_f)/degauss) + 1.0_DP  )
                  dfde = -wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP

                  aux2 = aux2                                                  &
                         + dfde                                                &
                           *  (conjg( psi_grad_psi( ix1,ib1,ibb1,ik ) )        &
                               *       psi_grad_psi( ix1,ib1,ibb1,ik )        ) &
                                 * ( 1.0_DP/( eem*eem + sa*sa ) )

               enddo    ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_atrace_intra(iw) = sa * aux2 / (3.0_DP * omega)

      enddo ! iw

      ! End intra band contributions


      ! Degeneracies contribution
      allocate( sigma1_atrace_degen(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace_degen', &
                                                                      ABS(ierr))

      do iw = 0, nw

         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = 1, nbnd

                  if ( ib2 == ib1 ) cycle

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha

                  if( abs(ee) <=  de ) then
                     focc = 1.0_DP/( dexp( (et(ib2,ik)-e_f)/degauss ) + 1.0_DP )
                     dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP

                     aux2 = aux2                                               &
                            + ( dfde                                           &
                              *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )      &
                               *       psi_grad_psi( ix1,ib2,ibb1,ik )  )     ) &
                                * ( 1.0_DP/( eem*eem + sa*sa )  )               
                  endif

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_atrace_degen(iw) = sa * aux2 / (3.0_DP * omega)

      enddo ! iw
      ! End degeneracies contribution
 

      ! Inter bands contribution
      allocate( sigma1_atrace_inter(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace_inter', &
                                                                      ABS(ierr))

      do iw = 0, nw

         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnd
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = 1, nbnd

                  if ( ib2 == ib1 ) cycle

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  if ( abs(ee) <= de ) cycle

                  eem = ee - wgrid(iw)                       ! in Ha

                  dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  aux2 = aux2                                                  &
                            + ( dfde                                           &
                                * (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )    &
                                   *    psi_grad_psi( ix1,ib2,ibb1,ik )  )   ) &
                                     * 1.0_DP/( eem*eem + sa*sa )            

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

        enddo ! ix1

        call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
        call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

        sigma1_atrace_inter(iw) = sa * aux2 / ( 3.0_DP * omega )

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      sigma1_atrace = sigma1_atrace_intra + sigma1_atrace_degen &
                                                         + sigma1_atrace_inter

      sigma1_dc_atrace       = sigma1_atrace(0)
      sigma1_dc_atrace_intra = sigma1_atrace_intra(0)
      sigma1_dc_atrace_degen = sigma1_atrace_degen(0)
      sigma1_dc_atrace_inter = sigma1_atrace_inter(0)

   end subroutine sigma1_atrace_exact_decomp_1lorentzian

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

   subroutine sigma1_atrace_exact_decomp_2lorentzian

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant

      sa   = 0.5_dp * deltawidth / AUTOEV     ! Lorentzian half-width in Ha
      aux  = 0.5_dp * sa                      ! Prefactor including the 1/2 from
                                              ! ( 1/( (e-w)^2 + sa^2/4 ) 
                                              !   + 1/( (e+w)^2 + sa^2/4 ) )/2

      ! Intra bands contribution
      allocate( sigma1_atrace_intra(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgcond:4','allocating sigma1_atrace', &
                                                                      ABS(ierr))
      do iw = 0, nw
         eem =   wgrid(iw)                       ! in Ha
         aux2 = 0.0_DP 
 
         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  focc = 1.0_DP / ( dexp((et(ib1,ik)-e_f)/degauss) + 1.0_DP  )
                  dfde = -wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP

                  aux2 = aux2                                                  &
                         + dfde                                                &
                           *  (conjg( psi_grad_psi( ix1,ib1,ibb1,ik ) )        &
                               *       psi_grad_psi( ix1,ib1,ibb1,ik )        ) &
                                 * ( 1.0_DP/( eem*eem + sa*sa ) )

               enddo    ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_atrace_intra(iw) = sa * aux2 / (3.0_DP * omega)

      enddo ! iw
      ! End intra band contributions


      ! Degeneracies contribution
      allocate( sigma1_atrace_degen(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace_degen', &
                                                                      ABS(ierr))
      aux = 2.0_DP * aux ! Factor of 2 to sum over ib1, ib2=ib1+1

      do iw = 0, nw

         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = ib1+1, nbnd

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  if( abs(ee) <=  de ) then
                     focc = 1.0_DP/( dexp( (et(ib2,ik)-e_f)/degauss ) + 1.0_DP )
                     dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP

                     aux2 = aux2                                                &
                            + ( dfde                                            &
                              *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )      &
                               *       psi_grad_psi( ix1,ib2,ibb1,ik )  )     ) &
                                * (   1.0_DP/( eem*eem + sa*sa )                &               
                                    + 1.0_DP/( eep*eep + sa*sa )  )               
                  endif

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_atrace_degen(iw) = aux * aux2 / (3.0_DP * omega)

      enddo ! iw
      ! End degeneracies contribution

      ! Inter bands contribution
      allocate( sigma1_atrace_inter(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace_inter', &
                                                                      ABS(ierr))

      do iw = 0, nw

         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnd
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

               do ib2 = ib1+1, nbnd

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                  if ( abs(ee) <= de ) cycle

                  eem = ee - wgrid(iw)                       ! in Ha
                  eep = ee + wgrid(iw)                       ! in Ha

                  dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                  aux2 = aux2                                                  &
                            + ( dfde                                           &
                                * (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )    &
                                   *    psi_grad_psi( ix1,ib2,ibb1,ik )  )   ) &
                                     * ( 1.0_DP/( eem*eem + sa*sa )            &
                                          + 1.0_DP/( eep*eep + sa*sa ) )

               enddo ! ib2
               enddo ! ib1

            enddo ! ik

        enddo ! ix1

        call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
        call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

        sigma1_atrace_inter(iw) = aux * aux2 / ( 3.0_DP * omega )

      enddo ! iw

      allocate( sigma1_atrace(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

      sigma1_atrace = sigma1_atrace_intra + sigma1_atrace_degen &
                                                         + sigma1_atrace_inter

      sigma1_dc_atrace       = sigma1_atrace(0)
      sigma1_dc_atrace_intra = sigma1_atrace_intra(0)
      sigma1_dc_atrace_degen = sigma1_atrace_degen(0)
      sigma1_dc_atrace_inter = sigma1_atrace_inter(0)

   end subroutine sigma1_atrace_exact_decomp_2lorentzian

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

   subroutine sigma1_atrace_exact_decomp_lorentzian_DC

      ! Lorentzian delta function
      ! (sa / 2 Pi) / ( (ei - ej - omega)^2 + sa^2/4 ), 
      ! defined between -infinity and infinity
      ! The Pi cancels out with the 2 Pi / etc. constant in KG formula
      ! The factor of 2 in KG goes into the wg factors

      sa   = 0.5_dp * deltawidth / AUTOEV  ! Lorentzian half-width in Ha

      ! Intra bands contributions

      aux2 = 0.0_DP
      do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       
                  focc =1.0_DP/(dexp((et(ib1,ik)-e_f)/degauss)+1.0_DP)
                  dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP

                  aux2 = aux2                                                   &
                                 + dfde                                         &
                                   * real( conjg(psi_grad_psi(ix1,ib1,ibb1,ik)) &
                                      *          psi_grad_psi(ix1,ib1,ibb1,ik) )
                                        
               enddo ! ib1

            enddo ! ik

      enddo ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_dc_atrace_intra = aux2 / ( 3.0_DP * omega * sa)

      ! Degeneracies contributions
       
      aux = 2.0_DP * sa ! Factor of 2 to sum over ib1, ib2=ib1+1

      aux2 = 0.0_DP
      do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       
               do ib2 = ib1+1, nbnd

                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if( abs(ee) >  de ) cycle

                  focc =1.0_DP/(dexp((et(ib2,ik)-e_f)/degauss)+1.0_DP)
                  dfde =-wk(ik)*focc*( focc-1.0_DP )/degauss*2.0_DP
 
                  aux2 = aux2                                                   &
                                 + dfde                                         &
                                   * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                      *          psi_grad_psi(ix1,ib2,ibb1,ik) )&
                                        /( ee*ee + sa*sa )
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

      enddo ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

      sigma1_dc_atrace_degen = aux * aux2 / ( 3.0_DP * omega )

      ! Inter band contributions

      aux2 = 0.0_DP
      do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group
       
               do ib2 = ib1+1, nbnd
                  
                  ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                  if ( abs(ee) <= de ) cycle

                  dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee    

                  aux2 = aux2                                                   &
                                 + dfde                                         &
                                   * real( conjg(psi_grad_psi(ix1,ib2,ibb1,ik)) &
                                      *          psi_grad_psi(ix1,ib2,ibb1,ik) )&
                                        /( ee*ee + sa*sa )
               enddo ! ib2
               enddo ! ib1

            enddo ! ik

      enddo ! ix1

      call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
      call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)


      sigma1_dc_atrace_inter = aux * aux2 / ( 3.0_DP * omega )

      sigma1_dc_atrace   =   sigma1_dc_atrace_intra   &
                           + sigma1_dc_atrace_degen   & 
                           + sigma1_dc_atrace_inter

   end subroutine sigma1_atrace_exact_decomp_lorentzian_DC

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

   subroutine sigma1_atrace_exact_decomp_1gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )
          
      sg   =  deltawidth / AUTOEV       ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg             ! pi * 1/ (sg * sqrt(pi) )

      ! Intra bands contribution
      allocate( sigma1_atrace_intra(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgcond:5','allocating sigma1_atrace_intra', &
                                                                      ABS(ierr))

      do iw = 0, nw

         eem =  wgrid(iw)                       ! in Ha
         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  focc =  1.0_DP / ( dexp((et(ib1,ik)-e_f)/degauss) + 1.0_DP  )
                  dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP

                  aux2 = aux2                                                  &
                         +  dfde                                               &
                                *  (conjg( psi_grad_psi( ix1,ib1,ibb1,ik ) )   &
                                    *       psi_grad_psi( ix1,ib1,ibb1,ik )  ) &
                                            * ( exp(-eem*eem/(sg*sg)) )

               enddo    ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_atrace_intra(iw) = aux * aux2 / (3.0_DP * omega)

      enddo ! iw
      ! End intra bands contribution

      ! Degeneracies contribution
      allocate( sigma1_atrace_degen(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace_degen', &
                                                                      ABS(ierr))

      do iw = 0, nw

         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                do ib2 = 1, nbnd

                  if ( ib2 == ib1 ) cycle

                   ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                   eem = ee - wgrid(iw)                       ! in Ha

                   if( abs(ee) <= de ) then
                      focc = 1.0_DP /( dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP )
                      dfde =  -wk(ik) *focc *( focc - 1.0_DP ) / degauss *2.0_DP

                      aux2 = aux2                                             &
                             +   dfde                                         &
                                 * conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )    &
                                   *      psi_grad_psi( ix1,ib2,ibb1,ik )      &
                                     * ( exp(-eem*eem/(sg*sg)) )

                   endif

                enddo ! ib2
                enddo ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_atrace_degen(iw) = aux * aux2 / (3.0_DP * omega)

         enddo ! iw
         ! End degeneracies contribution

         ! Inter band contributions
         allocate( sigma1_atrace_inter(0:nw), STAT=ierr )
         if (ierr/=0) call errore('kgcond:6','allocating sigma1_atrace_inter',&
                                                                      ABS(ierr))

         do iw = 0, nw

            aux2 = 0.0_DP

            do ix1 = 1, 3

               do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  do ib2 = 1, nbnd

                     if ( ib2 == ib1 ) cycle

                     ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                     if ( abs(ee) <= de ) cycle

                     eem = ee - wgrid(iw)                       ! in Ha
                     eep = ee + wgrid(iw)                       ! in Ha

                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                     aux2 = aux2                                               &
                            +   dfde                                           &
                                *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )    &
                                     *      psi_grad_psi( ix1,ib2,ibb1,ik )   ) &
                            * ( exp(-eem*eem/(sg*sg)) )

                  enddo ! ib2
                  enddo ! ib1

               enddo ! ik

            enddo ! ix1

            call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
            call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

            sigma1_atrace_inter(iw) = aux * aux2 / (3.0_DP * omega)

         enddo ! iw
         ! End inter band contributions

         allocate( sigma1_atrace(0:nw), STAT=ierr )
         if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

         sigma1_atrace = sigma1_atrace_intra + sigma1_atrace_degen &
                                                         + sigma1_atrace_inter

         sigma1_dc_atrace       = sigma1_atrace(0)
         sigma1_dc_atrace_intra = sigma1_atrace_intra(0)
         sigma1_dc_atrace_degen = sigma1_atrace_degen(0)
         sigma1_dc_atrace_inter = sigma1_atrace_inter(0)


   end subroutine sigma1_atrace_exact_decomp_1gaussian 

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

   subroutine sigma1_atrace_exact_decomp_2gaussian

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )
     
      sg   =  deltawidth / AUTOEV       ! Gaussian width in Ha
      !aux  =  sqrt(pi) / sg              ! pi / (sg * sqrt(pi) ) 
      !aux  =  0.5_dp * sqrt(pi) / sg     ! 1/2 from (s(w)+s(-w))/2 
                                         ! Factor of two to sum over
      aux  = sqrt(pi) / sg               ! ib1, ib2=ib1+1


      ! Intra bands contribution
      allocate( sigma1_atrace_intra(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgcond:7','allocating sigma1_atrace_intra', &
                                                                      ABS(ierr))

      do iw = 0, nw

         eem =  wgrid(iw)                       ! in Ha
         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  focc =  1.0_DP / ( dexp((et(ib1,ik)-e_f)/degauss) + 1.0_DP  )
                  dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP

                  aux2 = aux2                                                  &
                         +  dfde                                               &
                                *  (conjg( psi_grad_psi( ix1,ib1,ibb1,ik ) )   &
                                    *       psi_grad_psi( ix1,ib1,ibb1,ik )  ) &
                                            * ( exp(-eem*eem/(sg*sg)) )

               enddo    ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_atrace_intra(iw) = aux * aux2 / ( 3.0_DP * omega )

      enddo ! iw
      ! End intra bands contribution

      ! Degeneracies contribution
      allocate( sigma1_atrace_degen(0:nw), STAT=ierr )
      if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace_degen', &
                                                                      ABS(ierr))

      do iw = 0, nw

         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                do ib2 = ib1+1, nbnd

                   ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                   eem = ee - wgrid(iw)                       ! in Ha
                   eep = ee + wgrid(iw)                       ! in Ha

                   if( abs(ee) <= de ) then
                      focc = 1.0_DP /( dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP )
                      dfde =  -wk(ik) *focc *( focc - 1.0_DP ) / degauss *2.0_DP

                      aux2 = aux2                                             &
                             +   dfde                                         &
                                 * conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )   &
                                   *      psi_grad_psi( ix1,ib2,ibb1,ik )     &
                                     * (   exp(-eem*eem/(sg*sg))              &
                                         + exp(-eep*eep/(sg*sg)) )

                   endif

                enddo ! ib2
                enddo ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_atrace_degen(iw) = aux * aux2 / ( 3.0_DP * omega )

         enddo ! iw
         ! End degeneracies contribution

         ! Inter band contributions
         allocate( sigma1_atrace_inter(0:nw), STAT=ierr )
         if (ierr/=0) call errore('kgcond:8','allocating sigma1_atrace_inter',&
                                                                      ABS(ierr))

         do iw = 0, nw

            aux2 = 0.0_DP

            do ix1 = 1, 3

               do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  do ib2 = ib1+1, nbnd

                     ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                     if ( abs(ee) <= de ) cycle

                     eem = ee - wgrid(iw)                       ! in Ha
                     eep = ee + wgrid(iw)                       ! in Ha

                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                     aux2 = aux2                                                &
                            +   dfde                                            &
                                *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )    &
                                     *      psi_grad_psi( ix1,ib2,ibb1,ik )   ) &
                            * ( exp(-eem*eem/(sg*sg)) + exp(-eep*eep/(sg*sg)) )

                  enddo ! ib2
                  enddo ! ib1

               enddo ! ik

            enddo ! ix1

            call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
            call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

            sigma1_atrace_inter(iw) = aux * aux2 / ( 3.0_DP * omega )

         enddo ! iw
         ! End inter band contributions

         allocate( sigma1_atrace(0:nw), STAT=ierr )
         if (ierr/=0) call errore('kgsigma1','allocating sigma1_atrace', &
                                                                      ABS(ierr))

         sigma1_atrace = sigma1_atrace_intra + sigma1_atrace_degen &
                                                         + sigma1_atrace_inter

         sigma1_dc_atrace       = sigma1_atrace(0)
         sigma1_dc_atrace_intra = sigma1_atrace_intra(0)
         sigma1_dc_atrace_degen = sigma1_atrace_degen(0)
         sigma1_dc_atrace_inter = sigma1_atrace_inter(0)


   end subroutine sigma1_atrace_exact_decomp_2gaussian 

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

   subroutine sigma1_atrace_exact_decomp_gaussian_DC

      ! Gaussian delta function: exp(-x*x/sg*sg ) / ( sg * sqrt(pi) )
     
      sg   =  deltawidth / AUTOEV       ! Gaussian width in Ha
      aux  =  sqrt(pi) / sg             ! pi * 1/2 * 1/ (sg * sqrt(pi) )


      ! Intra bands contribution

         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  focc =  1.0_DP / ( dexp((et(ib1,ik)-e_f)/degauss) + 1.0_DP  )
                  dfde =  -wk(ik) * focc * ( focc - 1.0_DP ) / degauss * 2.0_DP

                  aux2 = aux2                                                  &
                         +  dfde                                               &
                                *  (conjg( psi_grad_psi( ix1,ib1,ibb1,ik ) )   &
                                    *       psi_grad_psi( ix1,ib1,ibb1,ik )  )

               enddo    ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_dc_atrace_intra = aux * aux2 / ( 3.0_DP * omega )

      ! End intra bands contribution

      ! Degeneracies contribution

         aux = 2.0_DP * aux ! Factor of 2 to sum over ib1, ib2=ib1+1

         aux2 = 0.0_DP

         do ix1 = 1, 3

            do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                do ib2 = ib1+1, nbnd

                   ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha

                   if( abs(ee) <= de ) then
                      focc = 1.0_DP /( dexp((et(ib2,ik)-e_f)/degauss) + 1.0_DP )
                      dfde =  -wk(ik) *focc *( focc - 1.0_DP ) / degauss *2.0_DP

                      aux2 = aux2                                             &
                             +   dfde                                         &
                                 * conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )   &
                                   *      psi_grad_psi( ix1,ib2,ibb1,ik )     &
                                     *    exp(-ee*ee/(sg*sg))              

                   endif

                enddo ! ib2
                enddo ! ib1

            enddo ! ik

         enddo    ! ix1

         call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
         call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

         sigma1_dc_atrace_degen = aux * aux2 / ( 3.0_DP * omega )

         ! End degeneracies contribution

         ! Inter band contributions

            aux2 = 0.0_DP

            do ix1 = 1, 3

               do ik = 1, nks

               do ibb1 = 1, nbnds_local
                  ib1 = ibb1 + nbnds_per_process * my_rank_old &
                             + nbnds_per_group   * my_group

                  do ib2 = ib1+1, nbnd

                     ee  = ( et(ib1,ik) - et(ib2,ik) ) * 0.5_DP ! in Ha
                     if ( abs(ee) <= de ) cycle

                     dfde =  ( wg(ib2,ik) - wg(ib1,ik) )/ ee

                     aux2 = aux2                                                &
                            +   dfde                                            &
                                *  (conjg( psi_grad_psi( ix1,ib2,ibb1,ik ) )    &
                                     *      psi_grad_psi( ix1,ib2,ibb1,ik )   ) &
                            *  exp(-ee*ee/(sg*sg)) 

                  enddo ! ib2
                  enddo ! ib1

               enddo ! ik

            enddo ! ix1

            call mp_sum( aux2, inter_bgrp_comm ) ! reduce on bands (nbnd)
            call mp_sum( aux2, inter_pool_comm ) ! reduce on k (nks)

            sigma1_dc_atrace_inter = aux * aux2 / ( 3.0_DP * omega )

         ! End inter band contributions

         sigma1_dc_atrace =    sigma1_dc_atrace_intra &
                             + sigma1_dc_atrace_degen &
                             + sigma1_dc_atrace_inter   

   end subroutine sigma1_atrace_exact_decomp_gaussian_DC 


!   subroutine tensor_trace(tensor, trace)
!   dou
!   end subroutine tensor_trace

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



end module kgsigma1
