LCOV - code coverage report
Current view: top level - vgen - vmt_xc.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 46 63 73.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          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_vmt_xc
       7             :      USE m_judft
       8             :       !.....------------------------------------------------------------------
       9             :       !     Calculate the GGA xc-potential in the MT-spheres
      10             :       !.....------------------------------------------------------------------
      11             :       !     instead of vmtxcor.f: the different exchange-correlation
      12             :       !     potentials defined through the key icorr are called through
      13             :       !     the driver subroutine vxcallg.f, subroutines vectorized
      14             :       !     ** r.pentcheva 22.01.96
      15             :       !     *********************************************************
      16             :       !     angular mesh calculated on speacial gauss-legendre points
      17             :       !     in order to use orthogonality of lattice harmonics and
      18             :       !     avoid a least square fit
      19             :       !     ** r.pentcheva 04.03.96
      20             :       !     *********************************************************
      21             :       !     MPI and OpenMP parallelization
      22             :       !             U.Alekseeva, February 2017
      23             :       !     *********************************************************
      24             : 
      25             :    CONTAINS
      26         340 :       SUBROUTINE vmt_xc(mpi,sphhar,atoms,&
      27             :                         den,xcpot,input,sym,EnergyDen,vTot,vx,exc)
      28             : #include"cpp_double.h"
      29             :          use m_libxc_postprocess_gga
      30             :          USE m_mt_tofrom_grid
      31             :          USE m_types_xcpot_inbuild
      32             :          USE m_types
      33             :          USE m_metagga
      34             :          USE m_juDFT_string
      35             :          IMPLICIT NONE
      36             : 
      37             :          CLASS(t_xcpot),INTENT(INOUT)   :: xcpot
      38             :          TYPE(t_mpi),INTENT(IN)         :: mpi
      39             :          TYPE(t_input),INTENT(IN)       :: input
      40             :          TYPE(t_sym),INTENT(IN)         :: sym
      41             :          TYPE(t_sphhar),INTENT(IN)      :: sphhar
      42             :          TYPE(t_atoms),INTENT(IN)       :: atoms
      43             :          TYPE(t_potden),INTENT(IN)      :: den,EnergyDen
      44             :          TYPE(t_potden),INTENT(INOUT)   :: vTot,vx,exc
      45             : #ifdef CPP_MPI
      46             :          include "mpif.h"
      47             : #endif
      48             :          !     ..
      49             :          !     .. Local Scalars ..
      50         340 :          TYPE(t_gradients)     :: grad, tmp_grad
      51         340 :          TYPE(t_xcpot_inbuild) :: xcpot_tmp
      52             :          TYPE(t_potden)        :: vTot_tmp
      53             :          TYPE(t_sphhar)        :: tmp_sphhar
      54         340 :          REAL, ALLOCATABLE     :: ch(:,:)
      55             :          INTEGER               :: n,nsp,nt,jr, loc_n
      56             :          INTEGER               :: i, j, idx, cnt
      57             :          REAL                  :: divi
      58             : 
      59             :          !     ..
      60             : 
      61             :          !locals for mpi
      62             :          integer :: ierr
      63             :          integer:: n_start,n_stride
      64         680 :          REAL:: v_x((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,input%jspins)
      65         680 :          REAL:: v_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,input%jspins)
      66         680 :          REAL:: e_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,1)
      67         340 :          REAL,ALLOCATABLE:: xcl(:,:)
      68         680 :          LOGICAL :: lda_atom(atoms%ntype),l_libxc, perform_MetaGGA
      69             :          !.....------------------------------------------------------------------
      70             :          perform_MetaGGA = ALLOCATED(EnergyDen%mt) &
      71         340 :                          .AND. (xcpot%exc_is_MetaGGA() .or. xcpot%vx_is_MetaGGA())
      72         998 :          lda_atom=.FALSE.; l_libxc=.FALSE.
      73             :          SELECT TYPE(xcpot)
      74             :          TYPE IS(t_xcpot_inbuild)
      75         298 :             lda_atom=xcpot%lda_atom
      76        1170 :             IF (ANY(lda_atom)) THEN
      77           0 :                IF((.NOT.xcpot%is_name("pw91"))) &
      78           0 :                   CALL judft_warn("Using locally LDA only possible with pw91 functional")
      79           0 :                CALL xcpot_tmp%init("l91",.FALSE.,atoms%ntype)
      80           0 :                ALLOCATE(xcl(SIZE(v_xc,1),SIZE(v_xc,2)))
      81             :             ENDIF
      82             :          CLASS DEFAULT
      83             :             l_libxc=.true. !libxc!!
      84             :          END SELECT
      85             : 
      86         340 :          nsp=atoms%nsp()
      87         340 :          ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
      88         340 :          IF (xcpot%needs_grad()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
      89             : 
      90         340 :          CALL init_mt_grid(input%jspins,atoms,sphhar,xcpot,sym)
      91             : 
      92             : #ifdef CPP_MPI
      93         340 :          n_start=mpi%irank+1
      94         340 :          n_stride=mpi%isize
      95         340 :          IF (mpi%irank>0) THEN
      96         170 :             vTot%mt=0.0
      97         170 :             vx%mt=0.0
      98         170 :             exc%mt=0.0
      99             :          ENDIF
     100             : #else
     101             :          n_start=1
     102             :          n_stride=1
     103             : #endif
     104         340 :          loc_n = 0
     105         340 :          call xcpot%kinED%alloc_mt(nsp*atoms%jmtd,input%jspins, n_start, atoms%ntype, n_stride)
     106        1009 :          DO n = n_start,atoms%ntype,n_stride
     107         329 :             loc_n = loc_n + 1
     108         329 :             CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
     109             : 
     110             :             !
     111             :             !         calculate the ex.-cor. potential
     112         329 :             if(perform_MetaGGA .and. xcpot%kinED%set) then
     113             :                CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc(:nsp*atoms%jri(n),:)&
     114           0 :                    , v_x(:nsp*atoms%jri(n),:),grad, kinED_KS=xcpot%kinED%mt(:,:,loc_n))
     115             :             else
     116             :                CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc(:nsp*atoms%jri(n),:)&
     117         329 :                   , v_x(:nsp*atoms%jri(n),:),grad)
     118             :             endif
     119         329 :             IF (lda_atom(n)) THEN
     120             :                ! Use local part of pw91 for this atom
     121           0 :                CALL xcpot_tmp%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),xcl(:nsp*atoms%jri(n),:),v_x(:nsp*atoms%jri(n),:),grad)
     122             :                !Mix the potentials
     123           0 :                divi = 1.0 / (atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(1,n))
     124           0 :                nt=0
     125           0 :                DO jr=1,atoms%jri(n)
     126             :                   v_xc(nt+1:nt+nsp,:) = ( xcl(nt+1:nt+nsp,:) * ( atoms%rmsh(atoms%jri(n),n) &
     127             :                                           - atoms%rmsh(jr,n) ) &
     128             :                                           + v_xc(nt+1:nt+nsp,:) * ( atoms%rmsh(jr,n) &
     129             :                                           - atoms%rmsh(1,n) ) &
     130           0 :                                          ) * divi
     131           0 :                   nt=nt+nsp
     132             :                ENDDO
     133             :             ENDIF
     134             : 
     135             :             !Add postprocessing for libxc
     136         329 :             IF (l_libxc.AND.xcpot%needs_grad()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad, atom_num=n)
     137             : 
     138         329 :             CALL mt_from_grid(atoms,sphhar,n,input%jspins,v_xc,vTot%mt(:,0:,n,:))
     139         329 :             CALL mt_from_grid(atoms,sphhar,n,input%jspins,v_x,vx%mt(:,0:,n,:))
     140             : 
     141             : 
     142         669 :             IF (ALLOCATED(exc%mt)) THEN
     143             :                !
     144             :                !           calculate the ex.-cor energy density
     145             :                !
     146             :                
     147         329 :                IF(perform_MetaGGA .and. xcpot%kinED%set) THEN
     148             :                   CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),&
     149             :                      e_xc(:nsp*atoms%jri(n),1),grad, &
     150           0 :                      kinED_KS=xcpot%kinED%mt(:,:,loc_n), mt_call=.True.)
     151             :                ELSE
     152             :                   CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),&
     153         329 :                      e_xc(:nsp*atoms%jri(n),1),grad, mt_call=.True.)
     154             :                ENDIF
     155             :    
     156             :                !write (*,*) "cut first ", cut_ratio, " number of points"
     157             :                !where(cut_mask) e_xc(:,1) = 0.0
     158             : 
     159         329 :                IF (lda_atom(n)) THEN
     160             :                   ! Use local part of pw91 for this atom
     161           0 :                   CALL xcpot_tmp%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),xcl(:nsp*atoms%jri(n),1),grad)
     162             :                   !Mix the potentials
     163           0 :                   nt=0
     164           0 :                   DO jr=1,atoms%jri(n)
     165             :                      e_xc(nt+1:nt+nsp,1) = ( xcl(nt+1:nt+nsp,1) * ( atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(jr,n) ) +&
     166           0 :                                             e_xc(nt+1:nt+nsp,1) * ( atoms%rmsh(jr,n) - atoms%rmsh(1,n) ) ) * divi
     167           0 :                      nt=nt+nsp
     168             :                   END DO
     169             :                ENDIF
     170         329 :                CALL mt_from_grid(atoms,sphhar,n,1,e_xc,exc%mt(:,0:,n,:))
     171             :             ENDIF
     172             :          ENDDO
     173             : 
     174         340 :          CALL finish_mt_grid()
     175             : #ifdef CPP_MPI
     176         340 :          CALL MPI_ALLREDUCE(MPI_IN_PLACE,vx%mt,SIZE(vx%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
     177         340 :          CALL MPI_ALLREDUCE(MPI_IN_PLACE,vTot%mt,SIZE(vTot%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
     178         340 :          CALL MPI_ALLREDUCE(MPI_IN_PLACE,exc%mt,SIZE(exc%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
     179             : #endif
     180             :          !
     181         340 :          RETURN
     182        1020 :       END SUBROUTINE vmt_xc
     183         340 :    END MODULE m_vmt_xc

Generated by: LCOV version 1.13