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