Line data Source code
1 : !!****m* ABINIT/m_dfpttd_berrycurv
2 : !! NAME
3 : !! m_dfpttd_berrycurv
4 : !!
5 : !! FUNCTION
6 : !! FIXME: add description.
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2023 ABINIT group (FIXME: add author)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! NOTES
15 : !!
16 : !! PARENTS
17 : !!
18 : !! CHILDREN
19 : !!
20 : !! SOURCE
21 :
22 : #if defined HAVE_CONFIG_H
23 : #include "config.h"
24 : #endif
25 :
26 : #include "abi_common.h"
27 :
28 : module m_dfpttd_berrycurv
29 :
30 : use defs_basis
31 : use defs_abitypes
32 : use defs_datatypes
33 : use m_dtset
34 : use m_dtfil
35 : use m_errors
36 : use m_profiling_abi
37 : use m_xmpi
38 : use m_mpinfo, only : proc_distrb_cycle
39 : use m_cgtools, only : dotprod_g
40 :
41 : implicit none
42 :
43 : public :: dfpttd_berrycurv
44 :
45 : private
46 :
47 : ! *************************************************************************
48 :
49 : contains
50 : !!***
51 :
52 : !!****f* ABINIT/m_dfpttd_berrycurv/dfpttd_berrycurv
53 : !! NAME
54 : !! dfpttd_berrycurv
55 : !!
56 : !! FUNCTION
57 : !! Compute first-order response function contributions to the time-dispersion
58 : !! 3rd order energy derivatives of the dispersion driver.
59 : !! The main inputs are :
60 : !! - 1st-order WFs for two perturbations i1pert/i1dir,i2pert/i2dir (cg1,cg2)
61 : !!
62 : !! INPUTS
63 : !! cg1 = first derivative of cg with respect the perturbation i1pert
64 : !! cg2 = first derivative of cg with respect the perturbation i2pert
65 : !! cplex= if 1, real space 1-order functions on FFT grid are REAL,
66 : !! if 2, COMPLEX
67 : !! dtset <type(dataset_type)>=all input variables for this dataset
68 : !! gsqcut=large sphere cut-off
69 : !! mband = maximum number of bands
70 : !! mk1mem = maximum number of k points for first-order WF
71 : !! which can fit in core memory
72 : !! mpert =maximum number of ipert
73 : !! mpi_enreg=MPI-parallelisation information
74 : !! mpw = maximum number of planewaves in basis sphere (large number)
75 : !! natom = number of atoms in unit cell
76 : !! nfft= number of FFT grid points (for this proc)
77 : !! ngfft(1:18)=integer array with FFT box dimensions and other
78 : !! nkpt = number of k points
79 : !! nspden = number of spin-density components
80 : !! nspinor = number of spinorial components of the wavefunctions
81 : !! nsppol = number of channels for spin-polarization (1 or 2)
82 : !! npwarr(nkpt) = array holding npw for each k point
83 : !! occ(mband*nkpt*nsppol) = occupation number for each band and k
84 : !! ucvol=volume of the unit cell
85 : !!
86 : !! OUTPUT
87 : !! d3etot(2,3,mpert,3,mpert,3,mpert) = third derivatives of the energy tensor
88 : !!
89 : !! SIDE EFFECTS
90 : !!
91 : !! NOTES
92 : !!
93 : !! PARENTS
94 : !!
95 : !! CHILDREN
96 : !!
97 : !! SOURCE
98 :
99 26 : subroutine dfpttd_berrycurv(cg1,cg2,d3etot_td,dtset,&
100 : & mband,mk1mem,mpi_enreg,mpw,nkpt,nspinor,nsppol, &
101 26 : & npwarr,occ)
102 :
103 : use defs_basis
104 :
105 : implicit none
106 :
107 : !Arguments ------------------------------------
108 : !scalars
109 : integer, intent(in) :: mband,mk1mem,mpw
110 : integer, intent(in) :: nkpt,nspinor,nsppol
111 : type(dataset_type),intent(in) :: dtset
112 : type(MPI_type),intent(inout) :: mpi_enreg
113 :
114 : !arrays
115 : integer,intent(in) :: npwarr(nkpt)
116 : real(dp),intent(in) :: cg1(2,mpw*nspinor*mband*mk1mem*nsppol)
117 : real(dp),intent(in) :: cg2(2,mpw*nspinor*mband*mk1mem*nsppol)
118 : real(dp),intent(out) :: d3etot_td(2)
119 : real(dp),intent(in) :: occ(mband*nkpt*nsppol)
120 :
121 : !Local variables-------------------------------
122 : !scalars
123 : integer :: bandtot,iband,icg,ierr,ikpt,isppol,istwf_k,me
124 : integer :: nband_k,npw_k,offset_cgi,size_wf,spaceworld
125 : real(dp) :: doti,dotr,wtk_k
126 : !arrays
127 : real(dp) :: d3etot_k(2)
128 26 : real(dp),allocatable :: cwavef1(:,:),cwavef2(:,:)
129 26 : real(dp),allocatable :: occ_k(:)
130 :
131 : ! *************************************************************************
132 :
133 : DBG_ENTER("COLL")
134 :
135 : !Init parallelism
136 26 : spaceworld=mpi_enreg%comm_cell
137 26 : me=mpi_enreg%me_kpt
138 :
139 : !Loop over spins
140 26 : d3etot_td=zero
141 26 : bandtot = 0
142 26 : icg=0
143 52 : do isppol = 1, nsppol
144 :
145 : ! Loop over k-points
146 364 : do ikpt = 1, nkpt
147 :
148 312 : nband_k = dtset%nband(ikpt+(isppol-1)*nkpt)
149 312 : npw_k = npwarr(ikpt)
150 312 : istwf_k = dtset%istwfk(ikpt)
151 :
152 312 : if (proc_distrb_cycle(mpi_enreg%proc_distrb,ikpt,1,mband,isppol,mpi_enreg%me)) then
153 0 : bandtot = bandtot + nband_k
154 0 : cycle ! Skip the rest of the k-point loop
155 : end if
156 :
157 936 : ABI_MALLOC(occ_k,(nband_k))
158 13416 : occ_k(:) = occ(1+bandtot:nband_k+bandtot)
159 312 : wtk_k = dtset%wtk(ikpt)
160 :
161 312 : d3etot_k=zero
162 312 : size_wf= dtset%nspinor*npw_k
163 936 : ABI_MALLOC(cwavef1,(2,size_wf))
164 624 : ABI_MALLOC(cwavef2,(2,size_wf))
165 :
166 : !Loop over bands
167 13416 : do iband=1,nband_k
168 :
169 13104 : if(mpi_enreg%proc_distrb(ikpt,iband,isppol) /= mpi_enreg%me_kpt) cycle
170 :
171 : !Select bks wf1
172 13104 : offset_cgi = (iband-1)*size_wf+icg
173 10286640 : cwavef1(:,:)= cg1(:,1+offset_cgi:size_wf+offset_cgi)
174 10286640 : cwavef2(:,:)= cg2(:,1+offset_cgi:size_wf+offset_cgi)
175 :
176 : !Compute the Berry curvature
177 : !< u_{i,k}^{\lambda1} | u_{i,k}^{\lambda2} >
178 : call dotprod_g(dotr,doti,istwf_k,size_wf,2,cwavef1,cwavef2,&
179 13104 : & mpi_enreg%me_g0,mpi_enreg%comm_spinorfft)
180 :
181 13104 : d3etot_k(1)=d3etot_k(1)+occ_k(iband)*dotr
182 13416 : d3etot_k(2)=d3etot_k(2)+occ_k(iband)*doti
183 :
184 : end do !iband
185 :
186 : ! Scale d3etot_k contributions by the kpt weight
187 936 : d3etot_k(:)=d3etot_k(:)*wtk_k
188 :
189 : ! Add the contribution from each k-point.
190 936 : d3etot_td= d3etot_td + d3etot_k
191 :
192 : ! Keep track of total number of bands
193 312 : bandtot = bandtot + nband_k
194 :
195 : ! Shift arrays memory
196 312 : icg=icg+npw_k*dtset%nspinor*nband_k
197 :
198 : ! Deallocations
199 312 : ABI_FREE(cwavef1)
200 312 : ABI_FREE(cwavef2)
201 338 : ABI_FREE(occ_k)
202 :
203 : end do !ikpt
204 :
205 : end do !isppol
206 :
207 : !=== MPI communications ==================
208 : if (xmpi_paral==1) then
209 26 : call xmpi_sum(d3etot_td,spaceworld,ierr)
210 : end if
211 :
212 : DBG_EXIT("COLL")
213 :
214 26 : end subroutine dfpttd_berrycurv
215 : !!***
216 :
217 : end module m_dfpttd_berrycurv
218 : !!***
|
