LCOV - code coverage report
Current view: top level - xc-pot - libxc_postprocess_gga.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 33 35 94.3 %
Date: 2019-09-08 04:53:50 Functions: 3 3 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : MODULE m_libxc_postprocess_gga
       7             : CONTAINS
       8             : 
       9          40 :    SUBROUTINE libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad, atom_num)
      10             :       USE m_mt_tofrom_grid
      11             :       USE m_types
      12             :       use m_judft_string
      13             : 
      14             :       IMPLICIT NONE
      15             :       CLASS(t_xcpot),INTENT(IN)   :: xcpot
      16             :       TYPE(t_atoms),INTENT(IN)    :: atoms
      17             :       TYPE(t_sphhar),INTENT(IN)   :: sphhar
      18             :       INTEGER,INTENT(IN)          :: n
      19             :       REAL,INTENT(INOUT)          :: v_xc(:,:)
      20             :       TYPE(t_gradients),INTENT(IN):: grad
      21             :       INTEGER, OPTIONAL           :: atom_num
      22             : 
      23             :       INTEGER :: nsp,n_sigma,i
      24          40 :       REAL,ALLOCATABLE:: vsigma(:,:),vsigma_mt(:,:,:)
      25          40 :       TYPE(t_gradients)::grad_vsigma
      26             :       character(len=:), allocatable :: fname
      27             : 
      28          40 :       n_sigma=MERGE(1,3,SIZE(v_xc,2)==1) !Number of contracted gradients in libxc 1 for non-spin-polarized, 3 otherwise
      29          40 :       nsp=SIZE(v_xc,1) !no of points
      30          40 :       ALLOCATE(vsigma(nsp,n_sigma),vsigma_mt(atoms%jri(n),0:sphhar%nlhd,n_sigma))
      31         160 :       vsigma_mt=0.0
      32          40 :       vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
      33          40 :       CALL mt_from_grid(atoms,sphhar,n,n_sigma,vsigma,vsigma_mt)
      34       22640 :       DO i=1,atoms%jri(n)
      35       22640 :          vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2
      36             :       ENDDO
      37          40 :       ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
      38          40 :       CALL mt_to_grid(xcpot,n_sigma,atoms,sphhar,vsigma_mt,n,grad=grad_vsigma)
      39             : 
      40          40 :       CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
      41          40 :    END SUBROUTINE libxc_postprocess_gga_mt
      42             : 
      43          20 :    SUBROUTINE libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
      44             :       USE m_pw_tofrom_grid
      45             :       USE m_types
      46             : 
      47             :       IMPLICIT NONE
      48             :       CLASS(t_xcpot),INTENT(IN)   :: xcpot
      49             :       TYPE(t_stars),INTENT(IN)    :: stars
      50             :       TYPE(t_cell),INTENT(IN)     :: cell
      51             :       REAL,INTENT(INOUT)          :: v_xc(:,:)
      52             :       TYPE(t_gradients),INTENT(IN):: grad
      53             : 
      54             :       COMPLEX,ALLOCATABLE:: vsigma_g(:,:)
      55          20 :       REAL,ALLOCATABLE:: vsigma(:,:)
      56          20 :       TYPE(t_gradients)::grad_vsigma
      57             :       INTEGER :: nsp,n_sigma
      58             : 
      59          20 :       nsp=SIZE(v_xc,1) !no of points
      60          20 :       n_sigma=MERGE(1,3,SIZE(v_xc,2)==1) !See in _mt routine
      61          20 :       ALLOCATE(vsigma_g(stars%ng3,n_sigma),vsigma(nsp,n_sigma)); vsigma_g=0.0
      62          20 :       vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
      63          20 :       CALL pw_from_grid(xcpot,stars,.FALSE.,vsigma,vsigma_g)
      64             :       !vsigma_g(:,1)=vsigma_g(:,1)*stars%nstr(:)
      65          20 :       ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
      66          20 :       CALL pw_to_grid(xcpot,n_sigma,.false.,stars,cell,vsigma_g,grad_vsigma)
      67             : 
      68          20 :       CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
      69          20 :    END SUBROUTINE libxc_postprocess_gga_pw
      70             : 
      71          60 :    SUBROUTINE libxc_postprocess_gga(vsigma,grad,grad_vsigma,v_xc)
      72             :       USE m_types
      73             :       IMPLICIT NONE
      74             :       REAL,INTENT(IN)             :: vsigma(:,:)
      75             :       TYPE(t_gradients),INTENT(IN):: grad,grad_vsigma
      76             :       REAL,INTENT(INOUT)          :: v_xc(:,:)
      77             :       INTEGER:: i
      78          60 :       IF (SIZE(v_xc,2)==1) THEN !Single spin
      79           0 :          DO i=1,SIZE(v_xc,1) !loop over points
      80           0 :             v_xc(i,1)=v_xc(i,1)-2*dot_PRODUCT(grad_vsigma%gr(:,i,1),grad%gr(:,i,1))-2*vsigma(i,1)*grad%laplace(i,1)
      81             :          ENDDO
      82             :       ELSE  !two spins
      83     3944460 :          DO i=1,SIZE(v_xc,1) !loop over points
      84             :             v_xc(i,1)=v_xc(i,1)-2*dot_PRODUCT(grad_vsigma%gr(:,i,1),grad%gr(:,i,1))-2*vsigma(i,1)*grad%laplace(i,1)-&
      85     3944400 :                        dot_PRODUCT(grad_vsigma%gr(:,i,2),grad%gr(:,i,2))-vsigma(i,2)*grad%laplace(i,2)
      86             :             v_xc(i,2)=v_xc(i,2)-2*dot_PRODUCT(grad_vsigma%gr(:,i,3),grad%gr(:,i,2))-2*vsigma(i,3)*grad%laplace(i,2)-&
      87     3944460 :                        dot_PRODUCT(grad_vsigma%gr(:,i,2),grad%gr(:,i,1))-vsigma(i,2)*grad%laplace(i,1)
      88             :          ENDDO
      89             :       END IF
      90             : 
      91          60 :    END SUBROUTINE libxc_postprocess_gga
      92             : 
      93             : END MODULE m_libxc_postprocess_gga

Generated by: LCOV version 1.13