vis_xc.F90 4.5 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
   USE m_juDFT
Matthias Redies's avatar
Matthias Redies committed
13
   use m_convol
Matthias Redies's avatar
Matthias Redies committed
14 15 16 17 18
   !     ******************************************************
   !     subroutine generates the exchange-correlation potential
   !     in the interstitial region    c.l.fu
   !     including gradient corrections. t.a. 1996.
   !     ******************************************************
19
CONTAINS
20
   SUBROUTINE vis_xc(stars,sym,cell,den,xcpot,input,noco,EnergyDen,vTot,vx,exc)
21

Matthias Redies's avatar
Matthias Redies committed
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
37
      USE m_metagga
Matthias Redies's avatar
Matthias Redies committed
38
      IMPLICIT NONE
39

Matthias Redies's avatar
Matthias Redies committed
40
      CLASS(t_xcpot),INTENT(INOUT)     :: xcpot
Matthias Redies's avatar
Matthias Redies committed
41 42 43 44 45
      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
Matthias Redies's avatar
Matthias Redies committed
46
      TYPE(t_potden),INTENT(IN)  :: den, EnergyDen
47
      TYPE(t_potden),INTENT(INOUT)  :: vTot,vx,exc
48

Matthias Redies's avatar
Matthias Redies committed
49
      TYPE(t_gradients) :: grad, tmp_grad
Matthias Redies's avatar
Matthias Redies committed
50
      REAL, ALLOCATABLE :: rho(:,:), ED_rs(:,:), vTot_rs(:,:)
Matthias Redies's avatar
Matthias Redies committed
51
      REAL, ALLOCATABLE :: rho_conv(:,:), ED_conv(:,:), vTot_conv(:,:)
Matthias Redies's avatar
Matthias Redies committed
52
      COMPLEX, ALLOCATABLE :: den_pw_w(:,:), EnergyDen_pw_w(:,:), vtot_pw_norm(:,:) 
Matthias Redies's avatar
Matthias Redies committed
53
      REAL, ALLOCATABLE :: v_x(:,:),v_xc(:,:),e_xc(:,:)
Matthias Redies's avatar
Matthias Redies committed
54
      INTEGER           :: jspin, i, js
55

Matthias Redies's avatar
Matthias Redies committed
56
      CALL init_pw_grid(xcpot,stars,sym,cell)
57

Matthias Redies's avatar
Matthias Redies committed
58 59
      !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)
Matthias Redies's avatar
Matthias Redies committed
60

Matthias Redies's avatar
Matthias Redies committed
61 62
      ALLOCATE(v_xc,mold=rho)
      ALLOCATE(v_x,mold=rho)
63

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

Matthias Redies's avatar
Matthias Redies committed
66 67 68 69 70 71 72
      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.
73
      CALL  pw_from_grid(xcpot,stars,input%total,v_xc,vTot%pw,vTot%pw_w)
Matthias Redies's avatar
Matthias Redies committed
74 75
      CALL  pw_from_grid(xcpot,stars,input%total,v_x,vx%pw,vx%pw_w)

76
      ! use updated vTot for exc calculation
Matthias Redies's avatar
Matthias Redies committed
77
      IF(ALLOCATED(EnergyDen%pw) .AND. xcpot%exc_is_MetaGGA()) THEN
Matthias Redies's avatar
Matthias Redies committed
78 79
         allocate(den_pw_w,       mold=vTot%pw_w)
         allocate(EnergyDen_pw_w, mold=vTot%pw_w)
Matthias Redies's avatar
Matthias Redies committed
80
         allocate(vtot_pw_norm,   mold=vTot%pw)
Matthias Redies's avatar
Matthias Redies committed
81

82 83
         CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, &
                         cell,  EnergyDen%pw, tmp_grad,    ED_rs)
Matthias Redies's avatar
Matthias Redies committed
84

85
         CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, &
86
                         cell,  vTot%pw, tmp_grad,    vTot_rs)
Matthias Redies's avatar
Matthias Redies committed
87
         CALL calc_kinEnergyDen_pw(ED_rs, vTot_rs, rho, xcpot%kinED%is)
Matthias Redies's avatar
Matthias Redies committed
88
      ENDIF
Matthias Redies's avatar
Matthias Redies committed
89 90 91 92 93

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

94
         IF(ALLOCATED(EnergyDen%pw) .AND. xcpot%exc_is_MetaGGA()) THEN
Matthias Redies's avatar
Matthias Redies committed
95
            CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, xcpot%kinED%is, mt_call=.False.)
Matthias Redies's avatar
Matthias Redies committed
96
         ELSE
97
            CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, mt_call=.False.)
Matthias Redies's avatar
Matthias Redies committed
98
         ENDIF
Matthias Redies's avatar
Matthias Redies committed
99 100 101 102 103 104
         CALL pw_from_grid(xcpot,stars,.TRUE.,e_xc,exc%pw,exc%pw_w)
      ENDIF

      CALL finish_pw_grid()

   END SUBROUTINE vis_xc
105
END MODULE m_vis_xc