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             : !--------------------------------------------------------------------------------
       7             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       8             : ! This file is part of FLEUR and available as free software under the conditions
       9             : ! of the MIT license as expressed in the LICENSE file in more detail.
      10             : !--------------------------------------------------------------------------------
      11             : MODULE m_dfpt_vis_xc
      12             :    USE m_juDFT
      13             :    use m_convol
      14             :    !     ******************************************************
      15             :    !     subroutine generates the exchange-correlation potential
      16             :    !     in the interstitial region    c.l.fu
      17             :    !     including gradient corrections. t.a. 1996.
      18             :    !     ******************************************************
      19             : CONTAINS
      20           0 :    SUBROUTINE dfpt_vis_xc(stars,starsq,sym,cell,den,den1,xcpot,input,vTot)
      21             : 
      22             :       !     ******************************************************
      23             :       !     instead of visxcor.f: the different exchange-correlation
      24             :       !     potentials defined through the key icorr are called through
      25             :       !     the driver subroutine vxcallg.f,for the energy density - excallg
      26             :       !     subroutines vectorized
      27             :       !     ** r.pentcheva 22.01.96
      28             :       !     *********************************************************
      29             :       !     in case of total = .true. calculates the ex-corr. energy
      30             :       !     density
      31             :       !     ** r.pentcheva 08.05.96
      32             :       !     ******************************************************************
      33             :       USE m_pw_tofrom_grid
      34             :       USE m_types
      35             :       USE m_types_xcpot_libxc
      36             :       USE m_libxc_postprocess_gga
      37             :       USE m_metagga
      38             :       IMPLICIT NONE
      39             : 
      40             :       CLASS(t_xcpot),INTENT(IN)     :: xcpot
      41             :       TYPE(t_input),INTENT(IN)      :: input
      42             :       TYPE(t_sym),INTENT(IN)        :: sym
      43             :       TYPE(t_stars),INTENT(IN)      :: stars, starsq
      44             :       TYPE(t_cell),INTENT(IN)       :: cell
      45             :       TYPE(t_potden),INTENT(IN)     :: den, den1
      46             :       TYPE(t_potden),INTENT(INOUT)  :: vTot
      47             : 
      48           0 :       TYPE(t_gradients) :: grad
      49           0 :       TYPE(t_potden) :: vTotim
      50             : 
      51           0 :       REAL, ALLOCATABLE :: rho(:,:), rho1re(:,:), rho1im(:,:), ED_rs(:,:), vTot_rs(:,:)
      52             :       REAL, ALLOCATABLE :: rho_conv(:,:), ED_conv(:,:), vTot_conv(:,:)
      53           0 :       REAL, ALLOCATABLE :: v_xc1re(:,:),v_xc1im(:,:),f_xc(:,:)
      54             :       INTEGER           :: iSpin, jSpin, fxcSpin, i, js, nfxc
      55             :       LOGICAL           :: perform_MetaGGA, l_libxc
      56             : 
      57           0 :       nfxc = 2 * input%jspins - 1
      58             : 
      59           0 :       l_libxc=.FALSE.
      60             : 
      61             :       IF (ALLOCATED(vTotim%pw)) DEALLOCATE(vTotim%pw)
      62           0 :       ALLOCATE(vTotim%pw,mold=vTot%pw)
      63           0 :       vTotim%pw = CMPLX(0.0,0.0)
      64             : 
      65           0 :       call timestart("init_pw_grid")
      66           0 :       CALL init_pw_grid(stars,sym,cell,xcpot)
      67           0 :       call timestop("init_pw_grid")
      68             : 
      69             :       !Put the charge on the grid, in GGA case also calculate gradients
      70           0 :       call timestart("pw_to_grid")
      71           0 :       CALL pw_to_grid(.FALSE.,input%jspins,.FALSE.,stars,cell,den%pw,grad,xcpot,rho)
      72           0 :       CALL pw_to_grid(.FALSE.,input%jspins,.FALSE.,starsq,cell,den1%pw,grad,xcpot,rho1re,rho1im)
      73           0 :       call timestop("pw_to_grid")
      74             : 
      75           0 :       ALLOCATE(f_xc(SIZE(rho,1),nfxc))
      76           0 :       ALLOCATE(v_xc1re,mold=rho)
      77           0 :       ALLOCATE(v_xc1im,mold=rho)
      78             : 
      79             :       !call timestart("apply_cutoffs")
      80             :       !CALL xcpot%apply_cutoffs(1.E-6,rho,grad)
      81             :       !call timestop("apply_cutoffs")
      82             : #ifdef CPP_LIBXC
      83           0 :       CALL xcpot%get_fxc(input%jspins, rho, f_xc)
      84             : #else
      85             :       CALL judft_error("You compiled Fleur without libxc but want to use DFPT. Please fix that.")
      86             :       !CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
      87             :       !TODO: Maybe place the old way with x-Alpha here for fun.
      88             : #endif
      89             : 
      90           0 :       v_xc1re = 0.0
      91           0 :       v_xc1im = 0.0
      92           0 :       DO iSpin = 1, input%jspins
      93           0 :           DO jSpin = 1, input%jspins
      94           0 :               fxcSpin = iSpin + jSpin - 1
      95           0 :               v_xc1re(:, iSpin) = v_xc1re(:, iSpin) + f_xc(:, fxcSpin) * rho1re(:, jSpin)
      96           0 :               v_xc1im(:, iSpin) = v_xc1im(:, iSpin) + f_xc(:, fxcSpin) * rho1im(:, jSpin)
      97             :           END DO
      98             :       END DO
      99             : 
     100             :       !Put the potentials in rez. space.
     101           0 :       call timestart("pw_from_grid")
     102           0 :       CALL  pw_from_grid(starsq,v_xc1re,vTot%pw)
     103           0 :       CALL  pw_from_grid(starsq,v_xc1im,vTotim%pw)
     104           0 :       vTot%pw = vTot%pw + ImagUnit * vTotim%pw
     105           0 :       call timestop("pw_from_grid")
     106             : 
     107             : !      call timestart("finish_pw_grid")
     108             : !      CALL finish_pw_grid()
     109             : !      call timestop("finish_pw_grid")
     110           0 :    END SUBROUTINE dfpt_vis_xc
     111             : END MODULE m_dfpt_vis_xc