vmt_xc.F90 6.28 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! 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_vmt_xc
7
  USE m_judft
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
   !.....------------------------------------------------------------------
   !     Calculate the GGA xc-potential in the MT-spheres
   !.....------------------------------------------------------------------
   !     instead of vmtxcor.f: the different exchange-correlation
   !     potentials defined through the key icorr are called through
   !     the driver subroutine vxcallg.f, subroutines vectorized
   !     ** r.pentcheva 22.01.96
   !     *********************************************************
   !     angular mesh calculated on speacial gauss-legendre points
   !     in order to use orthogonality of lattice harmonics and
   !     avoid a least square fit
   !     ** r.pentcheva 04.03.96
   !     *********************************************************
   !     MPI and OpenMP parallelization
   !             U.Alekseeva, February 2017
   !     *********************************************************
24 25

CONTAINS
26 27
   SUBROUTINE vmt_xc(DIMENSION,mpi,sphhar,atoms,&
                     den,xcpot,input,sym, obsolete,vxc,vx,exc)
28 29

#include"cpp_double.h"
30 31 32 33 34
      use m_libxc_postprocess_gga
      USE m_mt_tofrom_grid
      USE m_types_xcpot_inbuild
      USE m_types
      IMPLICIT NONE
35

36 37 38 39 40 41 42 43 44 45
      CLASS(t_xcpot),INTENT(IN)      :: xcpot
      TYPE(t_dimension),INTENT(IN)   :: dimension
      TYPE(t_mpi),INTENT(IN)         :: mpi
      TYPE(t_obsolete),INTENT(IN)    :: obsolete
      TYPE(t_input),INTENT(IN)       :: input
      TYPE(t_sym),INTENT(IN)         :: sym
      TYPE(t_sphhar),INTENT(IN)      :: sphhar
      TYPE(t_atoms),INTENT(IN)       :: atoms
      TYPE(t_potden),INTENT(IN)      :: den
      TYPE(t_potden),INTENT(INOUT)   :: vxc,vx,exc
46
#ifdef CPP_MPI
47
      include "mpif.h"
48
#endif
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
      !     ..
      !     .. Local Scalars ..
      TYPE(t_gradients)     :: grad
      TYPE(t_xcpot_inbuild) :: xcpot_tmp
      REAL, ALLOCATABLE     :: ch(:,:)
      INTEGER               :: n,nsp,nt,jr
      REAL                  :: divi

      !     ..

      !locals for mpi
      integer :: ierr
      integer:: n_start,n_stride
      REAL:: v_x((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,input%jspins)
      REAL:: v_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,input%jspins)
      REAL:: e_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,1)
      REAL,ALLOCATABLE:: xcl(:,:)
      LOGICAL :: lda_atom(atoms%ntype),l_libxc
      !.....------------------------------------------------------------------
      lda_atom=.FALSE.; l_libxc=.FALSE.
      SELECT TYPE(xcpot)
      TYPE IS(t_xcpot_inbuild)
         lda_atom=xcpot%lda_atom
         IF (ANY(lda_atom)) THEN
            IF((.NOT.xcpot%is_name("pw91"))) &
74
               CALL judft_warn("Using locally LDA only possible with pw91 functional")
75 76 77 78 79 80 81
            CALL xcpot_tmp%init("l91",.FALSE.,atoms%ntype)
            ALLOCATE(xcl(SIZE(v_xc,1),SIZE(v_xc,2)))
         ENDIF
      CLASS DEFAULT
         l_libxc=.true. !libxc!!
      END SELECT

82
      nsp=atoms%nsp()
83 84 85 86
      ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
      IF (xcpot%is_gga()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)

      CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym)
87 88

#ifdef CPP_MPI
89 90 91 92 93 94 95
      n_start=mpi%irank+1
      n_stride=mpi%isize
      IF (mpi%irank>0) THEN
         vxc%mt=0.0
         vx%mt=0.0
         exc%mt=0.0
      ENDIF
96
#else
97 98
      n_start=1
      n_stride=1
99 100
#endif

101
      DO n = n_start,atoms%ntype,n_stride
Matthias Redies's avatar
Matthias Redies committed
102
         CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
         !
         !         calculate the ex.-cor. potential
         CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc(:nsp*atoms%jri(n),:),v_x(:nsp*atoms%jri(n),:),grad)
         IF (lda_atom(n)) THEN
            ! Use local part of pw91 for this atom
            CALL xcpot_tmp%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),xcl(:nsp*atoms%jri(n),:),v_x(:nsp*atoms%jri(n),:),grad)
            !Mix the potentials
            divi = 1.0 / (atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(1,n))
            nt=0
            DO jr=1,atoms%jri(n)
               v_xc(nt+1:nt+nsp,:) = ( xcl(nt+1:nt+nsp,:) * ( atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(jr,n) ) +&
                                      v_xc(nt+1:nt+nsp,:) * ( atoms%rmsh(jr,n) - atoms%rmsh(1,n) ) ) * divi
               nt=nt+nsp
            ENDDO
         ENDIF

         !Add postprocessing for libxc
         IF (l_libxc.AND.xcpot%is_gga()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad)

         CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_xc,vxc%mt(:,0:,n,:))
         CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_x,vx%mt(:,0:,n,:))
124

125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
         IF (ALLOCATED(exc%mt)) THEN
            !
            !           calculate the ex.-cor energy density
            !
            CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),e_xc(:nsp*atoms%jri(n),1),grad)
            IF (lda_atom(n)) THEN
               ! Use local part of pw91 for this atom
               CALL xcpot_tmp%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),xcl(:nsp*atoms%jri(n),1),grad)
               !Mix the potentials
               nt=0
               DO jr=1,atoms%jri(n)
                  e_xc(nt+1:nt+nsp,1) = ( xcl(nt+1:nt+nsp,1) * ( atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(jr,n) ) +&
                                         e_xc(nt+1:nt+nsp,1) * ( atoms%rmsh(jr,n) - atoms%rmsh(1,n) ) ) * divi
                  nt=nt+nsp
               END DO
            ENDIF
            CALL mt_from_grid(atoms,sphhar,nsp,n,1,e_xc,exc%mt(:,0:,n,:))
         ENDIF
      ENDDO
144

145
      CALL finish_mt_grid()
146
#ifdef CPP_MPI
147 148 149
      CALL MPI_ALLREDUCE(MPI_IN_PLACE,vx%mt,SIZE(vx%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
      CALL MPI_ALLREDUCE(MPI_IN_PLACE,vxc%mt,SIZE(vxc%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
      CALL MPI_ALLREDUCE(MPI_IN_PLACE,exc%mt,SIZE(exc%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
150
#endif
151 152 153
      !
      RETURN
   END SUBROUTINE vmt_xc
154
END MODULE m_vmt_xc