Branch data 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 : : !!***
|
