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          14 :    SUBROUTINE libxc_postprocess_gga_mt(xcpot,atoms,sym,sphhar,noco,n,v_xc,grad, atom_num)
      10             :       USE m_mt_tofrom_grid
      11             :       USE m_types
      12             : 
      13             :       IMPLICIT NONE
      14             :       CLASS(t_xcpot),INTENT(IN)   :: xcpot
      15             :       TYPE(t_atoms),INTENT(IN)    :: atoms
      16             :       TYPE(t_sym),INTENT(IN)      :: sym
      17             :       TYPE(t_sphhar),INTENT(IN)   :: sphhar
      18             :       TYPE(t_noco),INTENT(IN)     :: noco
      19             :       INTEGER,INTENT(IN)          :: n
      20             :       REAL,INTENT(INOUT)          :: v_xc(:,:)
      21             :       TYPE(t_gradients),INTENT(IN):: grad
      22             :       INTEGER, OPTIONAL           :: atom_num
      23             : 
      24             :       INTEGER :: nsp,n_sigma,i
      25             :       REAL,ALLOCATABLE:: vsigma(:,:),vsigma_mt(:,:,:)
      26          14 :       TYPE(t_gradients)::grad_vsigma
      27             :       character(len=:), allocatable :: fname
      28             : 
      29          14 :       n_sigma=MERGE(1,3,SIZE(v_xc,2)==1) !Number of contracted gradients in libxc 1 for non-spin-polarized, 3 otherwise
      30          14 :       nsp=SIZE(v_xc,1) !no of points
      31         112 :       ALLOCATE(vsigma(nsp,n_sigma),vsigma_mt(atoms%jri(n),0:sphhar%nlhd,n_sigma))
      32      195028 :       vsigma_mt=0.0
      33     4036766 :       vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
      34          14 :       CALL mt_from_grid(atoms,sym,sphhar,n,n_sigma,vsigma,vsigma_mt)
      35        8448 :       DO i=1,atoms%jri(n)
      36      225080 :          vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2
      37             :       ENDDO
      38          56 :       ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
      39    16146852 :       grad_vsigma%gr=0.0
      40          14 :       CALL mt_to_grid(xcpot%needs_grad(),n_sigma,atoms,sym,sphhar,.TRUE.,vsigma_mt,n,noco,grad=grad_vsigma)
      41             : 
      42          14 :       CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
      43          14 :    END SUBROUTINE libxc_postprocess_gga_mt
      44             : 
      45           8 :    SUBROUTINE libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
      46             :       USE m_pw_tofrom_grid
      47             :       USE m_types
      48             : 
      49             :       IMPLICIT NONE
      50             :       CLASS(t_xcpot),INTENT(IN)   :: xcpot
      51             :       TYPE(t_stars),INTENT(IN)    :: stars
      52             :       TYPE(t_cell),INTENT(IN)     :: cell
      53             :       REAL,INTENT(INOUT)          :: v_xc(:,:)
      54             :       TYPE(t_gradients),INTENT(IN):: grad
      55             : 
      56             :       COMPLEX,ALLOCATABLE:: vsigma_g(:,:)
      57             :       REAL,ALLOCATABLE:: vsigma(:,:)
      58           8 :       TYPE(t_gradients)::grad_vsigma
      59             :       INTEGER :: nsp,n_sigma
      60             : 
      61           8 :       nsp=SIZE(v_xc,1) !no of points
      62           8 :       n_sigma=MERGE(1,3,SIZE(v_xc,2)==1) !See in _mt routine
      63        4978 :       ALLOCATE(vsigma_g(stars%ng3,n_sigma),vsigma(nsp,n_sigma)); vsigma_g=0.0
      64       98244 :       vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
      65           8 :       CALL pw_from_grid(stars,vsigma,vsigma_g)
      66             :       !vsigma_g(:,1)=vsigma_g(:,1)*stars%nstr(:)
      67          32 :       ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
      68           8 :       CALL pw_to_grid(xcpot%needs_grad(),n_sigma,.false.,stars,cell,vsigma_g,grad_vsigma,xcpot)
      69             : 
      70           8 :       CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
      71           8 :    END SUBROUTINE libxc_postprocess_gga_pw
      72             : 
      73           0 :    SUBROUTINE libxc_postprocess_gga_vac(xcpot,input,cell,stars,vacuum ,v_xc,grad)
      74             :       USE m_vac_tofrom_grid
      75             :       USE m_types
      76             : 
      77             :       IMPLICIT NONE
      78             :       CLASS(t_xcpot),INTENT(IN)   :: xcpot
      79             :       TYPE(t_input),INTENT(IN)   :: input
      80             :       TYPE(t_cell),INTENT(IN)   :: cell
      81             :       TYPE(t_stars),INTENT(IN)   :: stars
      82             :       TYPE(t_vacuum),INTENT(IN)   :: vacuum
      83             :        
      84             :       REAL,INTENT(INOUT)          :: v_xc(:,:)
      85             :       TYPE(t_gradients),INTENT(IN):: grad
      86             : 
      87             :       COMPLEX,ALLOCATABLE:: vsigma_new(:,:,:,:)
      88           0 :       REAL,ALLOCATABLE:: vsigma(:,:), rho_dummy(:,:),v_xc2(:,:)
      89           0 :       TYPE(t_gradients)::grad_vsigma
      90             :       INTEGER :: nsp,n_sigma,ifftd2
      91             : 
      92           0 :       ifftd2 = 9*stars%mx1*stars%mx2
      93             :     
      94           0 :       nsp=SIZE(v_xc,1) !no of points
      95           0 :       n_sigma=MERGE(1,3,SIZE(v_xc,2)==1) !See in _mt routine
      96           0 :       ALLOCATE(rho_dummy(size(v_xc,1),n_sigma))
      97           0 :       ALLOCATE(v_xc2,mold=v_xc)
      98           0 :       ALLOCATE(vsigma_new(vacuum%nmz,stars%ng2,vacuum%nvac,n_sigma))
      99           0 :       v_xc2=v_xc
     100           0 :       vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
     101           0 :       CALL vac_from_grid(stars,vacuum,v_xc2,ifftd2,vsigma_new)
     102           0 :       ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma),grad_vsigma%sigma(n_sigma,nsp))
     103           0 :       CALL vac_to_grid(xcpot%needs_grad(),ifftd2,n_sigma,vacuum,.FALSE.,cell,vsigma_new,stars,rho_dummy,grad_vsigma)
     104             : 
     105           0 :       CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
     106           0 :    END SUBROUTINE libxc_postprocess_gga_vac
     107             : 
     108          22 :    SUBROUTINE libxc_postprocess_gga(vsigma,grad,grad_vsigma,v_xc)
     109             :       USE m_types
     110             :       IMPLICIT NONE
     111             :       REAL,INTENT(IN)             :: vsigma(:,:)
     112             :       TYPE(t_gradients),INTENT(IN):: grad,grad_vsigma
     113             :       REAL,INTENT(INOUT)          :: v_xc(:,:)
     114             :       INTEGER:: i
     115          22 :       IF (SIZE(v_xc,2)==1) THEN !Single spin
     116      606552 :          DO i=1,SIZE(v_xc,1) !loop over points
     117     2426196 :             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)
     118             :          ENDDO
     119             :       ELSE  !two spins
     120     1176138 :          DO i=1,SIZE(v_xc,1) !loop over points
     121             :             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)-&
     122     8232840 :                        dot_PRODUCT(grad_vsigma%gr(:,i,2),grad%gr(:,i,2))-vsigma(i,2)*grad%laplace(i,2)
     123             :             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)-&
     124     9408978 :                        dot_PRODUCT(grad_vsigma%gr(:,i,2),grad%gr(:,i,1))-vsigma(i,2)*grad%laplace(i,1)
     125             :          ENDDO
     126             :       END IF
     127             : 
     128          22 :    END SUBROUTINE libxc_postprocess_gga
     129             : 
     130             : END MODULE m_libxc_postprocess_gga