Line data    Source code

       1             : MODULE m_dfpt_vvac_xc
       2             :     use m_juDFT
       3             :     private
       4             :     !These used to be inputs for testing...
       5             :     INTEGER,PARAMETER:: fixed_ndvgrd=6
       6             :     REAL,PARAMETER   :: fixed_chng=-0.1e-11
       7             :   
       8             :     public dfpt_vvac_xc
       9             :     !-----------------------------------------------------------------------
      10             :     !     calculates 2-d star function coefficients of exchange-correlation*
      11             :     !     potential in the vacuum regions and adds them to the corresponding
      12             :     !     coeffs of the coulomb potential            c.l.fu, r.podloucky   *
      13             :     !     for the gradient contribution.   t.a. 1996
      14             :     !-----------------------------------------------------------------------
      15             :   CONTAINS
      16           0 :     SUBROUTINE dfpt_vvac_xc(ifftd2,stars,starsq, vacuum, noco,cell,den,den1,xcpot,input,vxc)
      17             :   
      18             :       !-----------------------------------------------------------------------
      19             :       !     instead of vvacxcor.f: the different exchange-correlation
      20             :       !     potentials defined through the key icorr are called through
      21             :       !     the driver subroutine vxcallg.f, subroutines vectorized
      22             :       !     in case of total = .true. calculates the ex-corr. energy
      23             :       !     density through the driver subroutine excallg.f
      24             :       !     ** r.pentcheva 08.05.96
      25             :       !-----------------------------------------------------------------------
      26             :   
      27             :       USE m_types
      28             :       USE m_types_xcpot_libxc
      29             :       use m_constants
      30             :       USE m_grdrsvac
      31             :       USE m_grdchlh
      32             :       USE m_mkgz
      33             :       USE m_mkgxyz3
      34             :       ! 
      35             :       ! 
      36             :       USE m_fft2d
      37             :       use m_vac_tofrom_grid
      38             :       USE m_libxc_postprocess_gga
      39             :       IMPLICIT NONE
      40             :       CLASS(t_xcpot),INTENT(IN)    :: xcpot
      41             :       TYPE(t_vacuum),INTENT(IN)    :: vacuum
      42             :       TYPE(t_input),INTENT(IN)     :: input
      43             :       TYPE(t_noco),INTENT(IN)      :: noco
      44             :       TYPE(t_stars),INTENT(IN)     :: stars,starsq
      45             :       TYPE(t_cell),INTENT(IN)      :: cell
      46             :       TYPE(t_potden),INTENT(IN)    :: den,den1
      47             :       TYPE(t_potden),INTENT(INOUT) :: vxc
      48             : 
      49             :       !     ..
      50             :       !     .. Scalar Arguments ..
      51             :       INTEGER, INTENT (IN) :: ifftd2
      52             :   
      53             :       !     ..
      54             :       !     .. Local Scalars ..
      55             :       INTEGER :: js,nt,i,iq,irec2,nmz0,nmzdiff,ivac,ip,ngrid
      56             :       INTEGER :: iSpin,jSpin,nfxc,fxcSpin
      57             :       REAL    :: rhti,zro,fgz,rhmnv,d_15,bmat1(3,3),rd
      58             :       LOGICAL :: l_libxc
      59             :       !     ..
      60             :       !     .. Local Arrays ..
      61           0 :       REAL, ALLOCATABLE :: rho(:,:),v_xc(:,:),v_x(:,:),e_xc(:,:), rho1re(:,:),rho1im(:,:)
      62             :       REAL, ALLOCATABLE :: v_xc1re(:,:),v_xc1im(:,:),f_xc(:,:)
      63           0 :       TYPE(t_gradients)::  grad, grad1 !TODO:     not sure if we need grad1
      64           0 :       TYPE(t_potden)   :: vxcIm
      65             :       !     .. unused input (needed for other noco GGA-implementations) ..
      66             :       
      67           0 :       l_libxc=.FALSE.
      68           0 :       nfxc = 2 * input%jspins - 1  
      69             : 
      70             :       !SELECT TYPE(xcpot)
      71             :       !TYPE IS (t_xcpot_libxc)
      72             :       !   IF (xcpot%needs_grad()) THEN
      73             :       !      CALL judft_error("libxc GGA functionals not implemented in film setups")
      74             :       !   END IF
      75             :       !END SELECT
      76             :   
      77           0 :       ngrid=vacuum%nvac*(vacuum%nmzxy*ifftd2+vacuum%nmz)
      78             : 
      79           0 :       if (xcpot%needs_grad()) CALL xcpot%alloc_gradients(ngrid,input%jspins,grad)
      80           0 :       allocate(rho(ngrid,input%jspins),v_xc(ngrid,input%jspins),v_x(ngrid,input%jspins))
      81           0 :       allocate(rho1re(ngrid,input%jspins))
      82           0 :       allocate(rho1im(ngrid,input%jspins))
      83             : 
      84           0 :       ALLOCATE(f_xc(SIZE(rho,1),nfxc))
      85           0 :       ALLOCATE(v_xc1re,mold=rho)
      86           0 :       ALLOCATE(v_xc1im,mold=rho)
      87             : 
      88           0 :       CALL vxcIm%copyPotDen(vxc)
      89           0 :       CALL vxcIm%resetPotDen()
      90             : 
      91           0 :       rho=0.0
      92           0 :       rho1re=0.0
      93           0 :       rho1im=0.0
      94             :       !call vac_to_grid(xcpot%needs_grad(),ifftd2,input%jspins,vacuum,noco%l_noco,cell,den%vacxy(:,:,:,:),den%vacz,stars,rho,grad)
      95           0 :       call timestart("vac_to_grid")
      96           0 :       call vac_to_grid(xcpot%needs_grad(),ifftd2,input%jspins,vacuum,noco%l_noco,cell,den%vac,stars,rho,grad)
      97           0 :       call vac_to_grid(xcpot%needs_grad(),ifftd2,input%jspins,vacuum,noco%l_noco,cell,den1%vac,starsq,rho1re,grad1,rho1im)
      98           0 :       call timestop("vac_to_grid")
      99             :       !         calculate the exchange-correlation potential in  real space
     100             : 
     101             : #ifdef CPP_LIBXC 
     102           0 :       CALL xcpot%get_fxc(input%jspins, rho, f_xc)
     103             : #endif
     104             :     
     105             :       !SELECT TYPE(xcpot)
     106             :       !TYPE IS (t_xcpot_libxc)
     107             :       !   l_libxc=.TRUE.
     108             :       !   IF (xcpot%needs_grad()) THEN
     109             :       !      CALL judft_error("GGA not yet implemented",calledby ="dfpt_vvac_xc")
     110             :       !      CALL libxc_postprocess_gga_vac(xcpot,input,cell,stars,vacuum ,v_xc,grad)
     111             :       !      CALL libxc_postprocess_gga_vac(xcpot,input,cell,stars,vacuum ,v_x,grad)
     112             :       !   END IF
     113             :       !END SELECT
     114             : 
     115           0 :       v_xc1re = 0.0
     116           0 :       v_xc1im = 0.0
     117           0 :       DO iSpin = 1, input%jspins
     118           0 :           DO jSpin = 1, input%jspins
     119           0 :               fxcSpin = iSpin + jSpin - 1
     120           0 :               v_xc1re(:, iSpin) = v_xc1re(:, iSpin) + f_xc(:, fxcSpin) * rho1re(:, jSpin)
     121           0 :               v_xc1im(:, iSpin) = v_xc1im(:, iSpin) + f_xc(:, fxcSpin) * rho1im(:, jSpin)
     122             :           END DO
     123             :       END DO      
     124           0 :       call timestart("vac_from_grid")
     125           0 :       call vac_from_grid(starsq,vacuum,v_xc1re,ifftd2,vxc%vac)
     126           0 :       call vac_from_grid(starsq,vacuum,v_xc1im,ifftd2,vxcIm%vac)
     127           0 :       vxc%vac=vxc%vac + ImagUnit * vxcIm%vac
     128           0 :       call timestop("vac_from_grid")
     129             : 
     130           0 :     END SUBROUTINE dfpt_vvac_xc
     131             :   END MODULE m_dfpt_vvac_xc
     132             :