vis_xc.F90 3.95 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_vis_xc
Matthias Redies's avatar
Matthias Redies committed
12 13 14 15 16 17
   USE m_juDFT
   !     ******************************************************
   !     subroutine generates the exchange-correlation potential
   !     in the interstitial region    c.l.fu
   !     including gradient corrections. t.a. 1996.
   !     ******************************************************
18
CONTAINS
Matthias Redies's avatar
Matthias Redies committed
19
   SUBROUTINE vis_xc(stars,sym,cell,den,xcpot,input,noco,EnergyDen, vxc,vx,exc)
20

Matthias Redies's avatar
Matthias Redies committed
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
      !     ******************************************************
      !     instead of visxcor.f: the different exchange-correlation
      !     potentials defined through the key icorr are called through
      !     the driver subroutine vxcallg.f,for the energy density - excallg
      !     subroutines vectorized
      !     ** r.pentcheva 22.01.96
      !     *********************************************************
      !     in case of total = .true. calculates the ex-corr. energy
      !     density
      !     ** r.pentcheva 08.05.96
      !     ******************************************************************
      USE m_pw_tofrom_grid
      USE m_types
      USE m_types_xcpot_libxc
      USE m_libxc_postprocess_gga
      IMPLICIT NONE
37

Matthias Redies's avatar
Matthias Redies committed
38 39 40 41 42 43 44 45
      CLASS(t_xcpot),INTENT(IN)     :: xcpot
      TYPE(t_input),INTENT(IN)      :: input
      TYPE(t_noco),INTENT(IN)       :: noco
      TYPE(t_sym),INTENT(IN)        :: sym
      TYPE(t_stars),INTENT(IN)      :: stars
      TYPE(t_cell),INTENT(IN)       :: cell
      TYPE(t_potden),INTENT(IN)     :: den, EnergyDen
      TYPE(t_potden),INTENT(INOUT)  :: vxc,vx,exc
46

Matthias Redies's avatar
Matthias Redies committed
47 48 49
      TYPE(t_gradients) :: grad, tmp_grad
      REAL, ALLOCATABLE :: rho(:,:), ED_rs(:,:), vtot_rs(:,:), kinED_rs(:,:)
      REAL, ALLOCATABLE :: v_x(:,:),v_xc(:,:),e_xc(:,:)
50

Matthias Redies's avatar
Matthias Redies committed
51
      CALL init_pw_grid(xcpot,stars,sym,cell)
52

Matthias Redies's avatar
Matthias Redies committed
53 54 55 56
      !Put the charge on the grid, in GGA case also calculate gradients
      CALL pw_to_grid(xcpot,input%jspins,noco%l_noco,stars,cell,den%pw,grad,rho)
      ALLOCATE(v_xc,mold=rho)
      ALLOCATE(v_x,mold=rho)
57

Matthias Redies's avatar
Matthias Redies committed
58
      CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
59

Matthias Redies's avatar
Matthias Redies committed
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
      IF (xcpot%needs_grad()) THEN
         SELECT TYPE(xcpot)
         TYPE IS (t_xcpot_libxc)
            CALL libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
         END SELECT
      ENDIF
      !Put the potentials in rez. space.
      CALL  pw_from_grid(xcpot,stars,input%total,v_xc,vxc%pw,vxc%pw_w)
      CALL  pw_from_grid(xcpot,stars,input%total,v_x,vx%pw,vx%pw_w)

      if(allocated(EnergyDen%pw) .and. xcpot%exc_is_MetaGGA) then
         CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, cell, EnergyDen%pw, tmp_grad, ED_rs)
         CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, cell, vtot%pw,      tmp_grad, vtot_rs)
         CALL calc_kinEnergyDen(ED_rs, vtot_rs, kinED_rs)
      endif

      !calculate the ex.-cor energy density
      IF (ALLOCATED(exc%pw_w)) THEN
         ALLOCATE ( e_xc(SIZE(rho,1),1) ); e_xc=0.0

         if(allocated(kinED_rs)) then
            CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad,kinED_rs)
         else
            CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad)
         endif
         CALL pw_from_grid(xcpot,stars,.TRUE.,e_xc,exc%pw,exc%pw_w)
      ENDIF

      CALL finish_pw_grid()

   END SUBROUTINE vis_xc
91
END MODULE m_vis_xc