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             : MODULE m_dfpt_vmt_xc
       7             : #ifdef CPP_MPI
       8             : use mpi
       9             : #endif
      10             : USE m_judft
      11             : 
      12             : CONTAINS
      13           0 :    SUBROUTINE dfpt_vmt_xc(fmpi,sphhar,atoms,den,den1,den1im,xcpot,input,sym,noco,vTot,dfptvTotimag)
      14             :       use m_libxc_postprocess_gga
      15             :       USE m_mt_tofrom_grid
      16             :       USE m_types_xcpot_inbuild
      17             :       USE m_types
      18             :       USE m_metagga
      19             :       IMPLICIT NONE
      20             : 
      21             :       CLASS(t_xcpot),INTENT(IN)      :: xcpot
      22             :       TYPE(t_mpi),INTENT(IN)         :: fmpi
      23             :       TYPE(t_input),INTENT(IN)       :: input
      24             :       TYPE(t_sym),INTENT(IN)         :: sym
      25             :       TYPE(t_sphhar),INTENT(IN)      :: sphhar
      26             :       TYPE(t_atoms),INTENT(IN)       :: atoms
      27             :       TYPE(t_potden),INTENT(IN)      :: den, den1, den1im
      28             :       TYPE(t_noco), INTENT(IN)       :: noco
      29             :       TYPE(t_potden),INTENT(INOUT)   :: vTot, dfptvTotimag
      30             :       !     ..
      31             :       !     .. Local Scalars ..
      32           0 :       TYPE(t_gradients)     :: grad
      33             :       TYPE(t_xcpot_inbuild) :: xcpot_tmp
      34             :       TYPE(t_potden)        :: vTot_tmp
      35           0 :       TYPE(t_noco)          :: noco_loco
      36           0 :       REAL, ALLOCATABLE     :: ch(:,:),chre(:,:),chim(:,:),f_xc(:,:),v_xc1re(:,:),v_xc1im(:,:)
      37             :       INTEGER               :: n,nsp,nt,jr
      38             :       INTEGER               :: i, j, idx, cnt, iSpin, jSpin, fxcSpin
      39             :       REAL                  :: divi
      40             : 
      41             :       !locals for fmpi
      42             :       integer :: ierr, nfxc
      43             :       integer:: n_start,n_stride
      44           0 :       LOGICAL :: lda_atom(atoms%ntype),l_libxc, perform_MetaGGA
      45             : 
      46           0 :       noco_loco = noco
      47           0 :       noco_loco%l_unrestrictMT = .FALSE.
      48             : 
      49           0 :       nfxc = 2 * input%jspins - 1
      50             : 
      51           0 :       l_libxc=.FALSE.
      52             :       SELECT TYPE(xcpot)
      53             :       TYPE IS(t_xcpot_inbuild)
      54           0 :          lda_atom=atoms%lda_atom
      55           0 :          IF (ANY(lda_atom)) THEN
      56           0 :             CALL judft_error("Using locally LDA not possible with DFPT.")
      57             :          ENDIF
      58             :       CLASS DEFAULT
      59           0 :          l_libxc=.true.
      60             :       END SELECT
      61             : 
      62           0 :       nsp=atoms%nsp()
      63             : 
      64           0 :       CALL init_mt_grid(input%jspins,atoms,sphhar,.FALSE.,sym)
      65             : 
      66             : #ifdef CPP_MPI
      67           0 :       n_start=fmpi%irank+1
      68           0 :       n_stride=fmpi%isize
      69           0 :       IF (fmpi%irank>0) THEN
      70           0 :          vTot%mt=0.0
      71           0 :          dfptvTotimag%mt=0.0
      72             :       ENDIF
      73             : #else
      74             :       n_start=1
      75             :       n_stride=1
      76             : #endif
      77           0 :       DO n = n_start,atoms%ntype,n_stride
      78           0 :          ALLOCATE(ch(nsp*atoms%jri(n),input%jspins),f_xc(nsp*atoms%jri(n),nfxc))
      79           0 :          ALLOCATE(chre(nsp*atoms%jri(n),input%jspins),chim(nsp*atoms%jri(n),input%jspins))
      80           0 :          ALLOCATE(v_xc1re(nsp*atoms%jri(n),input%jspins),v_xc1im(nsp*atoms%jri(n),input%jspins))
      81             : 
      82           0 :          CALL mt_to_grid(.FALSE., input%jspins, atoms,sym,sphhar,.FALSE.,den%mt(:,0:,n,:),n,noco_loco,grad,ch)
      83           0 :          CALL mt_to_grid(.FALSE., input%jspins, atoms,sym,sphhar,.FALSE.,den1%mt(:,0:,n,:),n,noco_loco,grad,chre)
      84           0 :          CALL mt_to_grid(.FALSE., input%jspins, atoms,sym,sphhar,.FALSE.,den1im%mt(:,0:,n,:),n,noco_loco,grad,chim)
      85             : 
      86             : #ifdef CPP_LIBXC
      87           0 :         CALL xcpot%get_fxc(input%jspins, ch, f_xc)
      88             : #else
      89             :         CALL judft_error("You compiled Fleur without libxc but want to use DFPT. Please fix that.")
      90             :         !CALL xcpot%get_vxc(input%jspins,ch,v_xc,v_x,grad)
      91             :         !TODO: Maybe place the old way with x-Alpha here for fun.
      92             : #endif
      93             : 
      94           0 :         v_xc1re = 0.0
      95           0 :         v_xc1im = 0.0
      96           0 :         DO iSpin = 1, input%jspins
      97           0 :             DO jSpin = 1, input%jspins
      98           0 :                 fxcSpin = iSpin + jSpin - 1
      99           0 :                 v_xc1re(:, iSpin) = v_xc1re(:, iSpin) + f_xc(:, fxcSpin) * chre(:, jSpin)
     100           0 :                 v_xc1im(:, iSpin) = v_xc1im(:, iSpin) + f_xc(:, fxcSpin) * chim(:, jSpin)
     101             :             END DO
     102             :         END DO
     103             : 
     104           0 :          CALL mt_from_grid(atoms,sym,sphhar,n,input%jspins,v_xc1re,vTot%mt(:,0:,n,:))
     105           0 :          CALL mt_from_grid(atoms,sym,sphhar,n,input%jspins,v_xc1im,dfptvTotimag%mt(:,0:,n,:))
     106             : 
     107           0 :          DEALLOCATE (ch,chre,chim,f_xc,v_xc1re,v_xc1im)
     108             :       ENDDO
     109             : 
     110           0 :       CALL finish_mt_grid()
     111             : #ifdef CPP_MPI
     112           0 :       CALL MPI_ALLREDUCE(MPI_IN_PLACE,vTot%mt,SIZE(vTot%mt),MPI_DOUBLE_PRECISION,MPI_SUM,fmpi%mpi_comm,ierr)
     113           0 :       CALL MPI_ALLREDUCE(MPI_IN_PLACE,dfptvTotimag%mt,SIZE(dfptvTotimag%mt),MPI_DOUBLE_PRECISION,MPI_SUM,fmpi%mpi_comm,ierr)
     114             : #endif
     115             :       !
     116           0 :       RETURN
     117           0 :   END SUBROUTINE dfpt_vmt_xc
     118           0 : END MODULE m_dfpt_vmt_xc