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
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
19
   SUBROUTINE vis_xc(stars,sym,cell,den,xcpot,input,noco,EnergyDen, vxc,vx,exc)
20

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

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

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

51
      CALL init_pw_grid(xcpot,stars,sym,cell)
52

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

58
      CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
59

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