Branch data Line data Source code
1 : : !!****m* ABINIT/m_sigma_driver
2 : : !! NAME
3 : : !! m_sigma_driver
4 : : !!
5 : : !! FUNCTION
6 : : !! Calculate the matrix elements of the self-energy operator.
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 1999-2026 ABINIT group (MG, GMR, VO, LR, RWG, MT)
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 : : !! SOURCE
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : module m_sigma_driver
23 : :
24 : : use defs_basis
25 : : use m_gwdefs
26 : : use defs_wvltypes
27 : : use m_xmpi
28 : : use m_xomp
29 : : use m_errors
30 : : use m_abicore
31 : : use m_abi_mixing
32 : : use m_kxc
33 : : use m_distribfft
34 : : use netcdf
35 : : use m_nctk
36 : : use libxc_functionals
37 : : use m_dtfil
38 : : use m_cgtools
39 : :
40 : : use defs_datatypes, only : pseudopotential_type
41 : : use defs_abitypes, only : MPI_type
42 : : use m_time, only : timab
43 : : use m_numeric_tools, only : imax_loc
44 : : use m_fstrings, only : strcat, sjoin, itoa, basename, ktoa, ltoa
45 : : use m_hide_blas, only : xdotc
46 : : use m_io_tools, only : open_file, file_exists, iomode_from_fname
47 : : use m_mpinfo, only : destroy_mpi_enreg, initmpi_seq
48 : : use m_pstat, only : pstat_proc
49 : : use m_dtset, only : dataset_type
50 : : use m_hdr, only : hdr_type
51 : : use m_crystal, only : crystal_t
52 : : use m_geometry, only : normv, mkrdim, metric
53 : : use m_fftcore, only : print_ngfft
54 : : use m_fft_mesh, only : get_gfft, setmesh
55 : : use m_fft, only : fourdp
56 : : use m_ioarr, only : fftdatar_write, read_rhor
57 : : use m_ebands, only : ebands_t, gaps_t
58 : : use m_energies, only : energies_type
59 : : use m_bz_mesh, only : kmesh_t, littlegroup_t, littlegroup_free, isamek, get_ng0sh
60 : : use m_gsphere, only : gsphere_t, merge_and_sort_kg, setshells
61 : : use m_kg, only : getph, getcut
62 : : use m_xcdata, only : get_xclevel
63 : : use m_wfd, only : wfdgw_t, wfdgw_copy, test_charge, wave_t
64 : : use m_vcoul, only : vcoul_t
65 : : use m_qparticles, only : wrqps, rdqps, rdgw, show_QP, updt_m_ks_to_qp
66 : : use m_screening, only : epsm1_t
67 : : use m_ppmodel, only : ppmodel_t
68 : : use m_sigma, only : sigma_t, write_sigma_header
69 : : use m_dyson_solver, only : solve_dyson
70 : : use m_esymm, only : esymm_t, esymm_free
71 : : use m_melemts, only : melflags_t, melements_t
72 : : use m_pawang, only : pawang_type
73 : : use m_pawrad, only : pawrad_type
74 : : use m_pawtab, only : pawtab_type, pawtab_print, pawtab_get_lsize
75 : : use m_paw_an, only : paw_an_type, paw_an_init, paw_an_free, paw_an_nullify
76 : : use m_paw_ij, only : paw_ij_type, paw_ij_init, paw_ij_free, paw_ij_nullify, paw_ij_print
77 : : use m_pawfgrtab, only : pawfgrtab_type, pawfgrtab_init, pawfgrtab_free, pawfgrtab_print
78 : : use m_pawrhoij, only : pawrhoij_type, pawrhoij_alloc, pawrhoij_copy, pawrhoij_free, &
79 : : pawrhoij_inquire_dim, pawrhoij_symrhoij, pawrhoij_unpack
80 : : use m_pawcprj, only : pawcprj_type, pawcprj_alloc, pawcprj_free, paw_overlap
81 : : use m_pawdij, only : pawdij, symdij_all
82 : : use m_pawfgr, only : pawfgr_type, pawfgr_init, pawfgr_destroy
83 : : use m_paw_pwaves_lmn,only : paw_pwaves_lmn_t, paw_pwaves_lmn_init, paw_pwaves_lmn_free
84 : : use m_pawpwij, only : pawpwff_t, pawpwff_init, pawpwff_free
85 : : use m_paw_slater, only : paw_mkdijexc_core, paw_dijhf
86 : : use m_paw_dmft, only : paw_dmft_type
87 : : use m_paw_sphharm, only : setsym_ylm
88 : : use m_paw_mkrho, only : denfgr
89 : : use m_paw_nhat, only : nhatgrid, pawmknhat
90 : : use m_paw_tools, only : chkpawovlp, pawprt
91 : : use m_paw_denpot, only : pawdenpot
92 : : use m_paw_init, only : pawinit, paw_gencond
93 : : use m_pawpsp, only : pawpsp_check_corefile
94 : : use m_classify_bands,only : classify_bands
95 : : use m_wfk, only : wfk_read_eigenvalues
96 : : use m_io_kss, only : make_gvec_kss
97 : : use m_vhxc_me, only : calc_vhxc_me
98 : : use m_cohsex, only : cohsex_me
99 : : use m_sigx, only : calc_sigx_me
100 : : use m_sigc, only : calc_sigc_me
101 : : use m_setvtr, only : setvtr
102 : : use m_mkrho, only : prtrhomxmn
103 : : use m_pspini, only : pspini
104 : : use m_calc_ucrpa, only : calc_ucrpa
105 : : use m_prep_calc_ucrpa,only : prep_calc_ucrpa
106 : : use m_paw_correlations,only : pawpuxinit
107 : : use m_spacepar, only : hartre
108 : : use m_gwrdm, only : calc_rdmx,calc_rdmc,natoccs,update_hdr_bst,print_tot_occ,get_chkprdm,&
109 : : print_chkprdm,change_matrix,print_total_energy,print_band_energies,quadrature_sigma_cw
110 : : use m_plowannier, only : operwan_realspace_type,plowannier_type,init_plowannier,get_plowannier,&
111 : : fullbz_plowannier,init_operwan_realspace,reduce_operwan_realspace,&
112 : : destroy_operwan_realspace,destroy_plowannier,zero_operwan_realspace
113 : : use minimax_grids, only : gx_minimax_grid
114 : :
115 : : implicit none
116 : :
117 : : private
118 : : !!***
119 : :
120 : : public :: sigma
121 : : !!***
122 : :
123 : : contains
124 : : !!***
125 : :
126 : : !!****f* m_sigma_driver/sigma
127 : : !! NAME
128 : : !! sigma
129 : : !!
130 : : !! FUNCTION
131 : : !! Calculate the matrix elements of the self-energy operator.
132 : : !!
133 : : !! INPUTS
134 : : !! acell(3)=length scales of primitive translations (bohr)
135 : : !! codvsn=code version
136 : : !! Dtfil<type(datafiles_type)>=variables related to files
137 : : !! Dtset<type(dataset_type)>=all input variables for this dataset
138 : : !! Pawang<type(pawang_type)>=paw angular mesh and related data
139 : : !! Pawrad(ntypat*usepaw)<type(pawrad_type)>=paw radial mesh and related data
140 : : !! Pawtab(ntypat*usepaw)<type(pawtab_type)>=paw tabulated starting data
141 : : !! Psps<type(pseudopotential_type)>=variables related to pseudopotentials
142 : : !! Before entering the first time in sigma, a significant part of Psps has been initialized :
143 : : !! the integers dimekb,lmnmax,lnmax,mpssang,mpssoang,mpsso,mgrid,ntypat,n1xccc,usepaw,useylm,
144 : : !! and the arrays dimensioned to npsp. All the remaining components of Psps are to be initialized in
145 : : !! the call to pspini. The next time the code enters screening, Psps might be identical to the
146 : : !! one of the previous Dtset, in which case, no reinitialisation is scheduled in pspini.F90.
147 : : !! rprim(3,3)=dimensionless real space primitive translations
148 : : !!
149 : : !! OUTPUT
150 : : !! Output is written on the main abinit output file. Some results are stored in external files
151 : : !!
152 : : !! NOTES
153 : : !!
154 : : !! ON THE USE OF FFT GRIDS:
155 : : !! =================
156 : : !! In case of PAW:
157 : : !! ---------------
158 : : !! Two FFT grids are used:
159 : : !! - A "coarse" FFT grid (defined by ecut) for the application of the Hamiltonian on the plane waves basis.
160 : : !! It is defined by nfft, ngfft, mgfft, ...
161 : : !! Hamiltonian, wave-functions, density related to WFs (rhor here), ... are expressed on this grid.
162 : : !! - A "fine" FFT grid (defined) by ecutdg) for the computation of the density inside PAW spheres.
163 : : !! It is defined by nfftf, ngfftf, mgfftf, ... Total density, potentials, ... are expressed on this grid.
164 : : !! In case of norm-conserving:
165 : : !! ---------------------------
166 : : !! - Only the usual FFT grid (defined by ecut) is used. It is defined by nfft, ngfft, mgfft, ...
167 : : !! For compatibility reasons, (nfftf,ngfftf,mgfftf) are set equal to (nfft,ngfft,mgfft) in that case.
168 : : !!
169 : : !! SOURCE
170 : :
171 : 206 : subroutine sigma(acell,codvsn,Dtfil,Dtset,Pawang,Pawrad,Pawtab,Psps,rprim)
172 : :
173 : : !Arguments ------------------------------------
174 : : !scalars
175 : : character(len=8),intent(in) :: codvsn
176 : : type(Datafiles_type),intent(in) :: Dtfil
177 : : type(Dataset_type),intent(inout) :: Dtset
178 : : type(Pawang_type),intent(inout) :: Pawang
179 : : type(Pseudopotential_type),intent(inout) :: Psps
180 : : !arrays
181 : : real(dp),intent(in) :: acell(3),rprim(3,3)
182 : : type(Pawrad_type),intent(inout) :: Pawrad(Psps%ntypat*Psps%usepaw)
183 : : type(Pawtab_type),intent(inout) :: Pawtab(Psps%ntypat*Psps%usepaw)
184 : :
185 : : !Local variables-------------------------------
186 : : !scalars
187 : : integer,parameter :: tim_fourdp5 = 5, master = 0, cplex1 = 1, ipert0 = 0, idir0 = 0, optrhoij1 = 1, ndat1 = 1
188 : : integer :: approx_type,b1gw,b2gw,cplex,cplex_dij,cplex_rhoij !,band
189 : : integer :: dim_kxcg,gwcalctyp,gnt_option,has_dijU,has_dijso,iab,bmin,bmax,irr_idx1,irr_idx2
190 : : integer :: iat,ib,ib1,ib2,ic,id_required,ider,ii,ik,ierr,ount
191 : : integer :: ik_bz,ikcalc,ik_ibz,ikxc,npw_k,omp_ncpus,pwx,ibz
192 : : integer :: isp,is_idx,istep,itypat,itypatcor,izero,jj,first_band,last_band
193 : : integer :: ks_iv,lcor,lmn2_size_max,mband,my_nband
194 : : integer :: mgfftf,mod10,moved_atm_inside,moved_rhor,n3xccc !,mgfft
195 : : integer :: nbsc,ndij,ndim,nfftf,nfftf_tot,nkcalc,gwc_nfft,gwc_nfftot,gwx_nfft,gwx_nfftot
196 : : integer :: ngrvdw,nhatgrdim,nkxc,nkxc1,nprocs,nscf,nspden_rhoij,nzlmopt,optene
197 : : integer :: optcut,optgr0,optgr1,optgr2,option,option_test,option_dij,optrad,psp_gencond
198 : : integer :: my_rank,rhoxsp_method,comm,use_aerhor,use_umklp,usexcnhat
199 : : integer :: ioe0j,spin,io,jb,nomega_sigc, gw1rdm,x1rdm
200 : : integer :: temp_unt,ncid
201 : : integer :: work_size,nstates_per_proc,my_nbks !, jb_qp,ib_ks,ks_irr
202 : : real(dp) :: compch_fft,compch_sph,r_s,rhoav,alpha
203 : : real(dp) :: drude_plsmf,my_plsmf,ecore,ecut_eff,ecutdg_eff,ehartree
204 : : real(dp) :: etot_sd,etot_mbb,evextnl_energy,ex_energy,gsqcutc_eff,gsqcutf_eff,gsqcut_shp,norm,old_fermie
205 : : real(dp) :: eh_energy,ekin_energy,evext_energy,den_int,coef_hyb,exc_mbb_energy,tol_empty
206 : : real(dp) :: ucvol,vxcavg,vxcavg_qp,el_temp
207 : : real(dp) :: gwc_gsq,gwx_gsq,gw_gsq, gsqcut,boxcut,ecutf
208 : : real(dp) :: eff,mempercpu_mb,max_wfsmem_mb,nonscal_mem,ug_mem,ur_mem,cprj_mem
209 : : complex(dp) :: max_degw,cdummy
210 : : logical :: rdm_update,readchkprdm,prtchkprdm
211 : : logical :: use_paw_aeur,dbg_mode,pole_screening,call_pawinit,is_dfpt=.false.
212 : : character(len=500) :: msg
213 : : character(len=fnlen) :: wfk_fname,pawden_fname,gw1rdm_fname
214 [ + + + + : 5356 : type(kmesh_t) :: Kmesh,Qmesh
+ + + + ]
215 : 412 : type(ebands_t) :: ks_ebands, qp_ebands
216 [ + + + + : 13184 : type(vcoul_t) :: Vcp, Vcp_ks, Vcp_full
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ ]
217 [ + + + + : 10712 : type(crystal_t) :: Cryst
+ + + + +
+ + + + +
+ + + + ]
218 : : type(Energies_type) :: KS_energies,QP_energies
219 [ + + ]: 824 : type(epsm1_t) :: epsm1
220 : 206 : type(gsphere_t) :: Gsph_Max,Gsph_x,Gsph_c
221 : 206 : type(hdr_type) :: Hdr_wfk,Hdr_sigma,Hdr_rhor
222 : : type(melflags_t) :: KS_mflags,QP_mflags
223 : 618 : type(melements_t) :: KS_me, QP_me, GW1RDM_me
224 : 206 : type(MPI_type) :: MPI_enreg_seq
225 : 206 : type(paw_dmft_type) :: Paw_dmft
226 : : type(pawfgr_type) :: Pawfgr
227 : 206 : type(ppmodel_t) :: PPm
228 : 206 : type(sigparams_t) :: Sigp
229 : 206 : type(sigma_t) :: Sr
230 : 206 : type(wfdgw_t),target :: Wfd, Wfdf, Wfd_nato_master
231 : : type(wfdgw_t),pointer :: Wfd_nato_all
232 : : type(wave_t),pointer :: wave
233 : 206 : type(wvl_data) :: Wvl
234 : : !arrays
235 : : integer :: gwc_ngfft(18),ngfftc(18),ngfftf(18),gwx_ngfft(18), units(2)
236 : 206 : integer,allocatable :: sigmak_todo(:)
237 : 206 : integer,allocatable :: nq_spl(:),nlmn_atm(:),my_spins(:)
238 : 412 : integer,allocatable :: tmp_gfft(:,:),ks_vbik(:,:),nband(:,:),l_size_atm(:),qp_vbik(:,:)
239 : 412 : integer,allocatable :: tmp_kstab(:,:,:),ks_irreptab(:,:,:),qp_irreptab(:,:,:),my_band_list(:)
240 : : real(dp),parameter :: k0(3) = zero
241 : : real(dp) :: gmet(3,3),gprimd(3,3),rmet(3,3),rprimd(3,3),strsxc(6),tsec(2)
242 : 618 : real(dp),allocatable :: weights(:),nat_occs(:,:),gw_rhor(:,:),gw_rhog(:,:),gw_vhartr(:)
243 : 412 : real(dp),allocatable :: grchempottn(:,:),grewtn(:,:),grvdw(:,:),qmax(:)
244 : 206 : real(dp),allocatable :: ks_nhat(:,:),ks_nhatgr(:,:,:),ks_rhog(:,:)
245 : 206 : real(dp),allocatable :: ks_rhor(:,:),ks_vhartr(:),ks_vtrial(:,:),ks_vxc(:,:), ks_taur(:,:)
246 : 412 : real(dp),allocatable :: kxc(:,:),qp_kxc(:,:),ph1d(:,:),ph1df(:,:)
247 : 412 : real(dp),allocatable :: prev_rhor(:,:),prev_taur(:,:),qp_nhat(:,:)
248 : 206 : real(dp),allocatable :: qp_nhatgr(:,:,:),qp_rhog(:,:),qp_rhor_paw(:,:)
249 : 206 : real(dp),allocatable :: qp_rhor_n_one(:,:),qp_rhor_nt_one(:,:)
250 : 206 : real(dp),allocatable :: qp_rhor(:,:),qp_vhartr(:),qp_vtrial(:,:),qp_vxc(:,:)
251 : 412 : real(dp),allocatable :: qp_taur(:,:),igwene(:,:,:)
252 : 412 : real(dp),allocatable :: vpsp(:),xccc3d(:),dijexc_core(:,:,:),dij_hf(:,:,:)
253 : 206 : real(dp),allocatable :: nl_bks(:,:,:)
254 : 206 : real(dp),allocatable :: ks_aepaw_rhor(:,:) !,ks_n_one_rhor(:,:),ks_nt_one_rhor(:,:), osoc_bks(:, :, :)
255 : : complex(dp) :: ovlp(2)
256 : 206 : complex(dp),allocatable :: ctmp(:,:),hbare(:,:,:,:)
257 : 206 : complex(dp),target,allocatable :: sigcme(:,:,:,:,:)
258 : 412 : complex(dp),allocatable :: hdft(:,:,:,:),htmp(:,:,:,:),uks2qp(:,:)
259 : 618 : complex(dp),allocatable :: xrdm_k_full(:,:,:), rdm_k(:,:), pot_k(:,:), nateigv(:,:,:,:), old_ks_purex(:,:), new_hartr(:,:)
260 : 412 : complex(gwp),allocatable :: kxcg(:,:),fxc_ADA(:,:,:)
261 : 206 : complex(gwp),contiguous, pointer :: ug1(:)
262 : 412 : complex(dp),allocatable :: sigcme_k(:,:,:,:), rhot1_q_m(:,:,:,:,:,:,:), M1_q_m(:,:,:,:,:,:,:)
263 : 206 : logical,allocatable :: bks_mask(:,:,:),keep_ur(:,:,:),bmask(:), bdm_mask(:,:,:),bdm2_mask(:,:,:)
264 : 206 : type(esymm_t),target,allocatable :: KS_sym(:,:)
265 : 206 : type(esymm_t),pointer :: QP_sym(:,:)
266 : 206 : type(pawcprj_type),allocatable :: Cp1(:,:) !,Cp2(:,:)
267 : 206 : type(littlegroup_t),allocatable :: Ltg_k(:)
268 : 412 : type(Paw_an_type),allocatable :: KS_paw_an(:),QP_paw_an(:)
269 : 412 : type(Paw_ij_type),allocatable :: KS_paw_ij(:),QP_paw_ij(:)
270 : 206 : type(Pawfgrtab_type),allocatable :: Pawfgrtab(:)
271 : 412 : type(Pawrhoij_type),allocatable :: KS_Pawrhoij(:),QP_pawrhoij(:),prev_Pawrhoij(:),tmp_pawrhoij(:)
272 : 206 : type(pawpwff_t),allocatable :: Paw_pwff(:)
273 : 206 : type(paw_pwaves_lmn_t),allocatable :: Paw_onsite(:)
274 : 206 : type(plowannier_type) :: wanbz,wanibz,wanibz_in
275 : 206 : type(operwan_realspace_type), allocatable :: rhot1(:,:)
276 : : !************************************************************************
277 : :
278 : : DBG_ENTER('COLL')
279 : :
280 : 206 : call timab(401,1,tsec) ! sigma(Total)
281 : 206 : call timab(402,1,tsec) ! sigma(Init1)
282 [ + + ]: 618 : units = [std_out, ab_out]
283 : :
284 : : write(msg,'(7a)')&
285 : 206 : ' SIGMA: Calculation of the GW corrections ',ch10,ch10,&
286 : 206 : ' Based on a program developped by R.W. Godby, V. Olevano, G. Onida, and L. Reining.',ch10,&
287 : 412 : ' Incorporated in ABINIT by V. Olevano, G.-M. Rignanese, and M. Torrent.'
288 : 206 : call wrtout(units, msg)
289 : :
290 [ - + ]: 206 : if(dtset%ucrpa>0) then
291 : 0 : write(msg,'(6a)')ch10,' cRPA Calculation: Calculation of the screened Coulomb interaction (ucrpa/=0) ',ch10
292 : 0 : call wrtout(units, msg)
293 : : end if
294 : :
295 : : #if defined HAVE_GW_DPC
296 : : if (gwp /= 8) then
297 : : write(msg,'(6a)')ch10,&
298 : : 'Number of bytes for double precision complex /=8 ',ch10,&
299 : : 'Cannot continue due to kind mismatch in BLAS library ',ch10,&
300 : : 'Some BLAS interfaces are not generated by abilint '
301 : : ABI_ERROR(msg)
302 : : end if
303 : 206 : write(msg,'(a,i2,a)')'.Using double precision arithmetic ; gwpc = ',gwp,ch10
304 : : #else
305 : : write(msg,'(a,i2,a)')'.Using single precision arithmetic ; gwpc = ',gwp,ch10
306 : : #endif
307 : 206 : call wrtout(units, msg)
308 : :
309 : 206 : tol_empty=0.01 ! Initialize the tolerance used to decide if a band is empty (passed to m_sigx.F90)
310 : 206 : gwcalctyp=Dtset%gwcalctyp
311 : 206 : gw1rdm=Dtset%gw1rdm ! Input variable to decide if updates to the 1-RDM must be performed
312 : 206 : x1rdm=Dtset%x1rdm ! Input variable to use pure exchange correction on the 1-RDM ( Sigma_x - Vxc )
313 : 206 : rdm_update=(gwcalctyp==21 .and. gw1rdm>0) ! Input variable to decide whether to update GW density matrix
314 : 206 : readchkprdm=(Dtset%irdchkprdm==1) ! Input variable to decide if checkpoint files must be read
315 : 206 : prtchkprdm=(Dtset%prtchkprdm==1) ! Input variable to decide if checkpoint files must be written
316 : :
317 : 206 : mod10 =MOD(Dtset%gwcalctyp,10)
318 : :
319 : : ! Perform some additional checks for hybrid functional calculations
320 [ + + ]: 206 : if (mod10 == 5) then
321 : : !if (Dtset%ixc_sigma<0 .and. .not.libxc_functionals_check()) then
322 : : ! ABI_ERROR('Hybrid functional calculations require the compilation with LIBXC library')
323 : : !end if
324 : : !XG 20171116 : I do not agree with this condition, as one might like to do a one-shot hybrid functional calculation
325 : : !on top of a LDA/GGA calculation ... give the power (and risks) to the user !
326 : : !if(gwcalctyp<10) then
327 : : ! ABI_ERROR('gwcalctyp requires the update of energies and/or wavefunctions when performing hybrid XC calculations')
328 : : !end if
329 [ - + ]: 35 : if (Dtset%usepaw == 1) then
330 : 0 : ABI_ERROR('PAW version of hybrid functional calculations is not implemented')
331 : : end if
332 : : end if
333 : :
334 : : !=== Initialize MPI variables, and parallelization level ===
335 : : ! gwpara: 1--> parallelism over k-points, 2--> parallelism over bands.
336 : : ! In case of gwpara==1 memory is not parallelized.
337 : : ! If gwpara==2, bands are divided among processors but each proc has all the states where GW corrections are required.
338 : 206 : comm = xmpi_world; my_rank = xmpi_comm_rank(comm); nprocs = xmpi_comm_size(comm)
339 : :
340 [ + + ]: 206 : if (my_rank == master) then
341 : 178 : wfk_fname = dtfil%fnamewffk
342 [ - + ]: 178 : if (nctk_try_fort_or_ncfile(wfk_fname, msg) /= 0) then
343 : 0 : ABI_ERROR(msg)
344 : : end if
345 : : end if
346 : 206 : call xmpi_bcast(wfk_fname, master, comm, ierr)
347 : :
348 : : ! === Some variables need to be initialized/nullify at start ===
349 : 206 : usexcnhat = 0
350 : 206 : call KS_energies%init()
351 : 206 : call mkrdim(acell, rprim, rprimd)
352 : 206 : call metric(gmet,gprimd,ab_out,rmet,rprimd,ucvol)
353 : : !
354 : : ! === Define FFT grid(s) sizes ===
355 : : ! Be careful! This mesh is only used for densities, potentials and the matrix elements of v_Hxc. It is NOT the
356 : : ! (usually coarser) GW FFT mesh employed for the oscillator matrix elements that is defined in setmesh.F90.
357 : : ! See also NOTES in the comments at the beginning of this file.
358 : : ! NOTE: This mesh is defined in invars2m using ecutwfn, in GW Dtset%ecut is forced to be equal to Dtset%ecutwfn.
359 : :
360 : : call pawfgr_init(Pawfgr, Dtset, mgfftf, nfftf, ecut_eff, ecutdg_eff, ngfftc, ngfftf, &
361 : 206 : gsqcutc_eff=gsqcutc_eff, gsqcutf_eff=gsqcutf_eff, gmet=gmet, k0=k0)
362 : :
363 : : ! Fake MPI_type for the sequential part.
364 : 206 : call initmpi_seq(MPI_enreg_seq)
365 : 206 : call MPI_enreg_seq%distribfft%init_seq('c',ngfftc(2),ngfftc(3),'all')
366 : 206 : call MPI_enreg_seq%distribfft%init_seq('f',ngfftf(2),ngfftf(3),'all')
367 : :
368 [ + + ]: 412 : call print_ngfft([std_out], ngfftf, header='Dense FFT mesh used for densities and potentials')
369 [ + + ]: 824 : nfftf_tot=PRODUCT(ngfftf(1:3))
370 : :
371 : : ! ===========================================
372 : : ! === Open and read pseudopotential files ===
373 : : ! ===========================================
374 : 206 : call pspini(dtset, dtfil, ecore, psp_gencond, gsqcutc_eff, gsqcutf_eff, pawrad, pawtab, psps, cryst%rprimd, comm_mpi=comm)
375 : :
376 : 206 : call timab(402,2,tsec) ! Init1
377 : : !
378 : : ! ==================================================
379 : : ! ==== Initialize Sigp, epsm1 and basic objects ====
380 : : ! ==================================================
381 : : ! Sigp is completely initialized here.
382 : : ! epsm1 is only initialized with dimensions, (SCR|SUSC) file is read in epsm1%mkdump
383 : 206 : call timab(403,1,tsec) ! setup_sigma
384 : :
385 : : call setup_sigma(codvsn,wfk_fname,acell,rprim,Dtset,Dtfil,Psps,Pawtab,&
386 : 206 : gwx_ngfft,gwc_ngfft,Hdr_wfk,Hdr_sigma,Cryst,Kmesh,Qmesh,ks_ebands,Gsph_Max,Gsph_x,Gsph_c,Vcp,epsm1,Sigp,comm)
387 : :
388 : 206 : call pstat_proc%print(_PSTAT_ARGS_)
389 : :
390 : 206 : call timab(403,2,tsec) ! setup_sigma
391 : 206 : call timab(402,1,tsec) ! Init1
392 : :
393 [ - + ]: 206 : if (nprocs > Sigp%nbnds) then
394 : 0 : write(msg,"(2(a,i0))")"The number of MPI procs: ", nprocs, " is greater than nband: ", sigp%nbnds
395 : 0 : ABI_ERROR(msg)
396 : : end if
397 : :
398 : 206 : pole_screening = .FALSE.
399 [ - + ]: 206 : if (epsm1%fform==2002) then
400 : 0 : pole_screening = .TRUE.
401 : 0 : ABI_WARNING(' EXPERIMENTAL - Using a pole-fit screening!')
402 : : end if
403 : :
404 [ + + ]: 412 : call print_ngfft([std_out], gwc_ngfft, header='FFT mesh for oscillator strengths used for Sigma_c')
405 [ + + ]: 412 : call print_ngfft([std_out], gwx_ngfft, header='FFT mesh for oscillator strengths used for Sigma_x')
406 : :
407 : 206 : b1gw = Sigp%minbdgw; b2gw = Sigp%maxbdgw
408 : :
409 [ + + ]: 824 : gwc_nfftot=PRODUCT(gwc_ngfft(1:3))
410 : : gwc_nfft =gwc_nfftot !no FFT //
411 : :
412 : : gwx_nfftot=PRODUCT(gwx_ngfft(1:3))
413 : : gwx_nfft =gwx_nfftot !no FFT //
414 : :
415 : : ! TRYING TO RECREATE AN "ABINIT ENVIRONMENT"
416 : 206 : KS_energies%e_corepsp=ecore/Cryst%ucvol
417 : :
418 : : ! === Calculate KS occupation numbers and ks_vbk(nkibz,nsppol) ====
419 : : ! * ks_vbk gives the (valence|last Fermi band) index for each k and spin.
420 : : ! * spinmagntarget is passed to fermi.F90 to fix the problem with newocc in case of magnetic metals
421 [ - + + - : 824 : ABI_MALLOC(ks_vbik, (ks_ebands%nkpt, ks_ebands%nsppol))
- + + - +
- + - - +
- + ]
422 [ - + + - : 618 : ABI_MALLOC(qp_vbik, (ks_ebands%nkpt, ks_ebands%nsppol))
- + + - -
+ - + ]
423 : :
424 : : !call ks_ebands%update_occ(Dtset%spinmagntarget,prtvol=0)
425 : 206 : ks_vbik(:,:) = ks_ebands%get_valence_idx()
426 : :
427 : : ! ============================
428 : : ! ==== PAW initialization ====
429 : : ! ============================
430 [ + + ]: 206 : if (dtset%usepaw == 1) then
431 : 7 : call chkpawovlp(cryst%natom, cryst%ntypat, dtset%pawovlp, pawtab, cryst%rmet, cryst%typat, cryst%xred)
432 : :
433 : 7 : cplex_dij = dtset%nspinor; cplex = 1; ndij = 1
434 : :
435 [ - + + - : 56 : ABI_MALLOC(ks_pawrhoij, (cryst%natom))
+ - + - -
+ - + - +
+ + + - -
+ - + - +
- + - + -
+ ]
436 : : call pawrhoij_inquire_dim(cplex_rhoij=cplex_rhoij, nspden_rhoij=nspden_rhoij, &
437 : 7 : nspden=dtset%nspden, spnorb=dtset%pawspnorb, cpxocc=dtset%pawcpxocc)
438 : 7 : call pawrhoij_alloc(ks_pawrhoij, cplex_rhoij, nspden_rhoij, dtset%nspinor, dtset%nsppol, cryst%typat, pawtab=pawtab)
439 : :
440 : : ! Test if we have to call pawinit
441 [ + - + - : 7 : gnt_option = 1; if (dtset%pawxcdev == 2 .or. (dtset%pawxcdev == 1 .and. dtset%positron /= 0)) gnt_option = 2
- + ]
442 : 7 : call paw_gencond(dtset, gnt_option, "test", call_pawinit)
443 : :
444 [ + - - + ]: 7 : if (psp_gencond == 1 .or. call_pawinit) then
445 : 0 : call timab(553, 1, tsec)
446 : 0 : gsqcut_shp = two * abs(dtset%diecut) * dtset%dilatmx**2 / pi**2
447 : : call pawinit(dtset%effmass_free, gnt_option, gsqcut_shp, zero, dtset%pawlcutd, dtset%pawlmix, &
448 : : psps%mpsang, dtset%pawnphi, cryst%nsym, dtset%pawntheta, pawang, pawrad, &
449 : 0 : dtset%pawspnorb, pawtab, dtset%pawxcdev, dtset%ixc, dtset%usepotzero)
450 : 0 : call timab(553,2,tsec)
451 : :
452 : : ! Update internal values
453 : 0 : call paw_gencond(dtset, gnt_option, "save", call_pawinit)
454 : : else
455 [ - + - - ]: 7 : if (pawtab(1)%has_kij ==1) pawtab(1:cryst%ntypat)%has_kij = 2
456 [ - + - - ]: 7 : if (pawtab(1)%has_nabla==1) pawtab(1:cryst%ntypat)%has_nabla = 2
457 : : end if
458 : :
459 [ + + ]: 19 : psps%n1xccc = maxval(pawtab(1:cryst%ntypat)%usetcore)
460 : :
461 : : ! Initialize optional flags in Pawtab to zero
462 : : ! Cannot be done in Pawinit since the routine is called only if some parts are changed
463 [ + + ]: 19 : pawtab(:)%has_nabla = 0
464 [ + + ]: 19 : pawtab(:)%lamb_shielding = zero
465 : :
466 : 7 : call setsym_ylm(gprimd, pawang%l_max-1, cryst%nsym, dtset%pawprtvol, cryst%rprimd, cryst%symrec, pawang%zarot)
467 : :
468 : : ! Initialize and compute data for DFT+U
469 : 7 : Paw_dmft%use_dmft=Dtset%usedmft
470 : : call pawpuxinit(Dtset%dmatpuopt,Dtset%exchmix,Dtset%f4of2_sla,Dtset%f6of2_sla,&
471 : : is_dfpt,Dtset%jpawu,Dtset%lexexch,Dtset%lpawu,dtset%nspinor,Cryst%ntypat,dtset%optdcmagpawu,Pawang,Dtset%pawprtvol,&
472 : 7 : Pawrad,Pawtab,Dtset%upawu,Dtset%usedmft,Dtset%useexexch,Dtset%usepawu,dtset%ucrpa)
473 : :
474 [ + - ]: 7 : if (my_rank == master) call pawtab_print(Pawtab)
475 : :
476 : : ! Get Pawrhoij from the header of the WFK file.
477 : 7 : call pawrhoij_copy(Hdr_wfk%pawrhoij, KS_Pawrhoij)
478 : :
479 : : ! Evaluate form factor of radial part of phi.phj - tphi.tphj.
480 : : ! The q-grid must contain the FFT mesh used for sigma_c and the G-sphere for the exchange part.
481 : : ! We use the FFT mesh for sigma_c since COHSEX and the extrapolar method require oscillator
482 : : ! strengths on the FFT mesh.
483 [ - + + - : 21 : ABI_MALLOC(tmp_gfft,(3, gwc_nfftot))
+ - + - -
+ - + ]
484 : 7 : call get_gfft(gwc_ngfft, k0, gmet, gwc_gsq, tmp_gfft)
485 [ - + ]: 7 : ABI_FREE(tmp_gfft)
486 : :
487 : : ! Set up q-grid, make qmax 20% larger than largest expected.
488 [ - + + - : 21 : ABI_MALLOC(nq_spl, (Psps%ntypat))
+ - + - -
+ - + ]
489 [ - + + - : 21 : ABI_MALLOC(qmax, (Psps%ntypat))
+ - + - -
+ - + ]
490 : 7 : gwx_gsq = Dtset%ecutsigx / (two*pi**2)
491 : 7 : gw_gsq = max(gwx_gsq, gwc_gsq)
492 [ + + ]: 19 : qmax = sqrt(gw_gsq)*1.2d0
493 [ + + ]: 19 : nq_spl = Psps%mqgrid_ff
494 : : ! write(std_out,*)"using nq_spl",nq_spl,"qmax=",qmax
495 : :
496 : 7 : rhoxsp_method = 1 ! Arnaud-Alouani (default in sigma)
497 : : !rhoxsp_method = 2 ! Shiskin-Kresse
498 [ + + ]: 7 : if (dtset%pawoptosc /= 0) rhoxsp_method = dtset%pawoptosc
499 : :
500 [ - + + - : 117 : ABI_MALLOC(paw_pwff, (psps%ntypat))
+ - + - -
+ - + - +
+ + + + +
+ + - - +
- + ]
501 : 7 : call pawpwff_init(paw_pwff, rhoxsp_method, nq_spl, qmax, gmet, pawrad, pawtab, psps)
502 : :
503 [ - + ]: 7 : ABI_FREE(nq_spl)
504 [ - + ]: 7 : ABI_FREE(qmax)
505 : :
506 : : ! Variables/arrays related to the fine FFT grid
507 [ - + + - : 223507 : ABI_CALLOC(ks_nhat, (nfftf, Dtset%nspden))
- + + - +
- + - - +
- + + + +
+ ]
508 : :
509 [ - + + - : 56 : ABI_MALLOC(pawfgrtab, (cryst%natom))
+ - + - -
+ - + - +
+ + + - -
+ - + - +
- + - + -
+ - + -
+ ]
510 : 7 : call pawtab_get_lsize(pawtab, l_size_atm, cryst%natom, cryst%typat)
511 : :
512 : 7 : cplex = 1
513 : 7 : call pawfgrtab_init(Pawfgrtab,cplex,l_size_atm,Dtset%nspden,Dtset%typat)
514 [ - + ]: 7 : ABI_FREE(l_size_atm)
515 : 7 : compch_fft=greatest_real
516 [ + + ]: 19 : usexcnhat = MAXVAL(Pawtab(:)%usexcnhat)
517 : : ! * 0 if Vloc in atomic data is Vbare (Blochl's formulation)
518 : : ! * 1 if Vloc in atomic data is VH(tnzc) (Kresse's formulation)
519 : 7 : call wrtout(std_out, sjoin(' using usexcnhat: ', itoa(usexcnhat)))
520 : : !
521 : : ! Identify parts of the rectangular grid where the density has to be calculated ===
522 : 7 : optcut = 0; optgr0 = Dtset%pawstgylm; optgr1 = 0; optgr2 = 0; optrad = 1 - Dtset%pawstgylm
523 [ - + ]: 7 : if (Dtset%pawcross==1) optrad=1
524 [ - + - - ]: 7 : if (Dtset%xclevel==2.and.usexcnhat>0) optgr1=Dtset%pawstgylm
525 : :
526 : : call nhatgrid(Cryst%atindx1, gmet, Cryst%natom, Cryst%natom, Cryst%nattyp, ngfftf, Cryst%ntypat,&
527 : 7 : optcut, optgr0, optgr1, optgr2, optrad, Pawfgrtab, Pawtab, Cryst%rprimd, Cryst%typat, Cryst%ucvol, Cryst%xred)
528 : :
529 : 28 : call pawfgrtab_print(Pawfgrtab,Cryst%natom,unit=std_out,prtvol=Dtset%pawprtvol)
530 : :
531 : : else
532 [ - + - + ]: 199 : ABI_MALLOC(Paw_pwff, (0))
533 [ - + - + ]: 199 : ABI_MALLOC(Pawfgrtab, (0))
534 : : end if ! End of PAW Initialization
535 : :
536 : : ! Consistency check and additional stuff done only for GW with PAW.
537 [ - + - + ]: 206 : ABI_MALLOC(Paw_onsite, (0))
538 : :
539 [ + + ]: 206 : if (Dtset%usepaw == 1) then
540 [ - + ]: 7 : if (Dtset%ecutwfn < Dtset%ecut) then
541 : : write(msg,"(3a)")&
542 : 0 : " It is highly recommended to use ecutwfn = ecut for GW calculations with PAW since ",ch10,&
543 : 0 : " an excessive truncation of the planewave basis set can lead to unphysical results."
544 : 0 : ABI_WARNING(msg)
545 : : end if
546 : :
547 [ - + ]: 7 : ABI_CHECK(Dtset%useexexch == 0, "LEXX not yet implemented in GW")
548 [ - + ]: 7 : ABI_CHECK(Paw_dmft%use_dmft == 0, "DMFT + GW not available")
549 : :
550 : : ! Optionally read core orbitals from file and calculate $ \<\phi_i|Sigma_x^\core|\phi_j\> $ for the HF decoupling.
551 [ + + ]: 7 : if (Sigp%use_sigxcore == 1) then
552 [ + + ]: 5 : lmn2_size_max=MAXVAL(Pawtab(:)%lmn2_size)
553 [ - + + - : 10 : ABI_MALLOC(dijexc_core,(cplex_dij*lmn2_size_max,ndij,Cryst%ntypat))
- + + - -
+ + - + -
+ - - + -
+ - + ]
554 : :
555 : 2 : call paw_mkdijexc_core(ndij,cplex_dij,lmn2_size_max,Cryst,Pawtab,Pawrad,dijexc_core,Dtset%prtvol,Psps%filpsp)
556 : : end if ! HF decoupling
557 : :
558 [ - + ]: 7 : if (Dtset%pawcross==1) then
559 [ # # # # : 0 : ABI_SFREE(Paw_onsite)
# # # # #
# # # # #
# # ]
560 [ # # # # : 0 : ABI_MALLOC(Paw_onsite,(Cryst%natom))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
561 : : call paw_pwaves_lmn_init(Paw_onsite,Cryst%natom,Cryst%natom,Cryst%ntypat, &
562 : 0 : Cryst%rprimd,Cryst%xcart,Pawtab,Pawrad,Pawfgrtab)
563 : : end if
564 : : end if
565 : :
566 : : ! Allocate these arrays anyway, since they are passed to subroutines.
567 [ + + ]: 206 : if (.not.allocated(ks_nhat)) then
568 [ - + + - : 398 : ABI_MALLOC(ks_nhat, (nfftf, 0))
- + - + -
+ ]
569 : : end if
570 [ + + ]: 206 : if (.not.allocated(dijexc_core)) then
571 [ - + - + ]: 204 : ABI_MALLOC(dijexc_core, (1, 1, 0))
572 : : end if
573 : :
574 : : ! ==================================================
575 : : ! ==== Read KS band structure from the KSS file ====
576 : : ! ==================================================
577 : : !
578 : : ! Initialize Wfd, allocate wavefunctions and precalculate tables to do the FFT using the coarse gwc_ngfft.
579 : 206 : mband=Sigp%nbnds
580 [ - + + - : 1030 : ABI_MALLOC(bks_mask, (mband, Kmesh%nibz, Sigp%nsppol))
- + + - -
+ + - + -
+ - - + -
+ ]
581 [ - + + - : 824 : ABI_MALLOC(keep_ur , (mband, Kmesh%nibz, Sigp%nsppol))
- + + - -
+ + - - +
- + ]
582 [ + + + + : 61808 : keep_ur=.FALSE.; bks_mask=.FALSE.
+ + + + +
+ + + ]
583 : :
584 [ + + ]: 206 : if (rdm_update) then
585 [ - + + - : 20 : ABI_MALLOC(bdm_mask, (mband, Kmesh%nibz, Sigp%nsppol))
- + + - -
+ + - - +
- + ]
586 [ + + + + : 280 : bdm_mask=.FALSE.
+ + ]
587 [ + - ]: 5 : if (my_rank==master) then
588 [ + + + + : 280 : bdm_mask=.TRUE.
+ + ]
589 : : end if
590 [ - + + - : 20 : ABI_MALLOC(bdm2_mask, (mband,Kmesh%nibz,Sigp%nsppol))
- + + - -
+ + - - +
- + ]
591 [ + + + + : 280 : bdm2_mask=.FALSE.
+ + ]
592 : : end if
593 [ - + + - : 824 : ABI_MALLOC(nband,(Kmesh%nibz, Sigp%nsppol))
- + + - +
- + - - +
- + ]
594 [ + + + + ]: 1663 : nband=mband
595 : :
596 : : ! autoparal section
597 [ - + ]: 206 : if (dtset%max_ncpus/=0) then
598 : 0 : ount =ab_out
599 : : ! Temporary table needed to estimate memory
600 [ # # # # : 0 : ABI_MALLOC(nlmn_atm,(Cryst%natom))
# # # # #
# # # ]
601 [ # # ]: 0 : if (Dtset%usepaw==1) then
602 [ # # ]: 0 : do iat=1,Cryst%natom
603 : 0 : nlmn_atm(iat)=Pawtab(Cryst%typat(iat))%lmn_size
604 : : end do
605 : : end if
606 : :
607 : 0 : write(ount,'(a)')"--- !Autoparal"
608 : 0 : write(ount,"(a)")'#Autoparal section for Sigma runs.'
609 : 0 : write(ount,"(a)") "info:"
610 : 0 : write(ount,"(a,i0)")" autoparal: ",dtset%autoparal
611 : 0 : write(ount,"(a,i0)")" max_ncpus: ",dtset%max_ncpus
612 : 0 : write(ount,"(a,i0)")" gwpara: ",dtset%gwpara
613 : 0 : write(ount,"(a,i0)")" nkpt: ",dtset%nkpt
614 : 0 : write(ount,"(a,i0)")" nsppol: ",dtset%nsppol
615 : 0 : write(ount,"(a,i0)")" nspinor: ",dtset%nspinor
616 : 0 : write(ount,"(a,i0)")" nbnds: ",Sigp%nbnds
617 : :
618 : 0 : work_size = mband * Kmesh%nibz * Sigp%nsppol
619 : :
620 : : ! Non-scalable memory in Mb i.e. memory that is not distribute with MPI.
621 : 0 : nonscal_mem = (two*gwp*epsm1%npwe**2*epsm1%nomega*(epsm1%mqmem+1)*b2Mb) * 1.1_dp
622 : :
623 : : ! List of configurations.
624 : : ! Assuming an OpenMP implementation with perfect speedup!
625 : 0 : write(ount,"(a)")"configurations:"
626 [ # # ]: 0 : do ii=1,dtset%max_ncpus
627 : 0 : nstates_per_proc = 0
628 : 0 : eff = HUGE(one)
629 : 0 : max_wfsmem_mb = zero
630 : :
631 [ # # ]: 0 : do my_rank=0,ii-1
632 [ # # ]: 0 : call sigma_bksmask(Dtset,Sigp,Kmesh,my_rank,ii,my_spins,bks_mask,keep_ur,ierr)
633 [ # # ]: 0 : ABI_FREE(my_spins)
634 [ # # ]: 0 : if (ierr /= 0) exit
635 [ # # # # : 0 : my_nbks = COUNT(bks_mask)
# # # # ]
636 : 0 : nstates_per_proc = MAX(nstates_per_proc, my_nbks)
637 : 0 : eff = MIN(eff, (one * work_size) / (ii * nstates_per_proc))
638 : :
639 : : ! Memory needed for Fourier components ug.
640 : 0 : ug_mem = two*gwp*Dtset%nspinor*Sigp%npwwfn*my_nbks*b2Mb
641 : : ! Memory needed for real space ur (use gwc_nfft, instead of gwx_nfft)
642 [ # # # # : 0 : ur_mem = two*gwp*Dtset%nspinor*gwc_nfft*COUNT(keep_ur)*b2Mb
# # # # ]
643 : : ! Memory needed for PAW projections Cprj
644 : 0 : cprj_mem = zero
645 [ # # # # ]: 0 : if (Dtset%usepaw==1) cprj_mem = dp*Dtset%nspinor*SUM(nlmn_atm)*my_nbks*b2Mb
646 : 0 : max_wfsmem_mb = MAX(max_wfsmem_mb, ug_mem + ur_mem + cprj_mem)
647 : : end do
648 [ # # ]: 0 : if (ierr /= 0) cycle
649 : :
650 : : ! Add the non-scalable part and increase by 10% to account for other datastructures.
651 : 0 : mempercpu_mb = (max_wfsmem_mb + nonscal_mem) * 1.1_dp
652 [ # # ]: 0 : do omp_ncpus=1,xomp_get_max_threads()
653 : 0 : write(ount,"(a,i0)")" - tot_ncpus: ",ii * omp_ncpus
654 : 0 : write(ount,"(a,i0)")" mpi_ncpus: ",ii
655 : 0 : write(ount,"(a,i0)")" omp_ncpus: ",omp_ncpus
656 : 0 : write(ount,"(a,f12.9)")" efficiency: ",eff
657 : 0 : write(ount,"(a,f12.2)")" mem_per_cpu: ",mempercpu_mb
658 : : end do
659 : : end do
660 : 0 : write(ount,'(a)')"..."
661 : :
662 [ # # ]: 0 : ABI_FREE(nlmn_atm)
663 : 0 : ABI_ERROR_NODUMP("aborting now")
664 : :
665 : : else
666 [ - + ]: 206 : call sigma_bksmask(Dtset,Sigp,Kmesh,my_rank,nprocs,my_spins,bks_mask,keep_ur,ierr)
667 [ - + ]: 206 : ABI_CHECK(ierr==0, "Error in sigma_bksmask")
668 : : end if
669 : :
670 : : ! Each core stores the wavefunctions where GW corrections are required.
671 [ + + ]: 416 : do isp=1,SIZE(my_spins)
672 : 210 : spin = my_spins(isp)
673 [ + + ]: 1068 : do ikcalc=1,Sigp%nkptgw
674 : 652 : ik_ibz=Kmesh%tab(Sigp%kptgw2bz(ikcalc)) ! Irred k-point for GW
675 : 652 : ii=Sigp%minbnd(ikcalc,spin); jj=Sigp%maxbnd(ikcalc,spin)
676 [ + + ]: 6117 : bks_mask(ii:jj,ik_ibz,spin) = .TRUE.
677 [ + + + + ]: 6178 : if (MODULO(Dtset%gwmem,10)==1) keep_ur(ii:jj,ik_ibz,spin)=.TRUE.
678 : : end do
679 : : end do
680 : :
681 [ - + ]: 206 : ABI_FREE(my_spins)
682 : :
683 : : call wfd%init(Cryst,Pawtab,Psps,keep_ur,mband,nband,Kmesh%nibz,Sigp%nsppol,bks_mask,&
684 : : Dtset%nspden,Dtset%nspinor,Dtset%ecutwfn,Dtset%ecutsm,Dtset%dilatmx,Hdr_wfk%istwfk,Kmesh%ibz,gwc_ngfft,&
685 : 206 : Dtset%nloalg,Dtset%prtvol,Dtset%pawprtvol,comm,use_fnl_dir0der0=(Dtset%gw1rdm==2))
686 : :
687 : : ! MRM: also initialize the Wfd_nato_master for GW 1-RDM if required.
688 : : ! Warning, this should be replaced by copy but copy fails due to bands being allocated in different manners.
689 : : ! FIXME: Do it in the future!
690 [ + + ]: 206 : if (rdm_update) then
691 [ + - + - : 285 : bdm2_mask=bks_mask ! As bks_mask is going to be removed, save it in bdm2_mask to use it in Evext_nl
+ - - + -
- + + + +
+ + ]
692 : : call Wfd_nato_master%init(Cryst,Pawtab,Psps,keep_ur,mband,nband,Kmesh%nibz,Sigp%nsppol,bdm_mask,&
693 : : Dtset%nspden,Dtset%nspinor,Dtset%ecutwfn,Dtset%ecutsm,Dtset%dilatmx,Hdr_wfk%istwfk,Kmesh%ibz,gwc_ngfft,&
694 : 5 : Dtset%nloalg,Dtset%prtvol,Dtset%pawprtvol,xmpi_comm_self)!comm) ! MPI_COMM_SELF
695 : 5 : call Wfd_nato_master%read_wfk(wfk_fname,iomode_from_fname(wfk_fname))
696 : : end if
697 : :
698 : 206 : call timab(402,2,tsec) ! sigma(Init1)
699 : 206 : call timab(404,1,tsec) ! rdkss
700 : :
701 : 206 : call wfd%read_wfk(wfk_fname, iomode_from_fname(wfk_fname))
702 : : ! This test has been disabled (too expensive!)
703 : : if (.False.) call wfd%test_ortho(Cryst,Pawtab,unit=ab_out,mode_paral="COLL")
704 : :
705 [ + - - + ]: 206 : if (Dtset%pawcross==1 .or. dtset%userie == 456) then
706 : : call Wfdf%init(Cryst,Pawtab,Psps,keep_ur,mband,nband,Kmesh%nibz,Sigp%nsppol,bks_mask,&
707 : : Dtset%nspden,Dtset%nspinor,dtset%ecutwfn,Dtset%ecutsm,Dtset%dilatmx,Hdr_wfk%istwfk,Kmesh%ibz,gwc_ngfft,&
708 : 0 : Dtset%nloalg,Dtset%prtvol,Dtset%pawprtvol,comm)
709 [ # # ]: 0 : if (dtset%userie == 456) then
710 : 0 : call wrtout(std_out, "Reading states from supercell WFK file")
711 : 0 : call wfdf%read_wfk("SC_WFK", iomode_from_fname("SC_WFK"))
712 : : else
713 : 0 : call wfdgw_copy(Wfd, Wfdf)
714 : : end if
715 : 0 : call wfdf%change_ngfft(Cryst, Psps, ngfftf)
716 [ # # ]: 0 : if (dtset%userie == 456) call wfdf%print(units, "UNPERTURBED WFDF for GWTPT")
717 : : end if
718 : :
719 : 206 : call pstat_proc%print(_PSTAT_ARGS_)
720 : 206 : call timab(404,2,tsec) ! rdkss
721 : 206 : call timab(405,1,tsec) ! Init2
722 : :
723 [ - + ]: 206 : ABI_FREE(bks_mask)
724 [ - + ]: 206 : ABI_FREE(nband)
725 [ - + ]: 206 : ABI_FREE(keep_ur)
726 : :
727 : : ! ==============================================================
728 : : ! ==== Find little group of the k-points for GW corrections ====
729 : : ! ==============================================================
730 : : ! The little group is used only if symsigma == 1
731 : : ! If use_umklp == 1 then symmetries requiring an umklapp to preserve k_gw are included as well.
732 [ - + + - : 1262 : ABI_MALLOC(Ltg_k, (Sigp%nkptgw))
+ - + - -
+ - + + +
+ - - + -
+ - + - +
- + - + -
+ - + - +
- + - + ]
733 : 206 : use_umklp = 1
734 [ + + ]: 850 : do ikcalc=1,Sigp%nkptgw
735 [ + + ]: 850 : if (Sigp%symsigma /= 0) call Ltg_k(ikcalc)%init(Sigp%kptgw(:,ikcalc), Qmesh%nbz, Qmesh%bz, Cryst, use_umklp, npwe=0)
736 : : end do
737 : :
738 : : ! Compute structure factor phases and large sphere cut-off
739 [ + - - + : 618 : ABI_MALLOC(ph1d,(2, 3 * (2 * Dtset%mgfft + 1) * Cryst%natom))
+ - + - +
- - + - +
- + ]
740 [ + - - + : 618 : ABI_MALLOC(ph1df,(2, 3 * (2 * mgfftf + 1) * Cryst%natom))
+ - + - +
- - + - +
- + ]
741 : :
742 : 206 : call getph(Cryst%atindx,Cryst%natom,ngfftc(1),ngfftc(2),ngfftc(3),ph1d,Cryst%xred)
743 : :
744 [ + + + + ]: 206 : if (Psps%usepaw == 1.and. Pawfgr%usefinegrid == 1) then
745 : 4 : call getph(Cryst%atindx,Cryst%natom,ngfftf(1),ngfftf(2),ngfftf(3),ph1df,Cryst%xred)
746 : : else
747 [ + + + + ]: 172039 : ph1df(:,:)=ph1d(:,:)
748 : : end if
749 : :
750 : : !===================================================================================
751 : : !==== Classify the GW wavefunctions according to the irreducible representation ====
752 : : !===================================================================================
753 : : !* Warning still under development.
754 : : !* Only for SCGW.
755 : : !bmin=Sigp%minbdgw; bmax=Sigp%maxbdgw
756 : :
757 [ - + + - : 2281 : ABI_MALLOC(KS_sym,(Wfd%nkibz,Wfd%nsppol))
- + + - +
- + - - +
- + + + +
+ + - - +
- + - + -
+ - + - +
- + - + -
- - - - +
- + - + -
- - - - -
- + - - -
- - - - +
- - - - -
- ]
758 : :
759 [ + + - + ]: 206 : if (Sigp%symsigma==1.and.gwcalctyp>=20) then
760 : : ! call check_zarot(Gsph_c%ng,Cryst,gwc_ngfft,Gsph_c%gvec,Psps,Pawang,Gsph_c%rottb,Gsph_c%rottbm1)
761 : 0 : use_paw_aeur=.FALSE. ! should pass ngfftf but the dense mesh is not forced to be symmetric
762 [ # # ]: 0 : do spin=1,Wfd%nsppol
763 [ # # ]: 0 : do ikcalc=1,Sigp%nkptgw
764 : 0 : ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc))
765 : 0 : first_band = Sigp%minbnd(ikcalc,spin)
766 : 0 : last_band = Sigp%maxbnd(ikcalc,spin)
767 : : call classify_bands(Wfd,use_paw_aeur,first_band,last_band,ik_ibz,spin,Wfd%ngfft,Cryst,ks_ebands,Pawtab,Pawrad,Pawang,Psps,&
768 : 0 : Dtset%tolsym,KS_sym(ik_ibz,spin))
769 : : end do
770 : : end do
771 : : ! Recreate the Sig_ij tables taking advantage of the classification of the bands.
772 : 0 : call sigma_tables(Sigp,Kmesh, esymm=KS_sym)
773 : : end if
774 : :
775 : 206 : call timab(405,2,tsec) ! Init2
776 : 206 : call timab(406,1,tsec) ! make_vhxc
777 : :
778 : : !===========================
779 : : !=== COMPUTE THE DENSITY ===
780 : : !===========================
781 : : ! Evaluate the planewave part (complete charge in case of NC pseudos).
782 [ - + + - : 824 : ABI_MALLOC(ks_rhor, (nfftf, dtset%nspden))
- + + - +
- + - - +
- + ]
783 [ - + + - : 824 : ABI_MALLOC(ks_taur, (nfftf, dtset%nspden * dtset%usekden))
+ - - - +
- - + - +
- + ]
784 : :
785 : 206 : call wfd%mkrho(cryst, psps, ks_ebands, ngfftf, nfftf, ks_rhor)
786 : :
787 [ + + + - : 206 : if ((rdm_update .and. Dtset%prtden /= 0) .and. Wfd%my_rank == master) then
+ - ]
788 : : ! Print initial (KS) density file as read (useful to compare DEN files, cubes, etc.)
789 : 5 : gw1rdm_fname = trim(dtfil%fnameabo_ks_den) ! and used on Sigma grids
790 : : call fftdatar_write("density",gw1rdm_fname,dtset%iomode,hdr_sigma,&
791 : 5 : Cryst,ngfftf,cplex1,nfftf,dtset%nspden,ks_rhor,mpi_enreg_seq,ebands=ks_ebands)
792 : : end if
793 : :
794 [ - + ]: 206 : if (Dtset%usekden == 1) call wfd%mkrho(cryst, psps, ks_ebands, ngfftf, nfftf, ks_taur, optcalc=1)
795 : :
796 : : !========================================
797 : : !==== Additional computation for PAW ====
798 : : !========================================
799 : 206 : nhatgrdim = 0
800 [ + + ]: 206 : if (Dtset%usepaw==1) then
801 : : ! Get electronic temperature from dtset
802 [ - + - - : 7 : el_temp=merge(dtset%tphysel,dtset%tsmear,dtset%tphysel>tol8.and.dtset%occopt/=3.and.dtset%occopt/=9)
- - ]
803 : : ! Calculate the compensation charge nhat.
804 [ - + ]: 7 : if (Dtset%xclevel==2) nhatgrdim = usexcnhat * Dtset%pawnhatxc
805 : 7 : cplex = 1; ider = 2 * nhatgrdim; izero = 0
806 [ - + ]: 7 : if (nhatgrdim > 0) then
807 [ # # # # : 0 : ABI_MALLOC(ks_nhatgr,(nfftf,Dtset%nspden,3*nhatgrdim))
# # # # #
# # # # #
# # # # #
# # # ]
808 : : end if
809 [ + - ]: 7 : if (nhatgrdim == 0) then
810 [ - + - + ]: 7 : ABI_MALLOC(ks_nhatgr,(0,0,0))
811 : : end if
812 : :
813 : : call pawmknhat(compch_fft,cplex,ider,idir0,ipert0,izero,Cryst%gprimd,&
814 : : Cryst%natom,Cryst%natom,nfftf,ngfftf,nhatgrdim,Dtset%nspden,Cryst%ntypat,Pawang,&
815 : : Pawfgrtab,ks_nhatgr,ks_nhat,KS_Pawrhoij,KS_Pawrhoij,Pawtab,k0,Cryst%rprimd,&
816 : 7 : Cryst%ucvol,dtset%usewvl,Cryst%xred)
817 : :
818 : : ! === Evaluate onsite energies, potentials, densities ===
819 : : ! * Initialize variables/arrays related to the PAW spheres.
820 : : ! * Initialize also lmselect (index of non-zero LM-moments of densities).
821 [ - + + - : 56 : ABI_MALLOC(KS_paw_ij, (Cryst%natom))
+ - + - -
+ - + - +
+ + + - -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ ]
822 [ - + ]: 7 : has_dijso = Dtset%pawspnorb; has_dijU = merge(0, 1, Dtset%usepawu == 0)
823 : :
824 : 7 : call paw_ij_nullify(KS_paw_ij)
825 : : call paw_ij_init(KS_paw_ij,cplex,Dtset%nspinor,Dtset%nsppol,&
826 : : Dtset%nspden,Dtset%pawspnorb,Cryst%natom,Cryst%ntypat,Cryst%typat,Pawtab,&
827 : : has_dij=1,has_dijhartree=1,has_dijhat=1,has_dijxc=1,has_dijxc_hat=1,has_dijxc_val=1,&
828 : 7 : has_dijso=has_dijso,has_dijU=has_dijU,has_exexch_pot=1,has_pawu_occ=1)
829 : :
830 : 7 : nkxc1 = 0
831 [ - + + - : 56 : ABI_MALLOC(KS_paw_an, (Cryst%natom))
+ - + - -
+ - + - +
+ + + - -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
832 : 7 : call paw_an_nullify(KS_paw_an)
833 : : call paw_an_init(KS_paw_an,Cryst%natom,Cryst%ntypat,nkxc1,0,Dtset%nspden,&
834 : 7 : cplex,Dtset%pawxcdev,Cryst%typat,Pawang,Pawtab,has_vxc=1,has_vxcval=1)
835 : :
836 : : ! Calculate onsite vxc with and without core charge.
837 : 7 : nzlmopt=-1; option=0; compch_sph=greatest_real
838 : : call pawdenpot(compch_sph,el_temp,Cryst%gprimd,ipert0,Dtset%ixc,Cryst%natom,Cryst%natom,Dtset%nspden,&
839 : : Cryst%ntypat,Dtset%nucdipmom,nzlmopt,option,KS_Paw_an,KS_Paw_an,KS_energies%paw,KS_paw_ij,&
840 : : Pawang,Dtset%pawprtvol,Pawrad,KS_Pawrhoij,Dtset%pawspnorb,Pawtab,Dtset%pawxcdev,&
841 : 7 : Dtset%spnorbscl,Dtset%xclevel,Dtset%xc_denpos,Dtset%xc_taupos,Cryst%xred,Cryst%ucvol,Psps%znuclpsp,Dtset%spinaxis)
842 : :
843 : : else
844 [ - + - + ]: 199 : ABI_MALLOC(ks_nhatgr, (0, 0, 0))
845 [ - + - + ]: 199 : ABI_MALLOC(KS_paw_ij, (0))
846 [ - + - + ]: 199 : ABI_MALLOC(KS_paw_an, (0))
847 : : end if ! PAW
848 : :
849 : : call test_charge(nfftf,ks_ebands%nelect,Dtset%nspden,ks_rhor,Cryst%ucvol,&
850 : 206 : Dtset%usepaw,usexcnhat,Pawfgr%usefinegrid,compch_sph,compch_fft,drude_plsmf)
851 : :
852 : : ! For PAW, add the compensation charge on the FFT mesh, then get rho(G).
853 [ + + - + : 223692 : if (Dtset%usepaw==1) ks_rhor = ks_rhor + ks_nhat
+ + + + ]
854 : :
855 : 206 : call prtrhomxmn(std_out,MPI_enreg_seq,nfftf,ngfftf,Dtset%nspden,1,ks_rhor,ucvol=ucvol)
856 [ - + ]: 206 : if (Dtset%usekden==1) call prtrhomxmn(std_out,MPI_enreg_seq,nfftf,ngfftf,Dtset%nspden,1,ks_taur,optrhor=1,ucvol=ucvol)
857 : :
858 : : ! FFT n(r) --> n(g)
859 [ - + + - : 618 : ABI_MALLOC(ks_rhog, (2, nfftf))
+ - + - -
+ - + ]
860 : 206 : call fourdp(1, ks_rhog, ks_rhor(:,1),-1, MPI_enreg_seq, nfftf, 1, ngfftf, tim_fourdp5)
861 : :
862 : : ! The following steps have been gathered in the setvtr routine:
863 : : ! - get Ewald energy and Ewald forces
864 : : ! - compute local ionic pseudopotential vpsp
865 : : ! - eventually compute 3D core electron density xccc3d
866 : : ! - eventually compute vxc and vhartr
867 : : ! - set up ks_vtrial
868 : : !
869 : : !*******************************************************************
870 : : !**** NOTE THAT HERE Vxc CONTAINS THE CORE-DENSITY CONTRIBUTION ****
871 : : !*******************************************************************
872 : :
873 : 206 : ngrvdw = 0
874 [ - + ]: 206 : ABI_MALLOC(grvdw, (3, ngrvdw))
875 [ - + + - : 618 : ABI_MALLOC(grchempottn, (3, Cryst%natom))
+ - + - -
+ - + ]
876 [ - + + - : 412 : ABI_MALLOC(grewtn, (3, Cryst%natom))
- + - + ]
877 : 206 : nkxc = 0
878 [ + + ]: 206 : if (Dtset%nspden == 1) nkxc = 2
879 [ + + ]: 206 : if (Dtset%nspden >= 2) nkxc = 3 ! check GGA and spinor, quite a messy part!!!
880 : : ! In case of MGGA, fxc and kxc are not available and we dont need them in sigma (for now ...)
881 [ + + - + ]: 206 : if (Dtset%ixc < 0 .and. libxc_functionals_ismgga()) nkxc = 0
882 [ + - ]: 206 : if (nkxc /= 0) then
883 [ - + + - : 824 : ABI_MALLOC(kxc, (nfftf, nkxc))
- + + - +
- + - - +
- + ]
884 : : end if
885 : :
886 [ + + ]: 206 : n3xccc = 0; if (Psps%n1xccc /= 0) n3xccc = nfftf
887 [ + + + - : 618 : ABI_MALLOC(xccc3d, (n3xccc))
+ - + + -
+ - + ]
888 [ - + + - : 618 : ABI_MALLOC(ks_vhartr, (nfftf))
+ - + - -
+ - + ]
889 [ - + + - : 824 : ABI_MALLOC(ks_vtrial, (nfftf, Dtset%nspden))
- + + - +
- + - - +
- + ]
890 [ - + + - : 412 : ABI_MALLOC(vpsp, (nfftf))
- + - + ]
891 [ - + + - : 618 : ABI_MALLOC(ks_vxc, (nfftf, Dtset%nspden))
- + + - -
+ - + -
+ ]
892 : :
893 : 206 : optene = 4; moved_atm_inside = 0; moved_rhor = 0; istep = 1
894 : :
895 : : call setvtr(Cryst%atindx1,Dtset,KS_energies,gmet,gprimd,grchempottn,grewtn,grvdw,gsqcutf_eff,&
896 : : istep,kxc,mgfftf,moved_atm_inside,moved_rhor,MPI_enreg_seq,&
897 : : Cryst%nattyp,nfftf,ngfftf,ngrvdw,ks_nhat,ks_nhatgr,nhatgrdim,nkxc,Cryst%ntypat,Psps%n1xccc,n3xccc,&
898 : : optene,Pawang,Pawrad,KS_Pawrhoij,Pawtab,ph1df,Psps,ks_rhog,ks_rhor,Cryst%rmet,Cryst%rprimd,strsxc,&
899 : 206 : Cryst%ucvol,usexcnhat,ks_vhartr,vpsp,ks_vtrial,ks_vxc,vxcavg,Wvl,xccc3d,Cryst%xred,taur=ks_taur)
900 : :
901 : : !============================
902 : : !==== Compute KS PAW Dij ====
903 : : !============================
904 [ + + ]: 206 : if (Dtset%usepaw == 1) then
905 : 7 : call timab(561,1,tsec)
906 : :
907 : : ! Calculate the unsymmetrized Dij.
908 : : call pawdij(cplex,Dtset%enunit,Cryst%gprimd,ipert0,&
909 : : Cryst%natom,Cryst%natom,nfftf,ngfftf(1)*ngfftf(2)*ngfftf(3),&
910 : : Dtset%nspden,Cryst%ntypat,KS_paw_an,KS_paw_ij,Pawang,Pawfgrtab,&
911 : : Dtset%pawprtvol,Pawrad,KS_Pawrhoij,Dtset%pawspnorb,Pawtab,Dtset%pawxcdev,&
912 : : k0,Dtset%spnorbscl,Cryst%ucvol,dtset%cellcharge(1),&
913 : : ks_vtrial,ks_vxc,Cryst%xred,Dtset%znucl,&
914 : 7 : nucdipmom=Dtset%nucdipmom,spinaxis=Dtset%spinaxis)
915 : :
916 : : ! Symmetrize KS Dij
917 : : call symdij_all(Cryst%gprimd,Cryst%indsym,ipert0,&
918 : : Cryst%natom,Cryst%natom,Cryst%nsym,Cryst%ntypat,KS_paw_ij,Pawang,&
919 : 7 : Dtset%pawprtvol,Pawtab,Cryst%rprimd,Cryst%symafm,Cryst%symrec)
920 : :
921 : : ! Output the pseudopotential strengths Dij and the augmentation occupancies Rhoij.
922 : 7 : call pawprt(Dtset,Cryst%natom,KS_paw_ij,KS_Pawrhoij,Pawtab)
923 : 7 : call timab(561,2,tsec)
924 : : end if
925 : :
926 : 206 : call timab(406,2,tsec) ! make_vhxc
927 : :
928 : : !=== Calculate Vxc(b1,b2,k,s)=<b1,k,s|v_{xc}|b2,k,s> for all the states included in GW ===
929 : : ! * This part is parallelized within wfd%comm since each node has all GW wavefunctions.
930 : : ! * Note that vH matrix elements are calculated using the true uncutted interaction.
931 : 206 : call timab(407,1,tsec) ! vHxc_me
932 : :
933 : 206 : call KS_mflags%reset()
934 [ + + ]: 206 : if (rdm_update) then
935 : 5 : KS_mflags%has_hbare=1
936 : 5 : KS_mflags%has_kinetic=1
937 : : end if
938 : 206 : KS_mflags%has_vhartree=1
939 : 206 : KS_mflags%has_vxc =1
940 : 206 : KS_mflags%has_vxcval =1
941 [ - + ]: 206 : if (Dtset%usepawu /= 0 ) KS_mflags%has_vu = 1
942 [ - + ]: 206 : if (Dtset%useexexch /= 0) KS_mflags%has_lexexch= 1
943 [ + + ]: 206 : if (Sigp%use_sigxcore == 1) KS_mflags%has_sxcore = 1
944 [ + + ]: 206 : if (gwcalctyp<10 ) KS_mflags%only_diago = 1 ! off-diagonal elements only for SC on wavefunctions.
945 : :
946 : : if (.FALSE.) then ! quick and dirty hack to test HF contribution.
947 : : ABI_WARNING("testing on-site HF")
948 : : lmn2_size_max=MAXVAL(Pawtab(:)%lmn2_size)
949 : : ABI_MALLOC(dij_hf,(cplex_dij*lmn2_size_max,ndij,Cryst%natom))
950 : : call paw_dijhf(ndij,cplex_dij,1,lmn2_size_max,Cryst%natom,Cryst%ntypat,Pawtab,Pawrad,Pawang,&
951 : : KS_Pawrhoij,dij_hf,Dtset%prtvol)
952 : :
953 : : do iat=1,Cryst%natom
954 : : itypat = Cryst%typat(iat)
955 : : ii = Pawtab(itypat)%lmn2_size
956 : : KS_Paw_ij(iat)%dijxc(:,:) = dij_hf(1:cplex_dij*ii,:,iat)
957 : : KS_Paw_ij(iat)%dijxc_hat(:,:) = zero
958 : : end do
959 : : ABI_FREE(dij_hf)
960 : :
961 : : !option_dij=3
962 : : !call symdij(Cryst%gprimd,Cryst%indsym,ipert0,&
963 : : !& Cryst%natom,Cryst%nsym,Cryst%ntypat,option_dij,&
964 : : !& KS_paw_ij,Pawang,Dtset%pawprtvol,Pawtab,Cryst%rprimd,&
965 : : !& Cryst%symafm,Cryst%symrec)
966 : : end if
967 : :
968 [ - + + - : 824 : ABI_MALLOC(tmp_kstab, (2, Wfd%nkibz, Wfd%nsppol))
- + + - +
- + - - +
- + ]
969 [ + + + + : 4157 : tmp_kstab=0
+ + ]
970 [ + + ]: 416 : do spin=1,Sigp%nsppol
971 [ + + ]: 1068 : do ikcalc=1,Sigp%nkptgw ! No spin dependent!
972 : 652 : ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc))
973 : 652 : tmp_kstab(1, ik_ibz, spin) = Sigp%minbnd(ikcalc, spin)
974 : 862 : tmp_kstab(2, ik_ibz, spin) = Sigp%maxbnd(ikcalc, spin)
975 : : end do
976 : : end do
977 : :
978 [ - + ]: 206 : if (dtset%userie == 456) then
979 : 0 : call wrtout(std_out, "Computing KS vxc matrix elements using supercell WFK file")
980 : : call calc_vhxc_me(Wfdf, KS_mflags, KS_me, Cryst, Dtset, nfftf, ngfftf, &
981 : : ks_vtrial, ks_vhartr, ks_vxc, Psps, Pawtab, KS_paw_an, Pawang, Pawfgrtab, KS_paw_ij, dijexc_core, &
982 : 0 : ks_rhor, usexcnhat, ks_nhat, ks_nhatgr, nhatgrdim, tmp_kstab, taur=ks_taur)
983 : : else
984 : :
985 : : call calc_vhxc_me(Wfd, KS_mflags, KS_me, Cryst, Dtset, nfftf, ngfftf, &
986 : : ks_vtrial, ks_vhartr, ks_vxc, Psps, Pawtab, KS_paw_an, Pawang, Pawfgrtab, KS_paw_ij, dijexc_core, &
987 : 206 : ks_rhor, usexcnhat, ks_nhat, ks_nhatgr, nhatgrdim, tmp_kstab, taur=ks_taur)
988 : : end if
989 [ - + ]: 206 : ABI_FREE(tmp_kstab)
990 : :
991 : : ! Set KS matrix elements connecting different irreps to zero. Do not touch unknown bands!.
992 [ + + - + ]: 206 : if (gwcalctyp >= 20 .and. Sigp%symsigma > 0) then
993 : 0 : bmin=Sigp%minbdgw; bmax=Sigp%maxbdgw
994 [ # # # # : 0 : ABI_MALLOC(ks_irreptab,(bmin:bmax,Kmesh%nibz,Sigp%nsppol))
# # # # #
# # # # #
# # # # #
# ]
995 [ # # # # : 0 : ks_irreptab=0
# # ]
996 [ # # ]: 0 : do spin=1,Sigp%nsppol
997 [ # # ]: 0 : do ikcalc=1,Sigp%nkptgw
998 : 0 : ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc))
999 : 0 : first_band = Sigp%minbnd(ikcalc,spin)
1000 : 0 : last_band = Sigp%maxbnd(ikcalc,spin)
1001 [ # # ]: 0 : if (.not. KS_sym(ik_ibz,spin)%failed()) then
1002 [ # # ]: 0 : ks_irreptab(first_band:last_band,ik_ibz,spin) = KS_sym(ik_ibz,spin)%b2irrep(first_band:last_band)
1003 : : !ks_irreptab(bmin:bmax,ik_ibz,spin) = KS_sym(ik_ibz,spin)%b2irrep(bmin:bmax)
1004 : : end if
1005 : : end do
1006 : : end do
1007 : 0 : call KS_me%zero(ks_irreptab)
1008 [ # # ]: 0 : ABI_FREE(ks_irreptab)
1009 : : end if
1010 : :
1011 : 206 : call KS_me%print(header="Matrix elements in the KS basis set", prtvol=Dtset%prtvol)
1012 : :
1013 : : ! If possible, calculate the EXX energy between the frozen core
1014 : : ! and the valence electrons using KS wavefunctions
1015 : : ! MG: Be careful here, since ex_energy is meaningful only if all occupied states are calculated.
1016 [ + + ]: 206 : if (KS_mflags%has_sxcore ==1) then
1017 : : ! TODO
1018 : : !ex_energy = mels_get_exene_core(KS_me,kmesh,ks_ebands)
1019 : 2 : ex_energy=zero
1020 [ + + ]: 4 : do spin=1,Sigp%nsppol
1021 [ + + ]: 26 : do ik=1,Kmesh%nibz
1022 [ + + ]: 169 : do ib=b1gw,b2gw
1023 [ + - ]: 167 : if (Sigp%nsig_ab==1) then
1024 : 145 : ex_energy = ex_energy + half*ks_ebands%occ(ib,ik,spin)*Kmesh%wt(ik)*KS_me%sxcore(ib,ib,ik,spin)
1025 : : else
1026 [ # # ]: 0 : ex_energy = ex_energy + half*ks_ebands%occ(ib,ik,spin)*Kmesh%wt(ik)*SUM(KS_me%sxcore(ib,ib,ik,:))
1027 : : end if
1028 : : end do
1029 : : end do
1030 : : end do
1031 : 2 : write(msg,'(a,2(es16.6,a))')' CORE Exchange energy with KS wavefunctions: ',ex_energy,' Ha ,',ex_energy*Ha_eV,' eV'
1032 : 2 : call wrtout(std_out, msg)
1033 : : end if
1034 : :
1035 : 206 : call timab(407,2,tsec) ! vHxc_me
1036 : 206 : call timab(408,1,tsec) ! hqp_init
1037 : :
1038 : : ! Do not break this coding!
1039 : : ! When gwcalctyp>10, the order of the bands can be exchanged after
1040 : : ! the diagonalization. Therefore, we have to correctly assign the matrix elements to the corresponding
1041 : : ! bands and we cannot skip the following even though it looks useless.
1042 [ + + ]: 206 : if (gwcalctyp >= 10) call wrtout(std_out, ch10//' *************** KS Energies *******************')
1043 : :
1044 : : !=== qp_ebands stores energies and occ. used for the calculation ===
1045 : : ! * Initialize qp_ebands with KS values.
1046 : : ! * In case of SC update qp_ebands using the QPS file.
1047 : 206 : call ks_ebands%copy(qp_ebands)
1048 : :
1049 [ - + + - : 824 : ABI_MALLOC(qp_rhor, (nfftf, Dtset%nspden))
- + + - +
- + - - +
- + ]
1050 [ - + + - : 824 : ABI_MALLOC(qp_taur, (nfftf, Dtset%nspden * Dtset%usekden))
+ - - - +
- - + - +
- + ]
1051 : 206 : QP_sym => KS_sym
1052 : :
1053 [ + + ]: 206 : if (gwcalctyp<10) then
1054 : : ! one-shot GW, just do a copy of the KS density.
1055 [ + - + - : 1159639 : qp_rhor=ks_rhor
- + - - +
+ + + ]
1056 [ - + - - : 130 : if(Dtset%usekden==1)qp_taur=ks_taur
- - - - -
- - - -
- ]
1057 : : QP_sym => KS_sym
1058 : : else
1059 : : ! Self-consistent GW.
1060 : : ! Read the unitary matrix and the QP energies of the previous step from the QPS file.
1061 : 76 : call QP_energies%init()
1062 : 76 : QP_energies%e_corepsp=ecore/Cryst%ucvol
1063 : :
1064 : : ! m_ks_to_qp(ib,jb,k,s) := <\psi_{ib,k,s}^{KS}|\psi_{jb,k,s}^{QP}>
1065 : : ! Initialize the QP amplitudes with KS wavefunctions.
1066 [ - + + - : 456 : ABI_MALLOC(Sr%m_ks_to_qp, (Sigp%nbnds, Sigp%nbnds, Kmesh%nibz, Sigp%nsppol))
- + + - -
+ + - - +
+ - + - +
- - + - +
- + ]
1067 [ + + + + : 73347 : Sr%m_ks_to_qp=czero
+ + + + ]
1068 [ + + ]: 986 : do ib=1,Sigp%nbnds
1069 [ + + + + ]: 7162 : Sr%m_ks_to_qp(ib,ib,:,:)=cone
1070 : : end do
1071 : :
1072 : : ! Now read m_ks_to_qp and update the energies in qp_ebands.
1073 : : ! TODO switch on the renormalization of n in sigma.
1074 [ - + + - : 304 : ABI_MALLOC(prev_rhor, (nfftf, Dtset%nspden))
- + + - +
- + - - +
- + ]
1075 [ - + + - : 304 : ABI_MALLOC(prev_taur, (nfftf, Dtset%nspden*Dtset%usekden))
+ - - - +
- - + - +
- + ]
1076 [ + - - - : 228 : ABI_MALLOC(prev_Pawrhoij, (Cryst%natom*Psps%usepaw))
+ - - + -
+ - + - +
- + - - -
- - - - -
- - - - -
- ]
1077 : :
1078 : : call rdqps(qp_ebands,Dtfil%fnameabi_qps,Dtset%usepaw,Dtset%nspden,1,nscf,&
1079 : 76 : nfftf,ngfftf,Cryst%ucvol,Cryst,Pawtab,MPI_enreg_seq,nbsc,Sr%m_ks_to_qp,prev_rhor,prev_Pawrhoij)
1080 : :
1081 : : !Find the irreps associated to the QP amplitudes starting from the analogous table for the KS states.
1082 : : !bmin=Sigp%minbdgw; bmax=Sigp%maxbdgw
1083 : : !allocate(qp_irreptab(bmin:bmax,Kmesh%nibz,Sigp%nsppol))
1084 : : !qp_irreptab=0
1085 : : !!qp_irreptab=ks_irreptab
1086 : :
1087 : : !do jb_qp=bmin,bmax
1088 : : !do ib_ks=bmin,bmax
1089 : : !if (ABS(Sr%m_ks_to_qp(ib_ks,jb_qp,ik_ibz,spin)) > tol12) then ! jb_qp has same the same character as ib_ks.
1090 : : !ks_irr = ks_irreptab(ib_ks,ib_ks,ik_ibz,spin)
1091 : : !qp_irreptab(jb_qp,jb_qp,ik_ibz,spin) = ks_irr
1092 : : !do ii=bmin,bmax
1093 : : !if (ks_irr == ks_irreptab(ii,ib_ks,ik_ibz,spin)) then
1094 : : !qp_irreptab(jb_qp,ii,ik_ibz,spin) = ks_irr
1095 : : !end if
1096 : : !end do
1097 : : !end if
1098 : : !end do
1099 : : !end do
1100 : :
1101 [ + + + - : 1163604 : if (nscf==0) prev_rhor=ks_rhor
+ - - + -
- + + +
+ ]
1102 [ + + - + : 76 : if (nscf==0 .and. Dtset%usekden==1) prev_taur=ks_taur
- - - - -
- - - - -
- - ]
1103 : :
1104 [ + + + + : 76 : if (nscf>0.and.gwcalctyp>=20.and. wfd%my_rank == master) then
+ + ]
1105 : : ! Print the unitary transformation on std_out.
1106 : 28 : call show_QP(qp_ebands,Sr%m_ks_to_qp,fromb=Sigp%minbdgw,tob=Sigp%maxbdgw,unit=std_out,tolmat=0.001_dp)
1107 : : end if
1108 : :
1109 : : ! Compute QP wfg as linear combination of KS states.
1110 : : ! * Wfd%ug is modified inside calc_wf_qp
1111 : : ! * For PAW, update also the on-site projections.
1112 : : ! * WARNING the first dimension of MPI_enreg MUST be Kmesh%nibz
1113 : : ! TODO here we should use nbsc instead of nbnds
1114 : :
1115 : 76 : call wfd%rotate(Cryst, Sr%m_ks_to_qp)
1116 : :
1117 : : ! Reinit the storage mode of Wfd as ug have been changed ===
1118 : : ! Update also the wavefunctions for GW corrections on each processor
1119 : 76 : call wfd%reset_ur_cprj()
1120 : :
1121 : : ! This test has been disabled (too expensive!)
1122 : : if (.False.) call wfd%test_ortho(Cryst, Pawtab, unit=std_out)
1123 : :
1124 : : ! Compute QP occupation numbers.
1125 : 76 : call wrtout(std_out,'sigma: calculating QP occupation numbers:')
1126 : 76 : call qp_ebands%update_occ(Dtset%spinmagntarget, prtvol=0)
1127 : 76 : qp_vbik(:,:) = qp_ebands%get_valence_idx()
1128 : :
1129 : : ! Calculate the irreducible representations of the new QP amplitdues.
1130 [ + + - + ]: 76 : if (Sigp%symsigma==1.and.gwcalctyp>=20) then
1131 [ # # # # : 0 : ABI_MALLOC(QP_sym,(Wfd%nkibz,Wfd%nsppol))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1132 : 0 : use_paw_aeur=.FALSE. ! should pass ngfftf but the dense mesh is not forced to be symmetric
1133 [ # # ]: 0 : do spin=1,Wfd%nsppol
1134 [ # # ]: 0 : do ikcalc=1,Sigp%nkptgw
1135 : 0 : ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc))
1136 : : ! Quick fix for SCGW+symm TODO fix properly!
1137 : 0 : first_band = Sigp%minbnd(ikcalc,spin)
1138 : 0 : last_band = Sigp%maxbnd(ikcalc,spin)
1139 : : ! first_band = MINVAL(Sigp%minbnd(:,spin))
1140 : : ! last_band = MAXVAL(Sigp%maxbnd(:,spin))
1141 : : ! call classify_bands(Wfd,use_paw_aeur,first_band,last_band,ik_ibz,spin,ngfftf,Cryst,qp_ebands,Pawtab,Pawrad,Pawang,Psps,&
1142 : : call classify_bands(Wfd,use_paw_aeur,first_band,last_band,ik_ibz,spin,Wfd%ngfft,Cryst,qp_ebands,Pawtab,Pawrad,Pawang,Psps,&
1143 : 0 : & Dtset%tolsym,QP_sym(ik_ibz,spin))
1144 : : end do
1145 : : end do
1146 : :
1147 : : ! Recreate the Sig_ij tables taking advantage of the classification of the bands.
1148 [ # # ]: 0 : call sigma_tables(Sigp, Kmesh, esymm=QP_sym)
1149 : : end if
1150 : :
1151 : : ! Compute QP density using the updated wfg.
1152 : 76 : call wfd%mkrho(cryst, psps, qp_ebands, ngfftf, nfftf, qp_rhor)
1153 [ - + ]: 76 : if (Dtset%usekden==1) call wfd%mkrho(cryst, psps, qp_ebands, ngfftf, nfftf, qp_taur, optcalc=1)
1154 : :
1155 : : ! ========================================
1156 : : ! ==== QP self-consistent GW with PAW ====
1157 : : ! ========================================
1158 [ - + ]: 76 : if (Dtset%usepaw==1) then
1159 [ # # # # : 0 : ABI_MALLOC(qp_nhat,(nfftf,Dtset%nspden))
# # # # #
# # # # #
# # ]
1160 [ # # ]: 0 : nhatgrdim=0; if (Dtset%xclevel==2) nhatgrdim=usexcnhat
1161 [ # # # # : 0 : ABI_MALLOC(qp_nhatgr,(nfftf,Dtset%nspden,3*nhatgrdim))
# # # # #
# # # # #
# # # # #
# # # #
# ]
1162 : :
1163 [ # # # # : 0 : ABI_MALLOC(QP_pawrhoij,(Cryst%natom))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1164 [ # # # # : 0 : ABI_MALLOC(QP_paw_ij,(Cryst%natom))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1165 [ # # # # : 0 : ABI_MALLOC(QP_paw_an,(Cryst%natom))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1166 : :
1167 : : ! Calculate new QP quantities: nhat, nhatgr, rho_ij, paw_ij, and paw_an.
1168 : : call paw_qpscgw(Wfd,nscf,nfftf,ngfftf,Dtset,Cryst,Kmesh,Psps,qp_ebands,&
1169 : : Pawang,Pawrad,Pawtab,Pawfgrtab,prev_Pawrhoij,&
1170 : 0 : QP_pawrhoij,QP_paw_ij,QP_paw_an,QP_energies,qp_nhat,nhatgrdim,qp_nhatgr,compch_sph,compch_fft)
1171 : : else
1172 [ - + ]: 76 : ABI_MALLOC(qp_nhat, (0, 0))
1173 [ - + - + ]: 76 : ABI_MALLOC(qp_nhatgr, (0, 0, 0))
1174 [ - + - + ]: 76 : ABI_MALLOC(QP_pawrhoij, (0))
1175 [ - + - + ]: 76 : ABI_MALLOC(QP_paw_ij, (0))
1176 [ - + - + ]: 76 : ABI_MALLOC(QP_paw_an, (0))
1177 : : end if
1178 : :
1179 : : ! here I should renormalize the density
1180 : : call test_charge(nfftf,ks_ebands%nelect,Dtset%nspden,qp_rhor,Cryst%ucvol,&
1181 : 76 : Dtset%usepaw,usexcnhat,Pawfgr%usefinegrid,compch_sph,compch_fft,drude_plsmf)
1182 : :
1183 [ - + - - : 76 : if (Dtset%usepaw==1) qp_rhor(:,:)=qp_rhor(:,:)+qp_nhat(:,:) ! Add the "hat" term.
- - ]
1184 : :
1185 : 76 : call prtrhomxmn(std_out,MPI_enreg_seq,nfftf,ngfftf,Dtset%nspden,1,qp_rhor,ucvol=ucvol)
1186 [ - + ]: 76 : if (Dtset%usekden==1) then
1187 : 0 : call prtrhomxmn(std_out,MPI_enreg_seq,nfftf,ngfftf,Dtset%nspden,1,qp_taur,optrhor=1,ucvol=ucvol)
1188 : : end if
1189 : :
1190 : : ! Simple mixing of the PW density to damp oscillations in the Hartree potential.
1191 [ + + + + ]: 76 : if (nscf>0 .and. (ABS(Dtset%rhoqpmix-one)>tol12) ) then
1192 : 12 : write(msg,'(2a,f6.3)')ch10,' sigma: mixing QP densities using rhoqpmix= ',Dtset%rhoqpmix
1193 : 12 : call wrtout(std_out, msg)
1194 [ + - + - : 92260 : qp_rhor = prev_rhor + Dtset%rhoqpmix*(qp_rhor-prev_rhor)
- + - - +
+ + + ]
1195 [ - + - - : 12 : if(Dtset%usekden==1) qp_taur = prev_taur + Dtset%rhoqpmix*(qp_taur-prev_taur) ! mix taur.
- - - - -
- - - -
- ]
1196 : : end if
1197 : :
1198 [ - + ]: 76 : ABI_FREE(prev_rhor)
1199 [ - + ]: 76 : ABI_FREE(prev_taur)
1200 [ - + - - ]: 76 : if (Psps%usepaw==1.and.nscf>0) call pawrhoij_free(prev_pawrhoij)
1201 [ + - - + : 76 : ABI_FREE(prev_pawrhoij)
- - - - -
- - - - -
- - - + ]
1202 : :
1203 [ - + + - : 228 : ABI_MALLOC(qp_rhog,(2,nfftf))
+ - + - -
+ - + ]
1204 : 76 : call fourdp(1,qp_rhog,qp_rhor(:,1),-1,MPI_enreg_seq,nfftf,1,ngfftf,tim_fourdp5)
1205 : :
1206 : : ! ===========================================
1207 : : ! ==== Optional output of the QP density ====
1208 : : ! ===========================================
1209 [ + - + + ]: 76 : if (Dtset%prtden/=0 .and. wfd%my_rank == master) then
1210 : : call fftdatar_write("qp_rhor",dtfil%fnameabo_qp_den,dtset%iomode,hdr_sigma,&
1211 : 60 : cryst,ngfftf,cplex1,nfftf,dtset%nspden,qp_rhor,mpi_enreg_seq,ebands=qp_ebands)
1212 : : end if
1213 : :
1214 : : ! ===========================================
1215 : : ! === Optional output of the full QP density
1216 : : ! ===========================================
1217 [ - + - - ]: 76 : if (Wfd%usepaw==1.and.Dtset%prtden==2) then
1218 [ # # # # : 0 : ABI_MALLOC(qp_rhor_paw ,(nfftf,Wfd%nspden))
# # # # #
# # # # #
# # ]
1219 [ # # # # : 0 : ABI_MALLOC(qp_rhor_n_one ,(nfftf,Wfd%nspden))
# # # # #
# # # ]
1220 [ # # # # : 0 : ABI_MALLOC(qp_rhor_nt_one,(nfftf,Wfd%nspden))
# # # # #
# # # ]
1221 : :
1222 : : call denfgr(Cryst%atindx1,Cryst%gmet,comm,Cryst%natom,Cryst%natom,Cryst%nattyp,ngfftf,qp_nhat,&
1223 : : Wfd%nspinor,Wfd%nsppol,Wfd%nspden,Cryst%ntypat,Pawfgr,Pawrad,QP_pawrhoij,Pawtab,Dtset%prtvol,&
1224 : 0 : qp_rhor,qp_rhor_paw,qp_rhor_n_one,qp_rhor_nt_one,Cryst%rprimd,Cryst%typat,Cryst%ucvol,Cryst%xred)
1225 : :
1226 [ # # ]: 0 : ABI_FREE(qp_rhor_n_one)
1227 [ # # ]: 0 : ABI_FREE(qp_rhor_nt_one)
1228 : :
1229 [ # # ]: 0 : if (Dtset%prtvol > 9) then
1230 : : ! Print a normalisation check
1231 [ # # # # ]: 0 : norm = SUM(qp_rhor_paw(:,1))*Cryst%ucvol/PRODUCT(Pawfgr%ngfft(1:3))
1232 : 0 : write(msg,'(a,F8.4)') ' QUASIPARTICLE DENSITY CALCULATED - NORM OF DENSITY: ',norm
1233 : 0 : call wrtout(std_out, msg)
1234 : : end if
1235 : :
1236 : : ! Write the density to file
1237 [ # # ]: 0 : if (my_rank==master) then
1238 : : call fftdatar_write("qp_pawrhor",dtfil%fnameabo_qp_pawden,dtset%iomode,hdr_sigma,&
1239 : 0 : cryst,ngfftf,cplex1,nfftf,dtset%nspden,qp_rhor_paw,mpi_enreg_seq,ebands=qp_ebands)
1240 : : end if
1241 [ # # ]: 0 : ABI_FREE(qp_rhor_paw)
1242 : : end if
1243 : :
1244 : 76 : nkxc=0
1245 [ + + ]: 76 : if (Dtset%nspden==1) nkxc=2
1246 [ + + ]: 76 : if (Dtset%nspden>=2) nkxc=3 !check GGA and spinor that is messy !!!
1247 : : !In case of MGGA, fxc and kxc are not available and we dont need them for the screening part (for now ...)
1248 [ - + - - ]: 76 : if (Dtset%ixc<0.and.libxc_functionals_ismgga()) nkxc=0
1249 [ + - ]: 76 : if (nkxc/=0) then
1250 [ - + + - : 304 : ABI_MALLOC(qp_kxc,(nfftf,nkxc))
- + + - +
- + - - +
- + ]
1251 : : end if
1252 : :
1253 : : ! **** NOTE THAT Vxc CONTAINS THE CORE-DENSITY CONTRIBUTION ****
1254 [ + + ]: 76 : n3xccc=0; if (Psps%n1xccc/=0) n3xccc=nfftf
1255 [ - + + - : 228 : ABI_MALLOC(qp_vhartr, (nfftf))
+ - + - -
+ - + ]
1256 [ - + + - : 304 : ABI_MALLOC(qp_vtrial, (nfftf,Dtset%nspden))
- + + - +
- + - - +
- + ]
1257 [ - + + - : 228 : ABI_MALLOC(qp_vxc, (nfftf,Dtset%nspden))
- + + - -
+ - + -
+ ]
1258 : :
1259 : 76 : optene=4; moved_atm_inside=0; moved_rhor=0; istep=1
1260 : :
1261 : : call setvtr(Cryst%atindx1,Dtset,QP_energies,gmet,gprimd,grchempottn,grewtn,grvdw,gsqcutf_eff,&
1262 : : istep,qp_kxc,mgfftf,moved_atm_inside,moved_rhor,MPI_enreg_seq,&
1263 : : Cryst%nattyp,nfftf,ngfftf,ngrvdw,qp_nhat,qp_nhatgr,nhatgrdim,nkxc,Cryst%ntypat,Psps%n1xccc,n3xccc,&
1264 : : optene,Pawang,Pawrad,QP_pawrhoij,Pawtab,ph1df,Psps,qp_rhog,qp_rhor,Cryst%rmet,&
1265 : : Cryst%rprimd,strsxc,Cryst%ucvol,usexcnhat,qp_vhartr,vpsp,qp_vtrial,qp_vxc,vxcavg_qp,Wvl,&
1266 : 76 : xccc3d,Cryst%xred,taur=qp_taur)
1267 : :
1268 [ + - ]: 76 : ABI_SFREE(qp_kxc)
1269 : :
1270 [ - + ]: 76 : if (Dtset%usepaw==1) then
1271 : 0 : call timab(561,1,tsec)
1272 : :
1273 : : ! Compute QP Dij
1274 : : call pawdij(cplex,Dtset%enunit,Cryst%gprimd,ipert0,&
1275 : : Cryst%natom,Cryst%natom,nfftf,ngfftf(1)*ngfftf(2)*ngfftf(3),&
1276 : : Dtset%nspden,Cryst%ntypat,QP_paw_an,QP_paw_ij,Pawang,Pawfgrtab,&
1277 : : Dtset%pawprtvol,Pawrad,QP_pawrhoij,Dtset%pawspnorb,Pawtab,Dtset%pawxcdev,&
1278 : : k0,Dtset%spnorbscl,Cryst%ucvol,dtset%cellcharge(1),&
1279 : : qp_vtrial,qp_vxc,Cryst%xred,Dtset%znucl,&
1280 : 0 : nucdipmom=Dtset%nucdipmom,spinaxis=Dtset%spinaxis)
1281 : :
1282 : : ! Symmetrize total Dij
1283 : 0 : option_dij=0
1284 : :
1285 : : call symdij_all(Cryst%gprimd,Cryst%indsym,ipert0,&
1286 : : Cryst%natom,Cryst%natom,Cryst%nsym,Cryst%ntypat,&
1287 : : QP_paw_ij,Pawang,Dtset%pawprtvol,Pawtab,Cryst%rprimd,&
1288 : 0 : Cryst%symafm,Cryst%symrec)
1289 : :
1290 : : ! Output the QP pseudopotential strengths Dij and the augmentation occupancies Rhoij.
1291 : 0 : call pawprt(Dtset,Cryst%natom,QP_paw_ij,QP_Pawrhoij,Pawtab)
1292 : 0 : call timab(561,2,tsec)
1293 : : end if
1294 : :
1295 [ + + ]: 1967517 : ehartree=half*SUM(qp_rhor(:,1)*qp_vhartr(:))/DBLE(nfftf)*Cryst%ucvol
1296 : :
1297 [ + - + + ]: 6156 : write(msg,'(a,80a)')ch10,('-',ii=1,80)
1298 : 76 : call wrtout(ab_out,msg)
1299 : 76 : write(msg,'(5a,f9.4,3a,es21.14,2a,es21.14)')ch10,&
1300 : 76 : ' QP results after the unitary transformation in the KS subspace: ',ch10,ch10,&
1301 : 76 : ' Number of electrons = ',qp_rhog(1,1)*Cryst%ucvol,ch10,ch10,&
1302 : 76 : ' QP Band energy [Ha] = ',qp_ebands%get_bandenergy(),ch10,&
1303 : 152 : ' QP Hartree energy [Ha] = ',ehartree
1304 : 76 : call wrtout(ab_out,msg)
1305 [ + - + + ]: 6156 : write(msg,'(a,80a)')ch10,('-',ii=1,80)
1306 : 152 : call wrtout(ab_out,msg)
1307 : :
1308 : : ! TODO Since plasmonpole model 2-3-4 depend on the Fourier components of the density
1309 : : ! in case of self-consistency we might calculate here the ppm coefficients using qp_rhor
1310 : : end if ! gwcalctyp>=10
1311 : :
1312 : : ! KS hamiltonian: hdft(b1,b1,k,s)= <b1,k,s|H_s|b1,k,s>
1313 [ - + + - : 106347 : ABI_CALLOC(hdft, (b1gw:b2gw, b1gw:b2gw, Kmesh%nibz, Sigp%nsppol*Sigp%nsig_ab))
- + + - -
+ + - - +
+ - + - +
- - + - +
- + + + +
+ + + +
+ ]
1314 : :
1315 [ + + ]: 206 : if (Dtset%nspinor == 1) then
1316 [ + + ]: 402 : do spin=1,Sigp%nsppol
1317 [ + + ]: 1618 : do ik=1,Kmesh%nibz
1318 [ + + ]: 9843 : do ib=b1gw,b2gw
1319 : 9640 : hdft(ib, ib, ik, spin) = ks_ebands%eig(ib, ik, spin)
1320 : : end do
1321 : : end do
1322 : : end do
1323 : : else
1324 : : ! Spinorial case
1325 : : ! * Note that here vxc contains the contribution of the core.
1326 : : ! * Scale ovlp if orthonormalization is not satisfied as npwwfn might be < npwvec.
1327 : : ! TODO add spin-orbit case and gwpara 2
1328 [ - + + - : 21 : ABI_MALLOC(my_band_list, (wfd%mband))
+ - + - -
+ - + ]
1329 [ - + + - : 14 : ABI_MALLOC(bmask, (wfd%mband))
- + - + ]
1330 [ + + + + ]: 281 : bmask = .False.; bmask(b1gw:b2gw) = .True.
1331 : :
1332 [ - + ]: 7 : if (Wfd%usepaw == 1) then
1333 [ # # # # : 0 : ABI_MALLOC(Cp1,(Wfd%natom, Wfd%nspinor))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
1334 : 0 : call pawcprj_alloc(Cp1, 0, Wfd%nlmn_atm)
1335 : : end if
1336 : :
1337 [ + + ]: 14 : do spin=1,Sigp%nsppol
1338 [ + + ]: 45 : do ik_ibz=1,Kmesh%nibz
1339 : : ! Distribute bands in [b1gw, b2gw] range
1340 : 31 : call wfd%distribute_bands(ik_ibz, spin, my_nband, my_band_list, bmask=bmask)
1341 [ + - ]: 31 : if (my_nband == 0) cycle
1342 : 31 : npw_k = Wfd%npwarr(ik_ibz)
1343 [ + + ]: 440 : do ii=1,my_nband ! ib=b1gw,b2gw in sequential
1344 : 402 : ib = my_band_list(ii)
1345 [ - + ]: 402 : ABI_CHECK(wfd%get_wave_ptr(ib, ik_ibz, spin, wave, msg) == 0, msg)
1346 : 402 : ug1 => wave%ug
1347 : 402 : cdummy = xdotc(npw_k*Wfd%nspinor,ug1,1,ug1,1)
1348 : 402 : ovlp(1) = REAL(cdummy); ovlp(2) = AIMAG(cdummy)
1349 : :
1350 [ - + ]: 402 : if (Psps%usepaw==1) then
1351 : 0 : call wfd%get_cprj(ib,ik_ibz,spin,Cryst,Cp1,sorted=.FALSE.)
1352 [ # # ]: 0 : ovlp = ovlp + paw_overlap(Cp1,Cp1,Cryst%typat,Pawtab)
1353 : : end if
1354 : : ! write(std_out,*)ovlp(1),ovlp(2)
1355 : 402 : norm=DBLE(ovlp(1)+ovlp(2))
1356 : 402 : ovlp(1)=DBLE(ovlp(1)/norm); ovlp(2)=DBLE(ovlp(2)/norm) ! ovlp(2)=cone-ovlp(1)
1357 : 402 : hdft(ib,ib,ik_ibz,1) = ks_ebands%eig(ib,ik_ibz,1)*ovlp(1) - KS_me%vxc(ib,ib,ik_ibz,3)
1358 : 402 : hdft(ib,ib,ik_ibz,2) = ks_ebands%eig(ib,ik_ibz,1)*ovlp(2) - KS_me%vxc(ib,ib,ik_ibz,4)
1359 : 402 : hdft(ib,ib,ik_ibz,3) = KS_me%vxc(ib,ib,ik_ibz,3)
1360 : 433 : hdft(ib,ib,ik_ibz,4) = KS_me%vxc(ib,ib,ik_ibz,4)
1361 : : end do
1362 : : end do
1363 : : end do
1364 : :
1365 : 7 : call xmpi_sum(hdft, wfd%comm, ierr)
1366 : :
1367 [ - + ]: 7 : ABI_FREE(my_band_list)
1368 [ - + ]: 7 : ABI_FREE(bmask)
1369 [ - + ]: 14 : if (Wfd%usepaw==1) then
1370 : 0 : call pawcprj_free(Cp1)
1371 [ # # # # : 0 : ABI_FREE(Cp1)
# # # # #
# ]
1372 : : end if
1373 : : end if
1374 : :
1375 : : ! Initialize Sigma results. TODO it is better if we use ragged arrays indexed by the k-point
1376 : 206 : call Sr%init(Sigp, Kmesh%nibz, Dtset%usepawu)
1377 : :
1378 : : ! Setup bare Hamiltonian := T + v_{loc} + v_{nl} + v_H.
1379 : : !
1380 : : ! * The representation depends whether we are updating the wfs or not.
1381 : : ! * ks_vUme is zero unless we are using DFT+U as starting point, see calc_vHxc_braket
1382 : : ! * Note that vH matrix elements are calculated using the true uncutted interaction
1383 : : ! This should be changed if the cutoff is also used in the GS run.
1384 : :
1385 [ + + ]: 206 : if (gwcalctyp < 10) then
1386 : : ! For one-shot GW use the KS representation.
1387 [ + - + - : 52920 : Sr%hhartree = hdft - KS_me%vxcval
+ - + - -
+ - - + +
+ + + + +
+ ]
1388 : :
1389 : : ! Additional stuff for PAW
1390 : : ! * DFT +U Hamiltonian
1391 : : ! * LEXX.
1392 : : ! * Core contribution estimated using Fock exchange.
1393 [ + + ]: 130 : if (Dtset%usepaw==1) then
1394 [ + + + - : 1157 : if (Sigp%use_sigxcore == 1) Sr%hhartree = hdft - (KS_me%vxc - KS_me%sxcore)
+ - + - +
- - + - -
+ + + + +
+ + + ]
1395 [ - + - - : 7 : if (Dtset%usepawu /= 0) Sr%hhartree = Sr%hhartree - KS_me%vu
- - - - -
- - - ]
1396 [ - + ]: 7 : if (Dtset%useexexch /= 0) then
1397 : 0 : ABI_ERROR("useexexch > 0 not implemented")
1398 [ # # # # : 0 : Sr%hhartree = Sr%hhartree - KS_me%vlexx
# # # # #
# ]
1399 : : end if
1400 : : end if
1401 : :
1402 : : else
1403 : : ! Self-consistent on energies and|or wavefunctions.
1404 : : ! * For NC get the bare Hamiltonian $H_{bare}= T+v_{loc}+ v_{nl}$ in the KS representation
1405 : : ! * For PAW, calculate the matrix elements of h0, store also the new Dij in QP_Paw_ij.
1406 : : ! * h0 is defined as T+vH[tn+nhat+tnZc] + vxc[tnc] + dij_eff and
1407 : : ! dij_eff = dij^0 + dij^hartree + dij^xc-dij^xc_val + dijhat - dijhat_val.
1408 : : ! In the above expression tn, tnhat are QP quantities.
1409 [ + - ]: 76 : if (Dtset%usepaw==0) then
1410 [ - + + - : 456 : ABI_MALLOC(hbare, (b1gw:b2gw,b1gw:b2gw,Kmesh%nibz,Sigp%nsppol*Sigp%nsig_ab))
- + + - -
+ + - - +
+ - + - +
- - + -
+ ]
1411 [ + - + - : 52603 : hbare = hdft - KS_me%vhartree - KS_me%vxcval
+ - + - -
+ - - + +
+ + + + +
+ ]
1412 : :
1413 : : ! Change basis from KS to QP, hbare is overwritten: A_{QP} = U^\dagger A_{KS} U
1414 [ - + + - : 380 : ABI_MALLOC(htmp, (b1gw:b2gw,b1gw:b2gw, Kmesh%nibz, Sigp%nsppol*Sigp%nsig_ab))
- + + - -
+ + - - +
+ - - + -
+ ]
1415 [ - + + - : 304 : ABI_MALLOC(ctmp, (b1gw:b2gw, b1gw:b2gw))
- + + - +
- + - - +
- + - + ]
1416 [ - + + - : 228 : ABI_MALLOC(uks2qp, (b1gw:b2gw, b1gw:b2gw))
- + + - -
+ - + ]
1417 [ + - + - : 105054 : htmp = hbare; hbare = czero
+ - + - -
+ - - - -
- - + + +
+ + + + +
+ + + + +
+ + + ]
1418 : :
1419 [ + + ]: 154 : do spin=1,Sigp%nsppol
1420 [ + + ]: 607 : do ik=1,Kmesh%nibz
1421 [ + + + + ]: 52373 : uks2qp(:,:) = Sr%m_ks_to_qp(b1gw:b2gw,b1gw:b2gw,ik,spin)
1422 [ + + ]: 984 : do iab=1,Sigp%nsig_ab
1423 [ - + ]: 453 : is_idx=spin; if (Sigp%nsig_ab>1) is_idx=iab
1424 [ + - + + : 2820233 : ctmp(:,:)=MATMUL(htmp(:,:,ik,is_idx),uks2qp(:,:))
+ + + + +
+ + + + -
+ - + - +
- + - ]
1425 [ + - + + : 2820686 : hbare(:,:,ik,is_idx)=MATMUL(TRANSPOSE(CONJG(uks2qp)),ctmp)
+ + + + +
+ + + + -
+ - + - +
- + - - -
- - - - ]
1426 : : end do
1427 : : end do
1428 : : end do
1429 [ - + ]: 76 : ABI_FREE(htmp)
1430 [ - + ]: 76 : ABI_FREE(ctmp)
1431 [ - + ]: 76 : ABI_FREE(uks2qp)
1432 : : end if ! usepaw==0
1433 : :
1434 : : ! Calculate the QP matrix elements
1435 : : ! This part is parallelized within MPI_COMM_WORD since each node has all GW wavefunctions.
1436 : : ! For PAW, we have to construct the new bare Hamiltonian.
1437 : 76 : call wrtout(std_out,ch10//' *************** QP Energies *******************')
1438 : :
1439 : 76 : call QP_mflags%reset()
1440 : : ! if (gwcalctyp<20) QP_mflags%only_diago=1 ! For e-only, no need of off-diagonal elements.
1441 : 76 : QP_mflags%has_vhartree=1
1442 [ - + ]: 76 : if (Dtset%usepaw==1) then
1443 : 0 : QP_mflags%has_kinetic =1
1444 : 0 : QP_mflags%has_hbare =1
1445 : : end if
1446 : : !QP_mflags%has_vxc =1
1447 : : !QP_mflags%has_vxcval =1
1448 : : !if (Sigp%gwcalctyp >100) QP_mflags%has_vxcval_hybrid=1
1449 [ + + + + ]: 76 : if (mod10==5 .and. &
1450 : : (Dtset%ixc_sigma==-402 .or. Dtset%ixc_sigma==-406 .or. Dtset%ixc_sigma==-427 .or. Dtset%ixc_sigma==-428 .or. &
1451 : : Dtset%ixc_sigma==-456 .or. Dtset%ixc_sigma==41 .or. Dtset%ixc_sigma==42)) then
1452 : 23 : QP_mflags%has_vxcval_hybrid = 1
1453 : : end if
1454 : :
1455 : : !if (Sigp%use_sigxcore==1) QP_mflags%has_sxcore =1
1456 : : !if (Dtset%usepawu/=0) QP_mflags%has_vu =1
1457 : : !if (Dtset%useexexch/=0) QP_mflags%has_lexexch=1
1458 : :
1459 [ - + + - : 304 : ABI_MALLOC(tmp_kstab, (2, Wfd%nkibz, Wfd%nsppol))
- + + - +
- + - - +
- + ]
1460 [ + + + + : 1513 : tmp_kstab=0
+ + ]
1461 [ + + ]: 154 : do spin=1,Sigp%nsppol
1462 [ + + ]: 553 : do ikcalc=1,Sigp%nkptgw ! No spin dependent!
1463 : 399 : ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc))
1464 : 399 : tmp_kstab(1,ik_ibz,spin)=Sigp%minbnd(ikcalc,spin)
1465 : 477 : tmp_kstab(2,ik_ibz,spin)=Sigp%maxbnd(ikcalc,spin)
1466 : : end do
1467 : : end do
1468 : :
1469 : : call calc_vhxc_me(Wfd,QP_mflags,QP_me,Cryst,Dtset,nfftf,ngfftf,&
1470 : : qp_vtrial,qp_vhartr,qp_vxc,Psps,Pawtab,QP_paw_an,Pawang,Pawfgrtab,QP_paw_ij,dijexc_core,&
1471 : 76 : qp_rhor,usexcnhat,qp_nhat,qp_nhatgr,nhatgrdim,tmp_kstab,taur=qp_taur)
1472 [ - + ]: 76 : ABI_FREE(tmp_kstab)
1473 : :
1474 [ + + - + ]: 76 : if (gwcalctyp>=20 .and. Sigp%symsigma>0) then
1475 : 0 : bmin=Sigp%minbdgw; bmax=Sigp%maxbdgw
1476 [ # # # # : 0 : ABI_MALLOC(qp_irreptab,(bmin:bmax,Kmesh%nibz,Sigp%nsppol))
# # # # #
# # # # #
# # # # #
# ]
1477 [ # # # # : 0 : qp_irreptab=0
# # ]
1478 [ # # ]: 0 : do spin=1,Sigp%nsppol
1479 [ # # ]: 0 : do ikcalc=1,Sigp%nkptgw
1480 : 0 : ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc))
1481 : 0 : first_band = Sigp%minbnd(ikcalc,spin)
1482 : 0 : last_band = Sigp%maxbnd(ikcalc,spin)
1483 [ # # ]: 0 : if (.not. QP_sym(ik_ibz,spin)%failed()) then
1484 [ # # ]: 0 : qp_irreptab(first_band:last_band,ik_ibz,spin) = QP_sym(ik_ibz,spin)%b2irrep(first_band:last_band)
1485 : : !qp_irreptab(bmin:bmax,ik_ibz,spin) = QP_sym(ik_ibz,spin)%b2irrep(bmin:bmax)
1486 : : end if
1487 : : end do
1488 : : end do
1489 : 0 : call QP_me%zero(qp_irreptab)
1490 [ # # ]: 0 : ABI_FREE(qp_irreptab)
1491 : : end if
1492 : :
1493 : 76 : call QP_me%print(header="Matrix elements in the QP basis set", prtvol=Dtset%prtvol)
1494 : :
1495 : : ! Output the QP pseudopotential strengths Dij and the augmentation occupancies Rhoij.
1496 [ - + ]: 76 : if (Dtset%usepaw==1) then
1497 : 0 : call wrtout(std_out," *** After calc_vHxc_braket *** ")
1498 : : ! TODO finalize the implementation of this routine.
1499 : 0 : call paw_ij_print(QP_Paw_ij,unit=std_out,pawprtvol=Dtset%pawprtvol,pawspnorb=Dtset%pawspnorb,mode_paral="COLL")
1500 : 0 : call pawprt(Dtset,Cryst%natom,QP_paw_ij,QP_Pawrhoij,Pawtab)
1501 : : end if
1502 : :
1503 [ + - ]: 76 : if (Dtset%usepaw==0) then
1504 : : ! GA: We have an odd bug here. I have to unroll this loop, otherwise it
1505 : : ! might cause segfault when running on several nodes.
1506 : : !
1507 : : ! Sr%hhartree = hbare + QP_me%vhartree
1508 [ + + ]: 76 : if (QP_mflags%has_vxcval_hybrid == 0) then
1509 [ + + ]: 108 : do spin=1,Sigp%nsppol*Sr%nsig_ab
1510 [ + + ]: 380 : do ikcalc=1,Sr%nkibz
1511 [ + + ]: 2691 : do ib1=b1gw,b2gw
1512 [ + + ]: 24256 : do ib2=b1gw,b2gw
1513 : 23984 : Sr%hhartree(ib2,ib1,ikcalc,spin) = hbare(ib2,ib1,ikcalc,spin) + QP_me%vhartree(ib2,ib1,ikcalc,spin)
1514 : : end do
1515 : : end do
1516 : : end do
1517 : : end do
1518 : : else
1519 [ + + ]: 46 : do spin=1,Sigp%nsppol*Sr%nsig_ab
1520 [ + + ]: 227 : do ikcalc=1,Sr%nkibz
1521 [ + + ]: 2300 : do ib1=b1gw,b2gw
1522 [ + + ]: 28117 : do ib2=b1gw,b2gw
1523 : : Sr%hhartree(ib2,ib1,ikcalc,spin) = hbare(ib2,ib1,ikcalc,spin) + &
1524 : 27936 : QP_me%vhartree(ib2,ib1,ikcalc,spin) + QP_me%vxcval_hybrid(ib2,ib1,ikcalc,spin)
1525 : : end do
1526 : : end do
1527 : : end do
1528 : : end do
1529 : : end if
1530 : : else
1531 [ # # # # : 0 : Sr%hhartree=QP_me%hbare
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
1532 : : end if
1533 : :
1534 [ + + - + ]: 76 : if (gwcalctyp>=20 .and. Sigp%symsigma > 0) then
1535 : : ! bmin=Sigp%minbdgw; bmax=Sigp%maxbdgw
1536 [ # # ]: 0 : do spin=1,Sigp%nsppol
1537 [ # # ]: 0 : do ik_ibz=1,Kmesh%nibz
1538 [ # # ]: 0 : if (.not. QP_sym(ik_ibz,spin)%failed()) then
1539 : 0 : bmin=Sigp%minbnd(ik_ibz,spin); bmax=Sigp%minbnd(ik_ibz,spin)
1540 [ # # ]: 0 : do ib2=bmin,bmax
1541 : 0 : irr_idx2 = QP_sym(ik_ibz,spin)%b2irrep(ib2)
1542 [ # # ]: 0 : do ib1=bmin,bmax
1543 : 0 : irr_idx1 = QP_sym(ik_ibz,spin)%b2irrep(ib1)
1544 [ # # # # ]: 0 : if (irr_idx1/=irr_idx2 .and. ALL((/irr_idx1,irr_idx2/)/=0) ) Sr%hhartree(ib1,ib2,ik_ibz,spin) = czero
1545 : : end do
1546 : : end do
1547 : : end if
1548 : : end do
1549 : : end do
1550 : : end if
1551 : :
1552 [ - + ]: 76 : ABI_FREE(qp_rhog)
1553 [ - + ]: 76 : ABI_FREE(qp_vhartr)
1554 [ - + ]: 76 : ABI_FREE(qp_vxc)
1555 [ - + ]: 76 : ABI_FREE(qp_nhat)
1556 [ - + ]: 76 : ABI_FREE(qp_nhatgr)
1557 : 76 : call QP_me%free()
1558 : : end if ! gwcalctyp<10
1559 : :
1560 : : ! Free some memory
1561 [ + + ]: 206 : ABI_SFREE(hbare)
1562 [ + - ]: 206 : ABI_SFREE(hdft)
1563 : :
1564 : : ! Prepare the storage of QP amplitudes and energies
1565 : : ! Initialize with KS wavefunctions and energies.
1566 : : ! FIXME: This array should be allocated only if self-consistent
1567 [ + + + + : 73477 : if (sr%needs_eigvec_qp) Sr%eigvec_qp=czero
+ + + + +
+ ]
1568 [ + + + + : 31007 : Sr%en_qp_diago=zero
+ + ]
1569 [ + + ]: 5891 : do ib=1,Sigp%nbnds
1570 [ + + + + ]: 40764 : Sr%en_qp_diago(ib,:,:) = ks_ebands%eig(ib,:,:)
1571 [ + + + + : 12067 : if (sr%needs_eigvec_qp) Sr%eigvec_qp(ib,ib,:,:) = cone
+ + ]
1572 : : end do
1573 : :
1574 : : ! Store <n,k,s|V_xc[n_val]|n,k,s> and <n,k,s|V_U|n,k,s> ===
1575 : : ! Note that we store the matrix elements of V_xc in the KS basis set, not in the QP basis set
1576 : : ! Matrix elements of V_U are zero unless we are using DFT+U as starting point
1577 [ + + ]: 1648 : do ib=b1gw,b2gw
1578 [ + + + + ]: 13212 : Sr%vxcme(ib,:,:)=KS_me%vxcval(ib,ib,:,:)
1579 [ + + + + : 1598 : if (Sigp%use_sigxcore == 1) Sr%vxcme(ib,:,:)= KS_me%vxc(ib,ib,:,:) -KS_me%sxcore(ib,ib,:,:) !SF: This needs to be updated, otherwise Vxc will be reported incorrectly in the output. However, vxcme is not used by solve_dyson
+ + ]
1580 [ - + - - : 1648 : if (Dtset%usepawu/=0) Sr%vUme (ib,:,:)=KS_me%vu(ib,ib,:,:)
- - ]
1581 : : end do
1582 : :
1583 : : ! Initial guess for the GW energies
1584 : : ! Save the energies of the previous iteration.
1585 [ + + ]: 416 : do spin=1,Sigp%nsppol
1586 [ + + ]: 1663 : do ik=1,Kmesh%nibz
1587 [ + + ]: 30591 : do ib=1,Sigp%nbnds
1588 : 29344 : Sr%e0 (ib,ik,spin) = qp_ebands%eig(ib,ik,spin)
1589 : 30591 : Sr%egw(ib,ik,spin) = qp_ebands%eig(ib,ik,spin)
1590 : : end do
1591 : 1247 : Sr%e0gap(ik,spin) = zero
1592 : 1247 : ks_iv = ks_vbik(ik, spin)
1593 [ + - ]: 1457 : if (Sigp%nbnds>=ks_iv+1) Sr%e0gap(ik,spin)=Sr%e0(ks_iv+1,ik,spin)-Sr%e0(ks_iv,ik,spin)
1594 : : end do
1595 : : end do
1596 : : !
1597 : : !=== If required apply a scissor operator or update the energies ===
1598 : : !TODO check if other Sr entries have to be updated
1599 : : !moreover this part should be done only in case of semiconductors
1600 : : !FIXME To me it makes more sense if we apply the scissor to ks_ebands but I have to RECHECK csigme
1601 [ + + ]: 206 : if (ABS(Sigp%mbpt_sciss)>tol6) then
1602 : 2 : write(msg,'(6a,f10.5,2a)')ch10,&
1603 : 2 : ' sigma : performing a first self-consistency',ch10,&
1604 : 2 : ' update of the energies in G by a scissor operator',ch10, &
1605 : 4 : ' applying a scissor operator of ',Sigp%mbpt_sciss*Ha_eV,' [eV] ',ch10
1606 : 2 : call wrtout(units, msg)
1607 [ + + ]: 4 : do spin=1,Sigp%nsppol
1608 [ + + ]: 8 : do ik=1,Kmesh%nibz
1609 : 4 : ks_iv=ks_vbik(ik,spin)
1610 [ + - ]: 6 : if (Sigp%nbnds>=ks_iv+1) then
1611 [ + + ]: 28 : Sr%egw (ks_iv+1:Sigp%nbnds,ik,spin) = Sr%egw (ks_iv+1:Sigp%nbnds,ik,spin)+Sigp%mbpt_sciss
1612 [ + + ]: 28 : qp_ebands%eig(ks_iv+1:Sigp%nbnds,ik,spin) = qp_ebands%eig(ks_iv+1:Sigp%nbnds,ik,spin)+Sigp%mbpt_sciss
1613 : : end if
1614 : : end do
1615 : : end do
1616 : : !call apply_scissor(qp_ebands,Sigp%mbpt_sciss)
1617 : : else if (.FALSE.) then
1618 : : write(msg,'(4a)')ch10,&
1619 : : ' sigma : performing a first self-consistency',ch10,&
1620 : : ' update of the energies in G by a previous GW calculation'
1621 : : call wrtout(units, msg)
1622 : : ! TODO Recheck this part, is not clear to me!
1623 : : ABI_MALLOC(igwene,(qp_ebands%mband, qp_ebands%nkpt, qp_ebands%nsppol))
1624 : : call rdgw(qp_ebands, '__in.gw__', igwene, extrapolate=.TRUE.)
1625 : : ABI_FREE(igwene)
1626 : : Sr%egw=qp_ebands%eig
1627 : : !
1628 : : ! * Recalculate the new fermi level.
1629 : : call qp_ebands%update_occ(Dtset%spinmagntarget, prtvol=0)
1630 : : end if
1631 : :
1632 : : ! In case of AC refer all the energies wrt to the fermi level
1633 : : ! Be careful because results from ppmodel cannot be used for AC
1634 : : ! FIXME check ks_energy or qp_energy (in case of SCGW?)
1635 : :
1636 [ + + ]: 206 : if (mod10 == SIG_GW_AC) then
1637 : : ! All these quantities will be passed to csigme
1638 : : ! if I skipped the self-consistent part then here I have to use fermi
1639 [ + + + + : 942 : qp_ebands%eig = qp_ebands%eig - qp_ebands%fermie
+ + ]
1640 [ + + + + : 942 : Sr%egw = Sr%egw - qp_ebands%fermie
+ + ]
1641 [ + + + + : 942 : Sr%e0 = Sr%e0 - qp_ebands%fermie
+ + ]
1642 : 9 : old_fermie = qp_ebands%fermie
1643 : : ! TODO Recheck fermi
1644 : : ! Clean EVERYTHING in particulare the treatment of E fermi
1645 : 9 : qp_ebands%fermie = zero
1646 : : end if
1647 : :
1648 : : ! Setup frequencies around the KS\QP eigenvalues to compute Sigma derivatives (notice the spin) ===
1649 : : ! TODO it is better using an odd Sr%nomega4sd so that the KS\QP eigenvalue is in the middle
1650 : 206 : ioe0j=Sr%nomega4sd/2+1
1651 [ + + ]: 416 : do spin=1,Sigp%nsppol
1652 [ + + ]: 1068 : do ikcalc=1,Sigp%nkptgw
1653 : 652 : ib1=Sigp%minbnd(ikcalc,spin)
1654 : 652 : ib2=Sigp%maxbnd(ikcalc,spin)
1655 : 652 : ik_ibz=Kmesh%tab(Sigp%kptgw2bz(ikcalc))
1656 [ + + ]: 6327 : do jb=ib1,ib2
1657 [ + + ]: 25990 : do io=1,Sr%nomega4sd
1658 : 25338 : Sr%omega4sd(jb,ik_ibz,io,spin)=Sr%egw(jb,ik_ibz,spin)+Sigp%deltae*(io-ioe0j)
1659 : : end do
1660 : : end do
1661 : : end do
1662 : : end do
1663 : :
1664 : 206 : call pstat_proc%print(_PSTAT_ARGS_)
1665 : 206 : call timab(408,2,tsec) ! hqp_init
1666 : 206 : call timab(409,1,tsec) ! getW
1667 : :
1668 : : ! Get epsilon^{-1} either from the _SCR or the _SUSC file and store it in epsm1%epsm1
1669 : : ! If epsm1%mqmem==0, allocate and read a single q-slice inside csigme.
1670 : : ! TODO epsm1%nomega should be initialized so that only the frequencies really needed are stored in memory
1671 : : ! TODO The same piece of code is present in screening.
1672 [ + + ]: 206 : if (sigp%needs_w()) then
1673 : :
1674 : 337 : select case (dtset%gwgamma)
1675 : : case (0)
1676 : 166 : id_required = 4; ikxc = 0; approx_type = 0; option_test = 0; dim_kxcg = 0
1677 [ - + + - : 332 : ABI_MALLOC(kxcg, (nfftf_tot,dim_kxcg))
- + - + ]
1678 : :
1679 : : case (1, 2)
1680 : : ! ALDA TDDFT kernel vertex
1681 [ - + ]: 1 : ABI_CHECK(epsm1%ID == 0, "epsm1%ID should be 0")
1682 : :
1683 [ - + ]: 1 : if (Dtset%usepaw==1) then
1684 : : ! If we have PAW, we need the full density on the fine grid
1685 [ # # # # : 0 : ABI_MALLOC(ks_aepaw_rhor,(nfftf,Wfd%nspden))
# # # # #
# # # # #
# # ]
1686 [ # # # # ]: 0 : if (Dtset%getpawden==0 .and. Dtset%irdpawden==0) then
1687 : 0 : ABI_ERROR("Must use get/irdpawden to provide a _PAWDEN file!")
1688 : : end if
1689 : 0 : call wrtout(std_out,sjoin('Checking for existence of: ',Dtfil%filpawdensin))
1690 [ # # ]: 0 : if (.not. file_exists(dtfil%filpawdensin)) then
1691 : 0 : ABI_ERROR(sjoin("Missing file:", dtfil%filpawdensin))
1692 : : end if
1693 : :
1694 [ # # # # : 0 : ABI_MALLOC(tmp_pawrhoij,(cryst%natom*wfd%usepaw))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1695 : : call read_rhor(Dtfil%filpawdensin, cplex1, nfftf_tot, Wfd%nspden, ngfftf, 1, MPI_enreg_seq, &
1696 : 0 : ks_aepaw_rhor, Hdr_rhor, tmp_pawrhoij, wfd%comm)
1697 : :
1698 : 0 : call Hdr_rhor%free()
1699 : 0 : call pawrhoij_free(tmp_pawrhoij)
1700 [ # # # # : 0 : ABI_FREE(tmp_pawrhoij)
# # # # #
# # # # #
# # # # ]
1701 : : end if ! usepaw==1
1702 : :
1703 : 1 : id_required=4; ikxc=7; approx_type=1; dim_kxcg=1
1704 [ + - ]: 1 : if (Dtset%gwgamma==1) option_test=1 ! TESTELECTRON, vertex in chi0 *and* sigma
1705 [ - + ]: 1 : if (Dtset%gwgamma==2) option_test=0 ! TESTPARTICLE, vertex in chi0 only
1706 [ - + + - : 3 : ABI_MALLOC(kxcg, (nfftf_tot, dim_kxcg))
+ - + - -
+ - + ]
1707 : :
1708 : 1 : dbg_mode=.FALSE.
1709 [ - + ]: 1 : if (Dtset%usepaw==1) then
1710 : : ! Use PAW all-electron density
1711 : : call kxc_driver(Dtset,Cryst,ikxc,ngfftf,nfftf_tot,Wfd%nspden,ks_aepaw_rhor,&
1712 : 0 : epsm1%npwe,dim_kxcg,kxcg,Gsph_c%gvec,xmpi_comm_self,dbg_mode=dbg_mode)
1713 : : else
1714 : : ! Norm-conserving
1715 : : call kxc_driver(Dtset,Cryst,ikxc,ngfftf,nfftf_tot,Wfd%nspden,ks_rhor,&
1716 : 1 : epsm1%npwe,dim_kxcg,kxcg,Gsph_c%gvec,xmpi_comm_self,dbg_mode=dbg_mode)
1717 : : end if
1718 : :
1719 : : case (3, 4)
1720 : : ! ADA non-local kernel vertex
1721 [ # # ]: 0 : ABI_CHECK(epsm1%ID==0, "epsm1%ID should be 0")
1722 [ # # ]: 0 : ABI_CHECK(Sigp%nsppol==1, "ADA vertex for GWGamma not available yet for spin-polarised cases")
1723 : :
1724 [ # # ]: 0 : if (Dtset%usepaw==1) then
1725 : : ! If we have PAW, we need the full density on the fine grid
1726 [ # # # # : 0 : ABI_MALLOC(ks_aepaw_rhor,(nfftf, Sigp%nsppol))
# # # # #
# # # # #
# # ]
1727 [ # # # # ]: 0 : if (Dtset%getpawden==0.and.Dtset%irdpawden==0) then
1728 : 0 : ABI_ERROR("Must use get/irdpawden to provide a _PAWDEN file!")
1729 : : end if
1730 : 0 : call wrtout(std_out,sjoin('Checking for existence of: ',Dtfil%filpawdensin))
1731 [ # # ]: 0 : if (.not. file_exists(dtfil%filpawdensin)) then
1732 : 0 : ABI_ERROR(sjoin("Missing file:", dtfil%filpawdensin))
1733 : : end if
1734 : :
1735 [ # # # # : 0 : ABI_MALLOC(tmp_pawrhoij,(cryst%natom*wfd%usepaw))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1736 : :
1737 : : call read_rhor(Dtfil%filpawdensin, cplex1, nfftf_tot, Wfd%nspden, ngfftf, 1, MPI_enreg_seq, &
1738 : 0 : ks_aepaw_rhor, Hdr_rhor, tmp_pawrhoij, wfd%comm)
1739 : :
1740 : 0 : call Hdr_rhor%free()
1741 : 0 : call pawrhoij_free(tmp_pawrhoij)
1742 [ # # # # : 0 : ABI_FREE(tmp_pawrhoij)
# # # # #
# # # # #
# # # # ]
1743 : : end if ! Dtset%usepaw==1
1744 : :
1745 : 0 : id_required=4; ikxc=7; approx_type=2;
1746 [ # # ]: 0 : if (Dtset%gwgamma==3) option_test=1 ! TESTELECTRON, vertex in chi0 *and* sigma
1747 [ # # ]: 0 : if (Dtset%gwgamma==4) option_test=0 ! TESTPARTICLE, vertex in chi0 only
1748 [ # # # # : 0 : ABI_MALLOC(fxc_ADA, (epsm1%npwe, epsm1%npwe, epsm1%nqibz))
# # # # #
# # # # #
# # # # #
# ]
1749 : : ! Use userrd to set kappa
1750 [ # # ]: 0 : if (Dtset%userrd==zero) Dtset%userrd = 2.1_dp
1751 : : ! Set correct value of kappa (should be scaled with alpha*r_s where)
1752 : : ! r_s is Wigner-Seitz radius and alpha=(4/(9*Pi))^(1/3)
1753 : 0 : rhoav = (drude_plsmf*drude_plsmf)/four_pi
1754 : 0 : r_s = (three/(four_pi*rhoav))**third
1755 : 0 : alpha = (four*ninth*piinv)**third
1756 : 0 : Dtset%userrd = Dtset%userrd/(alpha*r_s)
1757 : :
1758 : 0 : dbg_mode=.TRUE.
1759 [ # # ]: 0 : if (Dtset%usepaw==1) then
1760 : : ! Use PAW all-electron density
1761 : : call kxc_ADA(Dtset,Cryst,ikxc,ngfftf,nfftf_tot,Wfd%nspden,&
1762 : : ks_aepaw_rhor,epsm1%npwe,epsm1%nqibz,epsm1%qibz,&
1763 : 0 : fxc_ADA,Gsph_c%gvec,xmpi_comm_self,kappa_init=Dtset%userrd,dbg_mode=dbg_mode)
1764 : : else
1765 : : ! Norm conserving
1766 : : call kxc_ADA(Dtset,Cryst,ikxc,ngfftf,nfftf_tot,Wfd%nspden,&
1767 : : ks_rhor,epsm1%npwe,epsm1%nqibz,epsm1%qibz,&
1768 : 0 : fxc_ADA,Gsph_c%gvec,xmpi_comm_self,kappa_init=Dtset%userrd,dbg_mode=dbg_mode)
1769 : : end if
1770 : :
1771 : 0 : dim_kxcg = 0
1772 [ # # # # : 0 : ABI_MALLOC(kxcg,(nfftf_tot,dim_kxcg))
# # # # ]
1773 : :
1774 : : case (-3, -4, -5, -6, -7, -8)
1775 : : ! bootstrap kernels
1776 [ - + ]: 3 : ABI_CHECK(epsm1%ID==0,"epsm1%ID should be 0")
1777 : :
1778 [ - + ]: 3 : if (Dtset%usepaw==1) then
1779 : : ! If we have PAW, we need the full density on the fine grid
1780 [ # # # # : 0 : ABI_MALLOC(ks_aepaw_rhor, (nfftf,Wfd%nspden))
# # # # #
# # # # #
# # ]
1781 [ # # # # ]: 0 : if (Dtset%getpawden==0.and.Dtset%irdpawden==0) then
1782 : 0 : ABI_ERROR("Must use get/irdpawden to provide a _PAWDEN file!")
1783 : : end if
1784 : 0 : call wrtout(std_out,sjoin('Checking for existence of: ',Dtfil%filpawdensin))
1785 [ # # ]: 0 : if (.not. file_exists(dtfil%filpawdensin)) then
1786 : 0 : ABI_ERROR(sjoin("Missing file:", dtfil%filpawdensin))
1787 : : end if
1788 : :
1789 [ # # # # : 0 : ABI_MALLOC(tmp_pawrhoij, (cryst%natom*wfd%usepaw))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1790 : :
1791 : : call read_rhor(Dtfil%filpawdensin, cplex1, nfftf_tot, Wfd%nspden, ngfftf, 1, MPI_enreg_seq, &
1792 : 0 : ks_aepaw_rhor, Hdr_rhor, tmp_pawrhoij, wfd%comm)
1793 : :
1794 : 0 : call Hdr_rhor%free()
1795 : 0 : call pawrhoij_free(tmp_pawrhoij)
1796 [ # # # # : 0 : ABI_FREE(tmp_pawrhoij)
# # # # #
# # # # #
# # # # ]
1797 : : end if ! Dtset%usepaw==1
1798 : :
1799 : 3 : id_required=4; ikxc=7; dim_kxcg=0
1800 : :
1801 [ + + ]: 3 : if (dtset%gwgamma>-5) then
1802 : 2 : approx_type=4 ! full fxc(G,G')
1803 [ + - ]: 1 : else if (dtset%gwgamma>-7) then
1804 : 1 : approx_type=5 ! fxc(0,0) one-shot
1805 : : else
1806 : 0 : approx_type=6 ! rpa-type bootstrap
1807 : : end if
1808 : :
1809 : 3 : option_test=MOD(Dtset%gwgamma,2)
1810 : : ! 1 -> TESTELECTRON, vertex in chi0 *and* sigma
1811 : : ! 0 -> TESTPARTICLE, vertex in chi0 only
1812 [ - + + - : 6 : ABI_MALLOC(kxcg, (nfftf_tot,dim_kxcg))
- + - + ]
1813 : :
1814 : : case (-11)
1815 : : ! LR+ALDA kernel
1816 [ - + ]: 1 : ABI_CHECK(epsm1%ID==0,"epsm1%ID should be 0")
1817 : :
1818 [ - + ]: 1 : if (Dtset%usepaw==1) then
1819 : : ! If we have PAW, we need the full density on the fine grid
1820 [ # # # # : 0 : ABI_MALLOC(ks_aepaw_rhor,(nfftf,Wfd%nspden))
# # # # #
# # # # #
# # ]
1821 [ # # # # ]: 0 : if (Dtset%getpawden==0.and.Dtset%irdpawden==0) then
1822 : 0 : ABI_ERROR("Must use get/irdpawden to provide a _PAWDEN file!")
1823 : : end if
1824 : 0 : call wrtout(std_out,sjoin('Checking for existence of: ',Dtfil%filpawdensin))
1825 [ # # ]: 0 : if (.not. file_exists(dtfil%filpawdensin)) then
1826 : 0 : ABI_ERROR(sjoin("Missing file:", dtfil%filpawdensin))
1827 : : end if
1828 : :
1829 [ # # # # : 0 : ABI_MALLOC(tmp_pawrhoij,(cryst%natom*wfd%usepaw))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1830 : :
1831 : : call read_rhor(Dtfil%filpawdensin, cplex1, nfftf_tot, Wfd%nspden, ngfftf, 1, MPI_enreg_seq, &
1832 : 0 : ks_aepaw_rhor, hdr_rhor, tmp_pawrhoij, wfd%comm)
1833 : :
1834 : 0 : call hdr_rhor%free()
1835 : 0 : call pawrhoij_free(tmp_pawrhoij)
1836 [ # # # # : 0 : ABI_FREE(tmp_pawrhoij)
# # # # #
# # # # #
# # # # ]
1837 : : end if ! Dtset%usepaw==1
1838 : :
1839 : 1 : id_required=4; ikxc=7; dim_kxcg=1
1840 : 1 : approx_type=7
1841 : 1 : option_test=1
1842 : : ! 1 -> TESTELECTRON, vertex in chi0 *and* sigma
1843 [ - + + - : 3 : ABI_MALLOC(kxcg,(nfftf_tot,dim_kxcg))
+ - + - -
+ - + ]
1844 : :
1845 : : case default
1846 [ + + - + : 171 : ABI_ERROR(sjoin("Wrong gwgamma:", itoa(dtset%gwgamma)))
+ - ]
1847 : : end select
1848 : :
1849 : : ! Set plasma frequency
1850 [ + + ]: 171 : my_plsmf = drude_plsmf; if (Dtset%ppmfrq>tol6) my_plsmf = Dtset%ppmfrq
1851 : 171 : Dtset%ppmfrq = my_plsmf
1852 : :
1853 [ + - ]: 171 : if (Dtset%gwgamma < 3) then
1854 : : call epsm1%mkdump(Vcp,epsm1%npwe,Gsph_c%gvec,dim_kxcg,kxcg,id_required,&
1855 : : approx_type,ikxc,option_test,Dtfil%fnameabo_scr,Dtset%iomode,&
1856 : 171 : nfftf_tot,ngfftf,comm)
1857 : : else
1858 : : call epsm1%mkdump(Vcp,epsm1%npwe,Gsph_c%gvec,dim_kxcg,kxcg,id_required,&
1859 : : approx_type,ikxc,option_test,Dtfil%fnameabo_scr,Dtset%iomode,&
1860 : 0 : nfftf_tot,ngfftf,comm,fxc_ADA=fxc_ADA)
1861 : : end if
1862 [ + - ]: 171 : ABI_SFREE(kxcg)
1863 [ - + ]: 171 : ABI_SFREE(fxc_ADA)
1864 [ - + ]: 171 : ABI_SFREE(ks_aepaw_rhor)
1865 : : end if
1866 : : !
1867 : : ! ================================================
1868 : : ! ==== Calculate plasmonpole model parameters ====
1869 : : ! ================================================
1870 : : ! TODO Maybe its better if we use mqmem as input variable
1871 : 206 : use_aerhor=0
1872 [ - + + - : 412 : ABI_MALLOC(ks_aepaw_rhor, (nfftf,Wfd%nspden*use_aerhor))
- + - + -
+ ]
1873 : :
1874 [ + + ]: 206 : if (sigp%needs_ppm()) then
1875 : : ! If epsm1 is MPI-shared, we have to start the RMA epoch. Note that epsm1%epsm1 is read-only.
1876 [ + + ]: 135 : if (epsm1%use_mpi_shared_win) then
1877 : 24 : call xmpi_win_fence(XMPI_MODE_NOPRECEDE, epsm1%epsm1_win, ierr)
1878 : 24 : ABI_CHECK_MPI(ierr, "")
1879 : : end if
1880 : :
1881 [ + - ]: 135 : my_plsmf = drude_plsmf; if (Dtset%ppmfrq > tol6) my_plsmf = Dtset%ppmfrq
1882 : 135 : call PPm%init(epsm1%mqmem, epsm1%nqibz, epsm1%npwe, Sigp%ppmodel, my_plsmf, Dtset%gw_invalid_freq)
1883 : : ! PPm%force_plsmf= force_ppmfrq ! this line to change the plasma frequency in the HL expression.
1884 : :
1885 [ + + - + ]: 135 : if (Wfd%usepaw==1 .and. Ppm%userho==1) then
1886 : : ! For PAW and ppmodel 2-3-4 we need the AE rho(G) without compensation charge.
1887 : : ! It would be possible to calculate rho(G) using Paw_pwff, though. It should be faster but
1888 : : ! results will depend on the expression used for the matrix elements. This approach is safer.
1889 : 0 : use_aerhor=1
1890 [ # # ]: 0 : ABI_FREE(ks_aepaw_rhor)
1891 [ # # # # : 0 : ABI_MALLOC(ks_aepaw_rhor, (nfftf,Wfd%nspden))
# # # # #
# # # # #
# # ]
1892 : :
1893 : : ! Check if input density file is available, otherwise compute
1894 [ # # ]: 0 : pawden_fname = strcat(Dtfil%filnam_ds(3), '_PAWDEN')
1895 : 0 : call wrtout(std_out,sjoin('Checking for existence of:',pawden_fname))
1896 [ # # ]: 0 : if (file_exists(pawden_fname)) then
1897 : : ! Read density from file
1898 [ # # # # : 0 : ABI_MALLOC(tmp_pawrhoij, (cryst%natom*wfd%usepaw))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
1899 : :
1900 : : call read_rhor(pawden_fname, cplex1, nfftf_tot, Wfd%nspden, ngfftf, 1, MPI_enreg_seq, &
1901 : 0 : ks_aepaw_rhor, Hdr_rhor, tmp_pawrhoij, wfd%comm)
1902 : :
1903 : 0 : call Hdr_rhor%free()
1904 : 0 : call pawrhoij_free(tmp_pawrhoij)
1905 [ # # # # : 0 : ABI_FREE(tmp_pawrhoij)
# # # # #
# # # # #
# # # # ]
1906 : : else
1907 : : ! Have to calculate PAW AW rhor from scratch
1908 [ # # # # : 0 : ABI_MALLOC(qp_rhor_n_one, (pawfgr%nfft,Dtset%nspden))
# # # # #
# # # # #
# # ]
1909 [ # # # # : 0 : ABI_MALLOC(qp_rhor_nt_one, (pawfgr%nfft,Dtset%nspden))
# # # # #
# # # ]
1910 : :
1911 : : ! FIXME
1912 : 0 : ABI_WARNING(" denfgr in sigma seems to produce wrong results")
1913 [ # # ]: 0 : write(std_out,*)" input tilde ks_rhor integrates: ",SUM(ks_rhor(:,1))*Cryst%ucvol/nfftf
1914 : :
1915 : : call denfgr(Cryst%atindx1,Cryst%gmet,comm,Cryst%natom,Cryst%natom,Cryst%nattyp,ngfftf,ks_nhat,Wfd%nspinor,&
1916 : : Wfd%nsppol,Wfd%nspden,Cryst%ntypat,Pawfgr,Pawrad,KS_Pawrhoij,Pawtab,Dtset%prtvol, &
1917 : 0 : ks_rhor,ks_aepaw_rhor,qp_rhor_n_one,qp_rhor_nt_one,Cryst%rprimd,Cryst%typat,Cryst%ucvol,Cryst%xred)
1918 : :
1919 [ # # ]: 0 : ABI_FREE(qp_rhor_n_one)
1920 [ # # ]: 0 : ABI_FREE(qp_rhor_nt_one)
1921 : : end if
1922 : :
1923 [ # # ]: 0 : write(msg,'(a,f8.4)')' sigma: PAW AE density used for PPmodel integrates to: ',SUM(ks_aepaw_rhor(:,1))*Cryst%ucvol/nfftf
1924 : 0 : call wrtout(std_out, msg)
1925 : :
1926 [ # # ]: 0 : if (epsm1%mqmem /= 0) then
1927 : : ! Calculate ppmodel parameters for all q-points.
1928 : 0 : call PPm%setup(Cryst,Qmesh,epsm1%npwe,epsm1%nomega,epsm1%omega,epsm1%epsm1,nfftf,Gsph_c%gvec,ngfftf,ks_aepaw_rhor(:,1))
1929 : : end if
1930 : :
1931 : : else
1932 : : ! NC or PAW with PPmodel 1.
1933 [ + + ]: 135 : if (epsm1%mqmem /= 0) then
1934 : : ! Calculate ppmodel parameters for all q-points
1935 : 118 : call PPm%setup(Cryst, Qmesh, epsm1%npwe, epsm1%nomega, epsm1%omega, epsm1%epsm1, nfftf, Gsph_c%gvec, ngfftf, ks_rhor(:,1))
1936 : : end if
1937 : : end if ! PAW or NC PPm and/or needs density
1938 : :
1939 : : ! If epsm1 is MPI-shared, we have to close the RMA epoch.
1940 [ + + ]: 135 : if (epsm1%use_mpi_shared_win) then
1941 : 24 : call xmpi_win_fence(XMPI_MODE_NOSUCCEED, epsm1%epsm1_win, ierr)
1942 : 24 : ABI_CHECK_MPI(ierr, "")
1943 : : end if
1944 : : end if ! sigma_needs_ppm
1945 : :
1946 : 206 : call pstat_proc%print(_PSTAT_ARGS_)
1947 : 206 : call timab(409,2,tsec) ! getW
1948 : :
1949 [ + + ]: 206 : if (wfd%my_rank == master) then
1950 : : ! Write info on the run on ab_out, then open files to store final results.
1951 : 178 : call ks_ebands%report_gap(header='KS Band Gaps',unit=ab_out)
1952 [ + - ]: 178 : if(dtset%ucrpa == 0) call write_sigma_header(Sigp,epsm1,Cryst,Kmesh,Qmesh)
1953 : :
1954 : : ! unt_gw: File with GW corrections.
1955 : : ! unt_sig: Self-energy as a function of frequency.
1956 : : ! unt_sgr: Derivative wrt omega of the Self-energy.
1957 : : ! unt_sigc: Sigma_c(eik) MRM
1958 : : ! unt_sgm: Sigma on the Matsubara axis (imag axis)
1959 : :
1960 [ - + ]: 178 : if (open_file(Dtfil%fnameabo_gw, msg, unit=unt_gw, status='unknown', form='formatted') /= 0) then
1961 : 0 : ABI_ERROR(msg)
1962 : : end if
1963 : 178 : write(unt_gw,"(a)")"# QP energies E in eV"
1964 : 178 : write(unt_gw,"(a)")"# Format:"
1965 : 178 : write(unt_gw,"(a)")"# kpoint"
1966 : 178 : write(unt_gw,"(a)")"# number of bands computed"
1967 : 178 : write(unt_gw,"(2a)")"# band index, Re(E), E-E0, Im(E)", ch10
1968 : 178 : write(unt_gw,"(2(i0,1x),a)")Sigp%nkptgw,Sigp%nsppol, "# nkptgw, nsppol"
1969 : :
1970 [ - + ]: 178 : if (open_file(Dtfil%fnameabo_gwdiag, msg, unit=unt_gwdiag, status='unknown', form='formatted') /= 0) then
1971 : 0 : ABI_ERROR(msg)
1972 : : end if
1973 : 178 : write(unt_gwdiag,*)Sigp%nkptgw,Sigp%nsppol
1974 : :
1975 [ - + ]: 178 : if (open_file(Dtfil%fnameabo_sig, msg, unit=unt_sig, status='unknown', form='formatted') /= 0) then
1976 : 0 : ABI_ERROR(msg)
1977 : : end if
1978 : 178 : write(unt_sig,"(a)")"# Sigma_xc and spectral function A along the real frequency axis in eV units"
1979 : 178 : write(unt_sig,"(a)")"# Format:"
1980 : 178 : write(unt_sig,"(a)")"# kpoint"
1981 : 178 : write(unt_sig,"(a)")"# min_band(k) max_band(k)"
1982 : 178 : write(unt_sig,"(a)")"# For each frequency w:"
1983 : 178 : write(unt_sig,"(2a)")"# w, {Re(Sigma_b(w)), Im(Sigma_b(w), A_b(w) for b in [min_band, max_band]}",ch10
1984 : :
1985 [ - + ]: 178 : if (open_file(Dtfil%fnameabo_sgr, msg, unit=unt_sgr, status='unknown', form='formatted') /= 0) then
1986 : 0 : ABI_ERROR(msg)
1987 : : end if
1988 : 178 : write(unt_sgr,"(a)")"# Derivatives of Sigma_c(omega) wrt omega in eV units"
1989 : :
1990 : : ! Sigma_c(eik) MRM
1991 [ - + ]: 178 : if (open_file(trim(Dtfil%fnameabo_sgr)//'_SIGC', msg, unit=unt_sigc, status='unknown', form='formatted') /= 0) then
1992 : 0 : ABI_ERROR(msg)
1993 : : end if
1994 : :
1995 [ + + ]: 178 : if (mod10 == SIG_GW_AC) then
1996 : : ! Sigma along the imaginary axis.
1997 [ - + ]: 9 : if (open_file(Dtfil%fnameabo_sgm, msg, unit=unt_sgm, status='unknown', form='formatted') /= 0) then
1998 : 0 : ABI_ERROR(msg)
1999 : : end if
2000 : 9 : write(unt_sgm,"(a)")"# Sigma_xc along the imaginary frequency axis in eV units"
2001 : : end if
2002 : : end if
2003 : :
2004 : : !=======================================================================
2005 : : !==== Calculate self-energy and output the results for each k-point ====
2006 : : !=======================================================================
2007 : : ! Here it would be possible to calculate the QP correction for the same k-point using a PPmodel
2008 : : ! in the first iteration just to improve the initial guess and CD or AC in the second step. Useful
2009 : : ! if the KS level is far from the expected QP results. Previously it was possible to do such
2010 : : ! calculation by simply listing the same k-point twice in kptgw. Now this trick is not allowed anymore.
2011 : : ! Everything, indeed, should be done in a clean and transparent way inside csigme.
2012 : :
2013 [ + + ]: 412 : call wfd%print([std_out])
2014 : 206 : call wrtout(std_out, sigma_type_from_key(mod10))
2015 : :
2016 [ + + ]: 206 : if (gwcalctyp < 10) then
2017 : 130 : msg = " Perturbative Calculation"
2018 [ + + ]: 130 : if (gwcalctyp == 1) msg = " Newton Raphson method "
2019 [ + + ]: 76 : else if (gwcalctyp < 20) then
2020 : 11 : msg = " Self-Consistent on Energies only"
2021 [ + + ]: 65 : else if (gwcalctyp == 21) then
2022 : 5 : msg = " GW 1-RDM Corrections"
2023 : : else
2024 : 60 : msg = " Self-Consistent on Energies and Wavefunctions"
2025 : : end if
2026 [ + - ]: 206 : if (Dtset%ucrpa == 0) call wrtout(std_out,msg)
2027 : :
2028 : : !=================================================
2029 : : !==== Calculate the matrix elements of Sigma =====
2030 : : !=================================================
2031 : :
2032 [ + + ]: 206 : nomega_sigc=Sr%nomega_r+Sr%nomega4sd; if (mod10==SIG_GW_AC) nomega_sigc=Sr%nomega_i
2033 : :
2034 : : ! min and max band indices for GW corrections.
2035 : 206 : ib1=Sigp%minbdgw; ib2=Sigp%maxbdgw
2036 : :
2037 : : !MG TODO: I don't like the fact that ib1 and ib2 are redefined here because this
2038 : : ! prevents me from refactoring the code. In particular I want to store the self-energy
2039 : : ! results inside the sigma_results datatypes hence one needs to know all the dimensions
2040 : : ! at the beginning of the execution (e.g. in setup_sigma) so that one can easily allocate the arrays in the type.
2041 [ - + ]: 206 : if (Dtset%ucrpa >= 1) then
2042 : : ! Read the band
2043 [ # # ]: 0 : if (dtset%plowan_compute<10)then
2044 [ # # ]: 0 : if (open_file("forlb.ovlp",msg,newunit=temp_unt,form="formatted", status="unknown") /= 0) then
2045 : 0 : ABI_ERROR(msg)
2046 : : end if
2047 : 0 : rewind(temp_unt)
2048 : 0 : read(temp_unt,*)
2049 : 0 : read(temp_unt,*)
2050 : 0 : read(temp_unt,*) msg, ib1, ib2
2051 : 0 : close(temp_unt)
2052 : : else
2053 [ # # ]: 0 : if (open_file("data.plowann",msg,newunit=temp_unt,form="formatted", status="unknown") /= 0) then
2054 : 0 : ABI_ERROR(msg)
2055 : : end if
2056 : 0 : rewind(temp_unt)
2057 : 0 : read(temp_unt,*)
2058 : 0 : read(temp_unt,*)
2059 : 0 : read(temp_unt,'(a7,2i4)') msg, ib1, ib2
2060 : 0 : close(temp_unt)
2061 : : endif
2062 : : endif
2063 : :
2064 : : ! Do not store it for rdm_update because it might be too large!
2065 [ + + ]: 206 : if (.not. rdm_update) then
2066 [ - + + - : 285616 : ABI_CALLOC(sigcme, (nomega_sigc,ib1:ib2,ib1:ib2,Sigp%nkptgw,Sigp%nsppol*Sigp%nsig_ab))
- + + - -
+ + - - +
+ - - + +
- + - + -
- + - + +
+ + + + +
+ + + + ]
2067 : : endif
2068 : :
2069 : : ! if (.False. .and. psps%usepaw == 0 .and. wfd%nspinor == 1 .and. any(dtset%so_psp /= 0)) then
2070 : : ! call wrtout(std_out, "Computing SOC contribution with first-order perturbation theory")
2071 : : ! ABI_MALLOC(bks_mask, (wfd%mband, wfd%nkibz, wfd%nsppol))
2072 : : ! bks_mask = .False.
2073 : : ! do spin=1,wfd%nsppol
2074 : : ! do ikcalc=1,Sigp%nkptgw
2075 : : ! ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc)) ! Irred k-point for GW
2076 : : ! ii=Sigp%minbnd(ikcalc, spin); jj=Sigp%maxbnd(ikcalc, spin)
2077 : : ! bks_mask(ii:jj, ik_ibz, spin) = .True.
2078 : : ! end do
2079 : : ! end do
2080 : : !
2081 : : ! call wfd_get_socpert(wfd, cryst, psps, pawtab, bks_mask, osoc_bks)
2082 : : ! ABI_FREE(bks_mask)
2083 : : ! ABI_FREE(osoc_bks)
2084 : : ! end if
2085 : :
2086 : : !==========================================================
2087 : : !==== Exchange part using the dense gwx_ngfft FFT mesh ====
2088 : : !==========================================================
2089 : : !TODO : load distribution is not optimal if band parallelism is used.
2090 : : !but this problem was also affecting the old implementation.
2091 : 206 : call timab(421,1,tsec) ! calc_sigx_me
2092 : :
2093 : : ! This routine shows how the wavefunctions are distributed.
2094 : : !call wfd_show_bkstab(Wfd,unit=std_out)
2095 : :
2096 [ - + ]: 206 : if (Dtset%ucrpa>=1) then
2097 : : ! Calculation of the Rho_n for calc_ucrpa
2098 : 0 : call wrtout(std_out, sjoin("begin of Ucrpa calc for a nb of kpoints of: ",itoa(Sigp%nkptgw)))
2099 : : ! Wannier basis: rhot1_q_m will need an atom index in the near future.
2100 : 0 : ic=0
2101 [ # # ]: 0 : do itypat=1,cryst%ntypat
2102 [ # # ]: 0 : if(pawtab(itypat)%lpawu.ne.-1) then
2103 : 0 : ndim=2*dtset%lpawu(itypat)+1
2104 : 0 : ic=ic+1
2105 : 0 : itypatcor=itypat
2106 : 0 : lcor=dtset%lpawu(itypat)
2107 : : end if
2108 : : end do
2109 [ # # ]: 0 : if(ic>1) then
2110 : 0 : ABI_ERROR("number of correlated species is larger than one")
2111 : : end if
2112 [ # # # # : 0 : ABI_MALLOC(rhot1_q_m, (cryst%nattyp(itypatcor),Wfd%nspinor,Wfd%nspinor,ndim,ndim,sigp%npwx,Qmesh%nibz))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
2113 [ # # # # : 0 : ABI_MALLOC(M1_q_m, (cryst%nattyp(itypatcor),Wfd%nspinor,Wfd%nspinor,ndim,ndim,sigp%npwx,Qmesh%nibz))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
2114 : :
2115 [ # # # # : 0 : M1_q_m=czero
# # # # #
# # # #
# ]
2116 [ # # # # : 0 : rhot1_q_m=czero
# # # # #
# # # #
# ]
2117 : :
2118 : : !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
2119 : : !Initialization of wan objects and getting psichies
2120 : : !Allocation of rhot1
2121 : : !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
2122 [ # # ]: 0 : if (dtset%plowan_compute>=10)then
2123 : 0 : call wrtout(units, " cRPA calculations using wannier weights from data.plowann")
2124 : : call init_plowannier(dtset%plowan_bandf,dtset%plowan_bandi,dtset%plowan_compute,dtset%plowan_iatom,&
2125 : : dtset%plowan_it,dtset%plowan_lcalc,dtset%plowan_natom,dtset%plowan_nbl,dtset%plowan_nt,&
2126 : : dtset%plowan_projcalc,dtset%acell_orig,dtset%kptns,sum(dtset%plowan_nbl),dtset%nimage,dtset%nkpt,dtset%nspinor,&
2127 [ # # ]: 0 : dtset%nsppol,dtset%wtk,dtset%dmft_t2g,wanibz_in)
2128 : 0 : call get_plowannier(wanibz_in,wanibz,dtset)
2129 : 0 : call fullbz_plowannier(dtset,kmesh,cryst,pawang,wanibz,wanbz)
2130 [ # # # # : 0 : ABI_MALLOC(rhot1,(sigp%npwx,Qmesh%nibz))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
2131 [ # # ]: 0 : do pwx=1,sigp%npwx
2132 [ # # ]: 0 : do ibz=1,Qmesh%nibz
2133 : 0 : call init_operwan_realspace(wanbz,rhot1(pwx,ibz))
2134 : 0 : call zero_operwan_realspace(wanbz,rhot1(pwx,ibz))
2135 : : end do
2136 : : end do
2137 : : endif
2138 : :
2139 : : !do ikcalc=1,Sigp%nkptgw
2140 : : !if(cryst%nsym==1) nkcalc=Kmesh%nbz
2141 : : !if(cryst%nsym>1) nkcalc=Kmesh%nibz
2142 : 0 : nkcalc=Kmesh%nbz
2143 : : !if(1==1)then!DEBUG
2144 : : !open(67,file="test.rhot1",status="REPLACE")
2145 [ # # ]: 0 : do ikcalc=1,nkcalc ! for the oscillator strength, spins are identical without SOC
2146 : : ! if(Sigp%nkptgw/=Kmesh%nbz) then
2147 : : ! write(msg,'(6a)')ch10,&
2148 : : !& ' nkptgw and nbz differs: this is not allowed to compute U in cRPA '
2149 : : ! ABI_ERROR(msg)
2150 : : ! endif
2151 : 0 : write(std_out,*) " ikcalc",ikcalc,size(Sigp%kptgw2bz),nkcalc
2152 : :
2153 [ # # ]: 0 : if(mod(ikcalc-1,nprocs)==Wfd%my_rank) then
2154 [ # # ]: 0 : if(cryst%nsym==1) ik_ibz=Kmesh%tab(ikcalc) ! Index of the irred k-point for GW
2155 [ # # ]: 0 : if(cryst%nsym>1) ik_ibz=Kmesh%tab(Sigp%kptgw2bz(ikcalc)) ! Index of the irred k-point for GW
2156 : :
2157 : : call prep_calc_ucrpa(ik_ibz,ikcalc,itypatcor,ib1,ib2,Cryst,qp_ebands,Sigp,Gsph_x,Vcp,&
2158 : : & Kmesh,Qmesh,lcor,M1_q_m,Pawtab,Pawang,Paw_pwff,&
2159 : : & Pawfgrtab,Paw_onsite,Psps,Wfd,Wfdf,QP_sym,gwx_ngfft,&
2160 [ # # ]: 0 : & ngfftf,Dtset%prtvol,Dtset%pawcross,Dtset%plowan_compute,rhot1_q_m,wanbz,rhot1)
2161 : : end if
2162 : : end do
2163 [ # # ]: 0 : if (dtset%plowan_compute<10)then
2164 : 0 : call xmpi_sum(rhot1_q_m,Wfd%comm,ierr)
2165 : 0 : call xmpi_sum(M1_q_m,Wfd%comm,ierr)
2166 [ # # # # : 0 : M1_q_m=M1_q_m/Kmesh%nbz/Wfd%nsppol
# # # # #
# # # #
# ]
2167 [ # # # # : 0 : rhot1_q_m=rhot1_q_m/Kmesh%nbz/Wfd%nsppol
# # # # #
# # # #
# ]
2168 : : !do pwx=1,sigp%npwx; do ibz=1,Qmesh%nibz; do ispinor1=1,dtset%nspinor; do ispinor2=1,dtset%nspinor; do iatom1=1,cryst%nattyp(itypatcor)
2169 : : ! do im1=1,2*lcor+1; do im2=1,2*lcor+1
2170 : : ! write(67,*)ibz,im1,im2,rhot1_q_m(iatom1,ispinor1,ispinor2,im1,im2,pwx,ibz)
2171 : : !enddo; enddo; enddo; enddo; enddo; enddo; enddo
2172 : : else
2173 : 0 : call reduce_operwan_realspace(wanbz,rhot1,sigp%npwx,Qmesh%nibz,Wfd%comm,Kmesh%nbz,Wfd%nsppol)
2174 : : !call cwtime(cpu,wall,gflops,"start") !reduction of rhot1
2175 : : ! dim=0
2176 : : ! do pwx=1,sigp%npwx; do ibz=1,Qmesh%nibz
2177 : : ! do spin=1,wanbz%nsppol; do ispinor1=1,wanbz%nspinor; ispinor2=1,wanbz%nspinor
2178 : : ! do iatom1=1,wanbz%natom_wan; do iatom2=1,wanbz%natom_wan
2179 : : ! do pos1=1,size(wanbz%nposition(iatom1)%pos,1); do pos2=1,size(wanbz%nposition(iatom2)%pos,1)
2180 : : ! do il1=1,wanbz%nbl_atom_wan(iatom1); do il2=1,wanbz%nbl_atom_wan(iatom2)
2181 : : ! do im1=1,2*wanbz%latom_wan(iatom1)%lcalc(il1)+1
2182 : : ! do im2=1,2*wanbz%latom_wan(iatom2)%lcalc(il2)+1
2183 : : ! dim=dim+1
2184 : : ! enddo!im2
2185 : : ! enddo!im1
2186 : : ! enddo!il2
2187 : : ! enddo!il1
2188 : : ! enddo!pos2
2189 : : ! enddo!pos1
2190 : : ! enddo!iatom2
2191 : : ! enddo!iatom1
2192 : : ! enddo!ispinor2
2193 : : ! enddo!ispinor1
2194 : : ! enddo!spin
2195 : : ! enddo!ibz
2196 : : ! enddo!pwx
2197 : : ! ABI_MALLOC(buffer,(dim))
2198 : : ! nnn=0
2199 : : ! do pwx=1,sigp%npwx; do ibz=1,Qmesh%nibz; do spin=1,wanbz%nsppol; do ispinor1=1,wanbz%nspinor; do ispinor2=1,wanbz%nspinor
2200 : : ! do iatom1=1,wanbz%natom_wan; do iatom2=1,wanbz%natom_wan
2201 : : ! do pos1=1,size(wanbz%nposition(iatom1)%pos,1); do pos2=1,size(wanbz%nposition(iatom2)%pos,1)
2202 : : ! do il1=1,wanbz%nbl_atom_wan(iatom1); do il2=1,wanbz%nbl_atom_wan(iatom2)
2203 : : ! do im1=1,2*wanbz%latom_wan(iatom1)%lcalc(il1)+1
2204 : : ! do im2=1,2*wanbz%latom_wan(iatom2)%lcalc(il2)+1
2205 : : ! nnn=nnn+1
2206 : : ! buffer(nnn)=rhot1(pwx,ibz)%atom_index(iatom1,iatom2)%position(pos1,pos2)%atom(il1,il2)%matl(im1,im2,spin,ispinor1,ispinor2)
2207 : : ! enddo; enddo; enddo; enddo; enddo; enddo; enddo; enddo; enddo; enddo; enddo; enddo; enddo
2208 : : ! call xmpi_sum(buffer,Wfd%comm,ierr)
2209 : : ! buffer=buffer/Kmesh%nbz/Wfd%nsppol
2210 : : ! nnn=0
2211 : : ! do pwx=1,sigp%npwx; do ibz=1,Qmesh%nibz; do spin=1,wanbz%nsppol; do ispinor1=1,wanbz%nspinor; do ispinor2=1,wanbz%nspinor
2212 : : ! do iatom1=1,wanbz%natom_wan; do iatom2=1,wanbz%natom_wan
2213 : : ! do pos1=1,size(wanbz%nposition(iatom1)%pos,1); do pos2=1,size(wanbz%nposition(iatom2)%pos,1)
2214 : : ! do il1=1,wanbz%nbl_atom_wan(iatom1); do il2=1,wanbz%nbl_atom_wan(iatom2)
2215 : : ! do im1=1,2*wanbz%latom_wan(iatom1)%lcalc(il1)+1
2216 : : ! do im2=1,2*wanbz%latom_wan(iatom2)%lcalc(il2)+1
2217 : : ! nnn=nnn+1
2218 : : ! rhot1(pwx,ibz)%atom_index(iatom1,iatom2)%position(pos1,pos2)%atom(il1,il2)%matl(im1,im2,spin,ispinor1,ispinor2)=buffer(nnn)
2219 : : ! !write(67,*)ibz,im1,im2,rhot1(pwx,ibz)%atom_index(iatom1,iatom2)%position(pos1,pos2)%atom(il1,il2)%matl(im1,im2,spin,ispinor1,ispinor2)
2220 : : ! enddo; enddo; enddo;enddo; enddo; enddo;enddo; enddo; enddo; enddo; enddo; enddo; enddo
2221 : : ! ABI_FREE(buffer)
2222 : : endif
2223 : :
2224 : : !close(67)
2225 : : ! call xmpi_barrier(Wfd%comm)
2226 : : ! call cwtime(cpu,wall,gflops,"stop")!reduction of rhot1
2227 : : ! write(6,*)cpu,wall,gflops
2228 : : ! if(Cryst%nsym==1) then
2229 : : ! M1_q_m=M1_q_m/Kmesh%nbz/Wfd%nsppol
2230 : : ! rhot1_q_m=rhot1_q_m/Kmesh%nbz/Wfd%nsppol
2231 : : ! endif
2232 : : ! Calculation of U in cRPA: need to treat with a different cutoff the
2233 : : ! bare coulomb and the screened coulomb interaction.
2234 : : ! else !DEBUG
2235 : : ! write(6,*)"DEBUGGING calc_ucrpa"
2236 : : ! open(67,file="test.rhot1",status="OLD")
2237 : : ! rewind(67)
2238 : : ! do pwx=1,sigp%npwx
2239 : : ! do ibz=1,Qmesh%nibz
2240 : : ! do spin=1,wanbz%nsppol
2241 : : ! do ispinor1=1,wanbz%nspinor
2242 : : ! do ispinor2=1,wanbz%nspinor
2243 : : ! do iatom1=1,wanbz%natom_wan
2244 : : ! do iatom2=1,wanbz%natom_wan
2245 : : ! do pos1=1,size(wanbz%nposition(iatom1)%pos,1)
2246 : : ! do pos2=1,size(wanbz%nposition(iatom2)%pos,1)
2247 : : ! do il1=1,wanbz%nbl_atom_wan(iatom1)
2248 : : ! do il2=1,wanbz%nbl_atom_wan(iatom2)
2249 : : ! do im1=1,2*wanbz%latom_wan(iatom1)%lcalc(il1)+1
2250 : : ! do im2=1,2*wanbz%latom_wan(iatom2)%lcalc(il2)+1
2251 : : ! read(67,*)dummy,dummy,dummy,xx
2252 : : ! rhot1(pwx,ibz)%atom_index(iatom1,iatom2)%position(pos1,pos2)%atom(il1,il2)%matl(im1,im2,spin,ispinor1,ispinor2)=xx
2253 : : ! enddo!im2
2254 : : ! enddo!im1
2255 : : ! enddo!il2
2256 : : ! enddo!il1
2257 : : ! enddo!pos2
2258 : : ! enddo!pos1
2259 : : ! enddo!iatom2
2260 : : ! enddo!iatom1
2261 : : ! enddo!ispinor2
2262 : : ! enddo!ispinor1
2263 : : ! enddo!spin
2264 : : ! enddo!ibz
2265 : : ! enddo!pwx
2266 : : ! close(67)
2267 : : ! endif!DEBUG
2268 : : call calc_ucrpa(itypatcor,cryst,Kmesh,lcor,M1_q_m,Qmesh,epsm1%npwe,sigp%npwx,&
2269 : : Cryst%nsym,Sigp%nomegasr,Sigp%minomega_r,Sigp%maxomega_r,ib1,ib2,&
2270 : 0 : 'Gsum',Cryst%ucvol,Wfd,epsm1%fname,dtset%plowan_compute,rhot1,wanbz)
2271 : :
2272 : : !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
2273 : : !Deallocation of wan and rhot1
2274 : : !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
2275 [ # # ]: 0 : if (dtset%plowan_compute >=10) then
2276 [ # # ]: 0 : do pwx=1,sigp%npwx
2277 [ # # ]: 0 : do ibz=1,Qmesh%nibz
2278 : 0 : call destroy_operwan_realspace(wanbz,rhot1(pwx,ibz))
2279 : : end do
2280 : : end do
2281 [ # # # # : 0 : ABI_FREE(rhot1)
# # # # #
# # # # #
# # # # #
# # # ]
2282 : 0 : call destroy_plowannier(wanbz)
2283 : : endif
2284 [ # # ]: 0 : ABI_FREE(rhot1_q_m)
2285 [ # # ]: 0 : ABI_FREE(M1_q_m)
2286 : :
2287 : : else
2288 : : ! MRM: sigmak_todo is an array indicating whether the k-point must be computed for GW correction.
2289 : : ! This array is set to DO IT (to 1) for any GW calculation
2290 : : ! and it will only change to NOT DO IT (to 0) in case that a density matrix update calc. is used and we are reading checkpoint files
2291 [ - + + - : 618 : ABI_MALLOC(sigmak_todo,(Wfd%nkibz))
+ - + - -
+ - + -
+ ]
2292 [ + + ]: 1443 : sigmak_todo(:)=1
2293 : :
2294 : : ! ======================================================
2295 : : ! ==== Initialize arrays for density matrix updates ====
2296 : : ! ======================================================
2297 [ + + ]: 206 : if (rdm_update) then
2298 : : ! Note: all subroutines of 70_gw/m_gwrdm.F90 are implemented assuming nsppol == 1
2299 [ - + ]: 5 : ABI_CHECK(dtset%nsppol == 1, "1-RDM GW correction only implemented for restricted closed-shell calculations!")
2300 : :
2301 [ - + + - : 2225 : ABI_CALLOC(nateigv, (Wfd%mband, Wfd%mband, Wfd%nkibz, Sigp%nsppol))
- + + - -
+ + - - +
+ - + - +
- - + - +
- + + + +
+ + + +
+ ]
2302 [ - + + - : 290 : ABI_CALLOC(nat_occs, (Wfd%mband, Wfd%nkibz))
- + + - +
- + - - +
- + - + +
+ + + ]
2303 [ - + + - : 2119 : ABI_CALLOC(xrdm_k_full, (b1gw:b2gw, b1gw:b2gw, Wfd%nkibz))
- + + - -
+ + - + -
+ - - + -
+ + + + +
+ + ]
2304 : :
2305 : 5 : write(msg,'(a34,2i9)')' Bands used for the GW 1RDM arrays',b1gw,b2gw
2306 : 5 : call wrtout(units, msg)
2307 : :
2308 [ + + ]: 35 : do ik_ibz=1,Wfd%nkibz
2309 [ + + ]: 264 : do ib=b1gw,b2gw
2310 : 264 : xrdm_k_full(ib,ib,ik_ibz) = qp_ebands%occ(ib,ik_ibz,1)
2311 : : end do
2312 [ + + ]: 275 : do ib=1,Wfd%mband
2313 : : ! Copy initial occ numbers (in principle 2 or 0 from KS-DFT)
2314 : 240 : nat_occs(ib,ik_ibz) = qp_ebands%occ(ib,ik_ibz,1)
2315 : : ! Set to identity matrix
2316 : 270 : nateigv(ib,ib,ik_ibz,1) = cone
2317 : : end do
2318 : : end do
2319 [ + + ]: 5 : if (readchkprdm) then
2320 : 1 : gw1rdm_fname = trim(dtfil%fnameabi_chkp_rdm)
2321 : 1 : call get_chkprdm(Wfd,Kmesh,Sigp,qp_ebands,nat_occs,nateigv,sigmak_todo,my_rank,gw1rdm_fname)
2322 : : end if
2323 : 5 : call xmpi_barrier(Wfd%comm)
2324 : :
2325 : : ! Prepare arrays for the imaginary freq. integration (quadrature) of Sigma_c(iw)
2326 [ - + + - : 15 : ABI_MALLOC(weights, (Sigp%nomegasi))
+ - + - -
+ - + -
+ ]
2327 : 5 : call quadrature_sigma_cw(Sigp,Sr,weights)
2328 : : end if
2329 : :
2330 : : ! ===================================
2331 : : ! ==== Static part (Sigma_x-Vxc) ====
2332 : : ! ===================================
2333 [ + + ]: 850 : do ikcalc=1,Sigp%nkptgw
2334 : : ! Index of the irred k-point for GW
2335 : 644 : ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc))
2336 : 644 : call pstat_proc%print(_PSTAT_ARGS_)
2337 : :
2338 : : ! Do not compute MELS if the k-point was read from the checkpoint file
2339 : : ! this IF only affects GW density matrix update!
2340 : :
2341 [ + + ]: 850 : if (sigmak_todo(ik_ibz) == 1) then
2342 : : ! min and max band indices for GW corrections (for this k-point)
2343 [ + + ]: 1290 : ib1 = MINVAL(Sigp%minbnd(ikcalc,:))
2344 [ + + ]: 1290 : ib2 = MAXVAL(Sigp%maxbnd(ikcalc,:))
2345 : : call calc_sigx_me(ik_ibz,ikcalc,ib1,ib2,Cryst,qp_ebands,dtset, Sigp,Sr,Gsph_x,Vcp,Kmesh,Qmesh,Ltg_k(ikcalc),&
2346 : : Pawtab,Pawang,Paw_pwff,Pawfgrtab,Paw_onsite,Psps,Wfd,Wfdf,QP_sym,&
2347 [ - + ]: 641 : gwx_ngfft,ngfftf,Dtset%prtvol,Dtset%pawcross,tol_empty)
2348 : :
2349 [ + + ]: 641 : if (rdm_update) then
2350 : : ! Only recompute exchange update to the 1-RDM if the point read was broken or not precomputed
2351 : :
2352 : : ! Compute Sigma_x - Vxc or DELTA Sigma_x - Vxc
2353 : : ! where DELTA Sigma_x = Sigma_x - hyb_parameter Vx^exact for hyb Functionals.
2354 : : ! NB: Only restricted closed-shell calcs are implemented here
2355 [ - + + - : 1790 : ABI_CALLOC(pot_k, (ib1:ib2, ib1:ib2))
- + + - +
- + - - +
- + - + +
+ + + ]
2356 [ - + + - : 1763 : ABI_CALLOC(rdm_k, (ib1:ib2, ib1:ib2))
- + + - -
+ - + - +
+ + + + ]
2357 [ + + + + ]: 1709 : pot_k(ib1:ib2,ib1:ib2) = Sr%x_mat(ib1:ib2,ib1:ib2,ik_ibz,1) - KS_me%vxcval(ib1:ib2,ib1:ib2,ik_ibz,1)
2358 : :
2359 : 27 : call calc_rdmx(ib1, ib2, ik_ibz, pot_k, rdm_k, qp_ebands)
2360 : :
2361 : : ! Update the full 1RDM with the exchange corrected one for this k-point
2362 [ + + + + ]: 1709 : xrdm_k_full(ib1:ib2,ib1:ib2,ik_ibz) = xrdm_k_full(ib1:ib2,ib1:ib2,ik_ibz) + rdm_k(ib1:ib2,ib1:ib2)
2363 : :
2364 : : ! Compute NAT ORBS for exchange corrected 1-RDM
2365 [ + + ]: 223 : do ib=ib1,ib2
2366 : 223 : rdm_k(ib,ib) = rdm_k(ib,ib) + qp_ebands%occ(ib,ik_ibz,1) ! Only restricted closed-shell calcs
2367 : : end do
2368 : 27 : call natoccs(ib1, ib2, rdm_k, nateigv, nat_occs, qp_ebands, ik_ibz, iinfo=0) ! Only restricted closed-shell calcs
2369 [ - + ]: 27 : ABI_FREE(pot_k)
2370 [ - + ]: 27 : ABI_FREE(rdm_k)
2371 : : end if
2372 : : else
2373 : 3 : write(msg,'(a1)') ' '
2374 : 3 : call wrtout(std_out,msg)
2375 : 3 : write(msg,'(a64,i5)') ' Skipping the calc. of Sigma_x - ( Vxc + hyb*Fock) for k-point: ',ik_ibz
2376 : 3 : call wrtout(std_out,msg)
2377 : 3 : write(msg,'(a1)') ' '
2378 : 3 : call wrtout(std_out,msg)
2379 : : end if
2380 : : end do ! ikcalc
2381 : :
2382 : : ! for the time being, do not remove this barrier!
2383 : 206 : call xmpi_barrier(Wfd%comm)
2384 : 206 : call pstat_proc%print(_PSTAT_ARGS_)
2385 : 206 : call timab(421,2,tsec) ! calc_sigx_me
2386 : :
2387 : : ! ==========================================================
2388 : : ! ==== Correlation part using the coarse gwc_ngfft mesh ====
2389 : : ! ==========================================================
2390 [ + + ]: 206 : if (mod10/=SIG_HF) then
2391 [ + + ]: 645 : do ikcalc=1,Sigp%nkptgw
2392 : 474 : ik_ibz=Kmesh%tab(Sigp%kptgw2bz(ikcalc)) ! Index of the irred k-point for GW
2393 [ + + ]: 954 : ib1 = MINVAL(Sigp%minbnd(ikcalc,:)) ! min and max band indices for GW corrections (for this k-point)
2394 [ + + ]: 954 : ib2 = MAXVAL(Sigp%maxbnd(ikcalc,:))
2395 : :
2396 [ - + + - : 275259 : ABI_CALLOC(sigcme_k, (nomega_sigc,ib2-ib1+1,ib2-ib1+1,Sigp%nsppol*Sigp%nsig_ab))
+ - - + +
- - + + -
- + + - +
- + - - +
- + - + +
+ + + + +
+ + ]
2397 : :
2398 [ + + ]: 474 : if (any(mod10 == [SIG_SEX, SIG_COHSEX])) then
2399 : : ! Calculate static COHSEX or SEX using the coarse gwc_ngfft mesh.
2400 : : call cohsex_me(ik_ibz,ikcalc,nomega_sigc,ib1,ib2,dtset, Cryst,qp_ebands,Sigp,Sr,epsm1,Gsph_c,Vcp,Kmesh,Qmesh,&
2401 : : Ltg_k(ikcalc),Pawtab,Pawang,Paw_pwff,Psps,Wfd,QP_sym,&
2402 [ - + ]: 5 : gwc_ngfft,Dtset%iomode,Dtset%prtvol,sigcme_k)
2403 : : else
2404 : : ! Compute correlated part using the coarse gwc_ngfft mesh.
2405 [ + + + + ]: 469 : if (x1rdm/=1 .and. sigmak_todo(ik_ibz)==1) then
2406 : : ! Do not compute correlation MELS if the k-point was read from the checkpoint file
2407 : : ! this IF only affects GW density matrix update
2408 : : call calc_sigc_me(ik_ibz,ikcalc,nomega_sigc,ib1,ib2,Dtset,dtfil, Cryst,qp_ebands, &
2409 : : Sigp,Sr,epsm1,Gsph_Max,Gsph_c,Vcp,Kmesh,Qmesh,&
2410 : : Ltg_k(ikcalc),PPm,Pawtab,Pawang,Paw_pwff,Pawfgrtab,Paw_onsite,Psps,Wfd,Wfdf,QP_sym,&
2411 [ - + ]: 460 : gwc_ngfft,ngfftf,nfftf,ks_rhor,use_aerhor,ks_aepaw_rhor,sigcme_k)
2412 : : else
2413 : 9 : write(msg,'(a1)') ' '
2414 : 9 : call wrtout(std_out, msg)
2415 : 9 : write(msg,'(a44,i5)') ' Skipping the calc. of Sigma_c for k-point: ',ik_ibz
2416 : 9 : call wrtout(std_out, msg)
2417 : 9 : write(msg,'(a1)') ' '
2418 : 9 : call wrtout(std_out, msg)
2419 : : end if
2420 : : end if
2421 : :
2422 : : ! MRM: compute density matrix numerical correction (freq. integration G0 Sigma_c(iw) G0).
2423 [ + + ]: 474 : if (rdm_update) then
2424 [ + + ]: 30 : if (sigmak_todo(ik_ibz) == 1) then
2425 : : ! Only recompute correlation update to the 1-RDM if the point read was broken or not precomputed
2426 [ + + ]: 27 : if (x1rdm /= 1) then
2427 [ - + + - : 1334 : ABI_CALLOC(rdm_k, (ib1:ib2,ib1:ib2))
- + + - +
- + - - +
- + - + +
+ + + ]
2428 : 21 : call calc_rdmc(ib1, ib2, ik_ibz, Sr%omega_i, weights, sigcme_k, qp_ebands, rdm_k)
2429 : : ! Update the full 1RDM with the GW corrected one for this k-point
2430 : : ! Only restricted closed-shell calcs
2431 [ + + + + ]: 1271 : rdm_k(ib1:ib2,ib1:ib2) = xrdm_k_full(ib1:ib2,ib1:ib2,ik_ibz) + rdm_k(ib1:ib2,ib1:ib2)
2432 : : ! Compute nat orbs and occ numbers at k-point ik_ibz
2433 : 21 : call natoccs(ib1, ib2, rdm_k, nateigv, nat_occs, qp_ebands, ik_ibz, iinfo=1)
2434 [ - + ]: 21 : ABI_FREE(rdm_k)
2435 : : endif
2436 : : ! Print the checkpoint file if required
2437 [ + + ]: 27 : if (prtchkprdm) then
2438 : 6 : gw1rdm_fname = trim(dtfil%fnameabo_chkp_rdm)
2439 : 6 : call print_chkprdm(Wfd,nat_occs,nateigv,ik_ibz,my_rank,gw1rdm_fname)
2440 : : end if
2441 : : end if
2442 : : else
2443 [ + + + + : 214331 : sigcme(:,ib1:ib2,ib1:ib2,ikcalc,:) = sigcme_k
+ + + + ]
2444 : : end if
2445 [ - + ]: 645 : ABI_FREE(sigcme_k)
2446 : : end do
2447 : 171 : call xmpi_barrier(Wfd%comm)
2448 [ + + ]: 171 : if (rdm_update) then
2449 [ - + ]: 5 : ABI_FREE(xrdm_k_full)
2450 [ - + ]: 5 : ABI_FREE(weights)
2451 : : end if
2452 : : end if
2453 : :
2454 : 206 : call xmpi_barrier(Wfd%comm)
2455 [ - + ]: 206 : ABI_FREE(sigmak_todo)
2456 : :
2457 : : ! 1) Print WFK and DEN files.
2458 : : ! 2) Build band corrections and compute new energies.
2459 [ + + ]: 206 : if (rdm_update) then
2460 [ - + + - : 19025 : ABI_CALLOC(gw_rhor, (nfftf, dtset%nspden))
- + + - +
- + - - +
- + - + +
+ + + ]
2461 : : !
2462 : : ! NRM WARNING: only the master has bands on Wfd_nato_master so it prints everything and computes gw_rhor
2463 : : !
2464 : : ! All procs. update the qp_ebands and the Hdr_sigma
2465 : 5 : call update_hdr_bst(Wfd_nato_master, nat_occs, b1gw, b2gw, qp_ebands, Hdr_sigma, Dtset%ngfft(1:3))
2466 : :
2467 : : ! Compute unit cell (averaged) occ = \sum _k weight_k occ_k
2468 : 5 : call print_tot_occ(qp_ebands)
2469 : :
2470 [ + - ]: 5 : if (my_rank == master) then
2471 : 5 : call Wfd_nato_master%rotate(cryst, nateigv, bmask=bdm_mask) ! Let it use bdm_mask and build NOs
2472 : 5 : call Wfd_nato_master%mkrho(cryst, psps, qp_ebands, ngfftf, nfftf, gw_rhor) ! Construct the density
2473 [ + - ]: 5 : if (dtset%prtwf == 1) then
2474 : : ! Print WFK file, here qp_ebands contains nat. orb. occs.
2475 : 5 : call Wfd_nato_master%write_wfk(Hdr_sigma, qp_ebands, dtfil%fnameabo_wfk, wfknocheck=.True.)
2476 : : end if
2477 [ + - ]: 5 : if (dtset%prtden == 1) then
2478 : : ! Print DEN file
2479 : : call fftdatar_write("density",dtfil%fnameabo_den,dtset%iomode,Hdr_sigma,&
2480 : 5 : Cryst,ngfftf,cplex1,nfftf,dtset%nspden,gw_rhor,mpi_enreg_seq,ebands=qp_ebands)
2481 : : end if
2482 : : end if
2483 : 5 : call xmpi_bcast(gw_rhor,master, Wfd%comm, ierr)
2484 : :
2485 : : ! We no longer need Wfd_nato_master.
2486 : 5 : call Wfd_nato_master%free()
2487 : 5 : call xmpi_barrier(Wfd%comm)
2488 : :
2489 [ - + ]: 5 : ABI_FREE(bdm_mask) ! The master already used bdm_mask
2490 [ - + ]: 5 : ABI_FREE(nat_occs) ! Occs were already placed in qp_ebands
2491 : 5 : call epsm1%free() ! We no longer need epsm1 for GW@KS-DFT 1RDM but we may need space on the RAM memory
2492 : :
2493 [ + + + - ]: 5 : if (gw1rdm==2 .and. Sigp%nkptgw==Wfd%nkibz) then
2494 : : ! Compute energies only if all k-points are available
2495 : : ! We need the hole 1-RDM to build Fock[GW.1RDM]!
2496 [ - + + - : 232 : ABI_CALLOC(old_ks_purex, (b1gw:b2gw, Sigp%nkptgw))
- + + - +
- + - - +
- + - + +
+ + + ]
2497 [ - + + - : 228 : ABI_CALLOC(new_hartr, (b1gw:b2gw, Sigp%nkptgw))
- + + - -
+ - + - +
+ + + + ]
2498 [ - + + - : 33012 : ABI_CALLOC(gw_rhog, (2, nfftf))
+ - + - -
+ - + + +
+ + ]
2499 [ - + + - : 11012 : ABI_CALLOC(gw_vhartr, (nfftf))
+ - + - -
+ - + +
+ ]
2500 : : !
2501 : : ! A) Compute Evext = int rho(r) vext(r) dr -> simply dot product on the FFT grid
2502 : : ! Only restricted closed-shell calcs
2503 : : !
2504 [ + + ]: 11004 : den_int = sum(gw_rhor(:,1)) * ucvol / nfftf
2505 [ + + ]: 11004 : evext_energy = sum(gw_rhor(:,1) * vpsp(:)) * ucvol / nfftf
2506 : : !
2507 : : ! B) Coulomb <KS_i|Vh[NO]|KS_j>
2508 : : !
2509 : : ! FFT to build gw_rhog
2510 : 4 : call fourdp(1, gw_rhog, gw_rhor(:,1), -1, MPI_enreg_seq, nfftf, ndat1, ngfftf, tim_fourdp5)
2511 : 4 : ecutf = dtset%ecut
2512 [ - + ]: 4 : if (psps%usepaw == 1) then
2513 : 0 : ecutf = dtset%pawecutdg
2514 : 0 : call wrtout(std_out, ch10//' FFT (fine) grid used in PAW GW update:')
2515 : : end if
2516 : 4 : call getcut(boxcut, ecutf, gmet, gsqcut, dtset%iboxcut, std_out, k0, ngfftf)
2517 : : call hartre(1, gsqcut, dtset%icutcoul, psps%usepaw, MPI_enreg_seq, nfftf, ngfftf, dtset%nkpt, dtset%rcut, &
2518 : 4 : gw_rhog, cryst%rprimd, dtset%vcutgeo, gw_vhartr)
2519 : :
2520 : : ! Build Vhartree -> gw_vhartr
2521 [ - + + - : 92 : ABI_ICALLOC(tmp_kstab, (2,Wfd%nkibz,Wfd%nsppol))
- + + - +
- + - - +
- + + + +
+ + + ]
2522 [ + + ]: 8 : do spin=1,Sigp%nsppol
2523 [ + + ]: 32 : do ikcalc=1,Sigp%nkptgw
2524 : 24 : ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc))
2525 : 24 : tmp_kstab(1,ik_ibz,spin)=Sigp%minbnd(ikcalc,spin)
2526 : 28 : tmp_kstab(2,ik_ibz,spin)=Sigp%maxbnd(ikcalc,spin)
2527 : : end do
2528 : : end do
2529 : :
2530 : : ! Build matrix elements from gw_vhartr -> GW1RDM_me
2531 : : call calc_vhxc_me(Wfd,KS_mflags,GW1RDM_me,Cryst,Dtset,nfftf,ngfftf,&
2532 : : ks_vtrial,gw_vhartr,ks_vxc,Psps,Pawtab,KS_paw_an,Pawang,Pawfgrtab,KS_paw_ij,dijexc_core,&
2533 : 4 : gw_rhor,usexcnhat,ks_nhat,ks_nhatgr,nhatgrdim,tmp_kstab,taur=ks_taur)
2534 : :
2535 : 4 : call xmpi_barrier(Wfd%comm)
2536 [ - + ]: 4 : ABI_FREE(tmp_kstab)
2537 [ - + ]: 4 : ABI_FREE(gw_rhor)
2538 [ - + ]: 4 : ABI_FREE(gw_rhog)
2539 [ - + ]: 4 : ABI_FREE(gw_vhartr)
2540 : :
2541 : : ! Save new <i|Hartree[NO]|i> in KS basis for Delta eik
2542 [ + + ]: 28 : do ikcalc=1,Sigp%nkptgw
2543 : 24 : ik_ibz=Kmesh%tab(Sigp%kptgw2bz(ikcalc)) ! Index of the irreducible k-point for GW
2544 [ + + ]: 48 : ib1=MINVAL(Sigp%minbnd(ikcalc,:)) ! min and max band indices for GW corrections (for this k-point)
2545 [ + + ]: 48 : ib2=MAXVAL(Sigp%maxbnd(ikcalc,:))
2546 [ + + ]: 220 : do ib=b1gw,b2gw
2547 : 216 : new_hartr(ib,ikcalc)=GW1RDM_me%vhartree(ib,ib,ik_ibz,1)
2548 : : end do
2549 : : end do
2550 : : !
2551 : : ! C) Exchange <KS_i|hyb*K^RANGE-SEP?[KS]|KS_j> and save it in old_ks_purex
2552 : : !
2553 : : ! Build Vcp_ks and Vcp_full
2554 : 4 : call setup_vcp(Vcp_ks,Vcp_full,Dtset,Gsph_x,Gsph_c,Cryst,Qmesh,Kmesh,coef_hyb,comm)
2555 : 4 : call xmpi_barrier(Wfd%comm)
2556 [ - + ]: 4 : if (coef_hyb > tol8) then
2557 [ # # ]: 0 : do ikcalc=1,Sigp%nkptgw
2558 : 0 : ik_ibz=Kmesh%tab(Sigp%kptgw2bz(ikcalc)) ! Index of the irreducible k-point for GW
2559 [ # # ]: 0 : ib1=MINVAL(Sigp%minbnd(ikcalc,:)) ! min and max band indices for GW corrections (for this k-point)
2560 [ # # ]: 0 : ib2=MAXVAL(Sigp%maxbnd(ikcalc,:))
2561 : : ! Notice we need KS occs and band energy diffs
2562 : : call calc_sigx_me(ik_ibz,ikcalc,ib1,ib2,Cryst,ks_ebands,dtset, Sigp,Sr,Gsph_x,Vcp_ks,Kmesh,Qmesh,Ltg_k(ikcalc),&
2563 : : Pawtab,Pawang,Paw_pwff,Pawfgrtab,Paw_onsite,Psps,Wfd,Wfdf,QP_sym,&
2564 [ # # ]: 0 : gwx_ngfft,ngfftf,Dtset%prtvol,Dtset%pawcross,tol_empty)
2565 : :
2566 : : ! Build <KS_i|RS?_Hyb?_Sigma_x[KS]|KS_j> matrix (Use Wfd)
2567 : 0 : call xmpi_barrier(Wfd%comm)
2568 [ # # ]: 0 : do ib=b1gw,b2gw
2569 : : ! Save old alpha*<i|K[KS]|i> from the GS calc. for Delta eik
2570 : 0 : old_ks_purex(ib,ikcalc)=Sr%x_mat(ib,ib,ik_ibz,1)
2571 : : end do
2572 : : end do
2573 : : endif
2574 : 4 : call xmpi_barrier(Wfd%comm)
2575 : 4 : call Vcp_ks%free()
2576 : :
2577 : : ! Use the Wfd with 'new name' (Wfd_nato_all) because it will contain the GW 1RDM nat. orbs. (bands)
2578 : 4 : ABI_COMMENT("From now on, the Wfd bands will contain the nat. orbs. ones")
2579 : 4 : Wfd_nato_all => Wfd
2580 : : ! Let rotate build the NOs in Wfd_nato_all (KS->NO)
2581 : 4 : call Wfd_nato_all%rotate(Cryst, nateigv)
2582 : 4 : call xmpi_barrier(Wfd%comm)
2583 : : !
2584 : : ! D) Non-local <NO_i|Vnl|NO_i> terms [saved on nl_bks(band,k,spin)]
2585 : : !
2586 [ - + ]: 4 : call Wfd_nato_all%get_nl_me(Cryst,Psps,Pawtab,bdm2_mask,nl_bks)
2587 : 4 : evextnl_energy=zero
2588 [ + + ]: 8 : do spin=1,Sigp%nsppol
2589 [ + + ]: 32 : do ikcalc=1,Sigp%nkptgw
2590 [ + + ]: 220 : do ib=Sr%b1gw,Sr%b2gw
2591 : 216 : evextnl_energy=evextnl_energy+Kmesh%wt(ikcalc)*qp_ebands%occ(ib,ikcalc,spin)*nl_bks(ib,ikcalc,spin)
2592 : : end do
2593 : : end do
2594 : : end do
2595 : 4 : call xmpi_barrier(Wfd%comm)
2596 [ - + ]: 4 : ABI_FREE(nl_bks)
2597 [ - + ]: 4 : ABI_FREE(bdm2_mask)
2598 : : !
2599 : : ! E) Exchange <NO_i|K[NO]|NO_j>
2600 : : !
2601 : : ! Get the matrix elements and save them on Sr%x_mat
2602 : 4 : tol_empty=0.0001 ! Allow lower occ numbers
2603 [ + + ]: 28 : do ikcalc=1,Sigp%nkptgw
2604 : 24 : ik_ibz=Kmesh%tab(Sigp%kptgw2bz(ikcalc)) ! Index of the irreducible k-point for GW
2605 [ + + ]: 48 : ib1=MINVAL(Sigp%minbnd(ikcalc,:)) ! min and max band indices for GW corrections (for this k-point)
2606 [ + + ]: 48 : ib2=MAXVAL(Sigp%maxbnd(ikcalc,:))
2607 : :
2608 : : ! Build <NO_i|Sigma_x[NO]|NO_j> matrix
2609 : : call calc_sigx_me(ik_ibz,ikcalc,ib1,ib2,Cryst,qp_ebands,dtset, Sigp,Sr,Gsph_x,Vcp_full,Kmesh,Qmesh,Ltg_k(ikcalc),&
2610 : : Pawtab,Pawang,Paw_pwff,Pawfgrtab,Paw_onsite,Psps,Wfd_nato_all,Wfdf,QP_sym,&
2611 [ - + ]: 28 : gwx_ngfft,ngfftf,Dtset%prtvol,Dtset%pawcross,tol_empty)
2612 : : end do
2613 : 4 : tol_empty=0.01 ! Recover standard value for tolerance on the occ numbers
2614 : 4 : call xmpi_barrier(Wfd%comm)
2615 : 4 : call Vcp_full%free()
2616 : : ! Save the new total exchange energy Ex = Ex[GW.1RDM]
2617 : 4 : ex_energy = Sr%get_exene(Kmesh, qp_ebands)
2618 : : ! Save the new total exchange-correlation MBB energy Exc = Exc^MBB[GW.1RDM]
2619 : 4 : exc_mbb_energy = Sr%get_excene(Kmesh,qp_ebands)
2620 : :
2621 : : ! Transform <NO_i|K[NO]|NO_j> -> <KS_i|K[NO]|KS_j>,
2622 : : ! <KS_i|J[NO]|KS_j> -> <NO_i|J[NO]|NO_j>,
2623 : : ! and <KS_i|T|KS_j> -> <NO_i|T|NO_j>
2624 : : !
2625 : 4 : call change_matrix(Sigp,Sr,GW1RDM_me,Kmesh,nateigv)
2626 : 4 : call xmpi_barrier(Wfd%comm) ! Wait for all Sigma_x to be ready before deallocating data
2627 : :
2628 : : ! Print Delta eik and band (state) energies
2629 : : !
2630 : 4 : call print_band_energies(b1gw,b2gw,Sr,Sigp,KS_me,Kmesh,ks_ebands,new_hartr,old_ks_purex)
2631 : 4 : call xmpi_barrier(Wfd%comm) ! Wait for all Sigma_x to be ready before deallocating data
2632 : : !
2633 : : ! Print the updated total energy and all energy components
2634 : : !
2635 : 4 : eh_energy = Sr%get_haene(GW1RDM_me,Kmesh,qp_ebands)
2636 : 4 : ekin_energy = Sr%get_kiene(GW1RDM_me,Kmesh,qp_ebands)
2637 : : ! SD 2-RDM
2638 : 4 : etot_sd=ekin_energy+evext_energy+evextnl_energy+QP_energies%e_corepsp+QP_energies%e_ewald+eh_energy+ex_energy
2639 : : ! MBB 2-RDM
2640 : 4 : etot_mbb=ekin_energy+evext_energy+evextnl_energy+QP_energies%e_corepsp+QP_energies%e_ewald+eh_energy+exc_mbb_energy
2641 : : call print_total_energy(ekin_energy,evext_energy,evextnl_energy,QP_energies%e_corepsp,eh_energy,ex_energy,&
2642 : 4 : exc_mbb_energy,QP_energies%e_ewald,etot_sd,etot_mbb,den_int)
2643 : : !
2644 : : ! Clean GW1RDM_me and allocated arrays
2645 : : !
2646 : 4 : call xmpi_barrier(Wfd%comm) ! Wait for all Sigma_x to be ready before deallocating data
2647 : 4 : call GW1RDM_me%free() ! Deallocate GW1RD_me
2648 [ - + ]: 4 : ABI_FREE(old_ks_purex)
2649 [ - + ]: 8 : ABI_FREE(new_hartr)
2650 : : else
2651 [ - + ]: 1 : ABI_FREE(gw_rhor)
2652 [ - + ]: 1 : ABI_FREE(bdm2_mask)
2653 : : end if
2654 [ - + ]: 5 : ABI_FREE(nateigv)
2655 : : endif
2656 : :
2657 : 206 : call xmpi_barrier(Wfd%comm)
2658 : :
2659 : : ! MRM: skip the rest for rdm_update=true (density matrix update)
2660 [ + + ]: 206 : if (.not.rdm_update) then
2661 : : ! =====================================================
2662 : : ! ==== Solve Dyson equation storing results in Sr% ====
2663 : : ! =====================================================
2664 : : ! * Use perturbative approach or AC to find QP corrections.
2665 : : ! * If qp-GW, diagonalize also H0+Sigma in the KS basis set to get the
2666 : : ! new QP amplitudes and energies (Sr%eigvec_qp and Sr%en_qp_diago.
2667 : : ! TODO AC with spinor not implemented yet.
2668 : : ! TODO Diagonalization of Sigma+hhartre with AC is wrong.
2669 : : !
2670 : 201 : call timab(425,1,tsec) ! solve_dyson
2671 [ + + ]: 815 : do ikcalc=1,Sigp%nkptgw
2672 : 614 : ik_ibz=Kmesh%tab(Sigp%kptgw2bz(ikcalc)) ! Index of the irred k-point for GW
2673 [ + + ]: 1236 : ib1=MINVAL(Sigp%minbnd(ikcalc,:)) ! min and max band indices for GW corrections (for this k-point)
2674 [ + + ]: 1236 : ib2=MAXVAL(Sigp%maxbnd(ikcalc,:))
2675 : :
2676 [ - + + - : 3684 : ABI_MALLOC(sigcme_k,(nomega_sigc,ib2-ib1+1,ib2-ib1+1,Sigp%nsppol*Sigp%nsig_ab))
+ - - + +
- - + + -
- + + - +
- + - - +
- + - + ]
2677 [ + - + - : 275351 : sigcme_k=sigcme(:,ib1:ib2,ib1:ib2,ikcalc,:)
+ - - + -
- + + + +
+ + + + ]
2678 : :
2679 : : call solve_dyson(ikcalc, ib1, ib2, nomega_sigc, dtset, Sigp, Kmesh, sigcme_k, qp_ebands%eig, &
2680 : 614 : Sr, ks_me, Dtfil, Wfd%comm)
2681 [ - + ]: 614 : ABI_FREE(sigcme_k)
2682 : : !
2683 : : ! Calculate direct gap for each spin and print out final results.
2684 : : ! We use the valence index of the KS system because we still do not know
2685 : : ! all the QP corrections. Ideally one should use the QP valence index
2686 [ + + ]: 1236 : do spin=1,Sigp%nsppol
2687 [ + + + + ]: 622 : if (Sigp%maxbnd(ikcalc,spin) >= ks_vbik(ik_ibz,spin)+1 .and. &
2688 : 614 : Sigp%minbnd(ikcalc,spin) <= ks_vbik(ik_ibz,spin) ) then
2689 : 599 : ks_iv=ks_vbik(ik_ibz,spin)
2690 : 599 : Sr%egwgap (ik_ibz,spin)= Sr%egw(ks_iv+1,ik_ibz,spin) - Sr%egw(ks_iv,ik_ibz,spin)
2691 : 599 : Sr%degwgap(ik_ibz,spin)= Sr%degw(ks_iv+1,ik_ibz,spin) - Sr%degw(ks_iv,ik_ibz,spin)
2692 : : else
2693 : : ! The "gap" cannot be computed
2694 : 23 : Sr%e0gap(ik_ibz,spin)=zero; Sr%egwgap (ik_ibz,spin)=zero; Sr%degwgap(ik_ibz,spin)=zero
2695 : : end if
2696 : : end do
2697 : :
2698 [ + + ]: 815 : if (wfd%my_rank == master) call Sr%write_results(ikcalc, ik_ibz, Sigp, ks_ebands)
2699 : : end do !ikcalc
2700 : :
2701 : 201 : call timab(425,2,tsec) ! solve_dyson
2702 : 201 : call timab(426,1,tsec) ! finalize
2703 : :
2704 : : ! Update the energies in qp_ebands
2705 : : ! If QPSCGW, use diagonalized eigenvalues otherwise perturbative results.
2706 [ + + ]: 201 : if (gwcalctyp>=10) then
2707 [ + + ]: 941 : do ib=1,Sigp%nbnds
2708 [ + + + + ]: 6837 : qp_ebands%eig(ib,:,:)=Sr%en_qp_diago(ib,:,:)
2709 : : end do
2710 : : else
2711 [ + - + - : 25274 : qp_ebands%eig=Sr%egw
+ - - + -
- - - - -
- - + + +
+ + + ]
2712 : : end if
2713 : :
2714 : : ! ================================================================================
2715 : : ! ==== This part is done only if all k-points in the IBZ have been calculated ====
2716 : : ! ================================================================================
2717 [ + + ]: 201 : if (Sigp%nkptgw==Kmesh%nibz) then
2718 : :
2719 : : ! Recalculate new occupations and Fermi level.
2720 : 86 : call qp_ebands%update_occ(Dtset%spinmagntarget,prtvol=Dtset%prtvol)
2721 : 86 : qp_vbik(:,:) = qp_ebands%get_valence_idx()
2722 : :
2723 : 86 : write(msg,'(2a,3x,2(es16.6,a))')ch10,' New Fermi energy : ',qp_ebands%fermie,' Ha ,',qp_ebands%fermie*Ha_eV,' eV'
2724 : 86 : call wrtout(units, msg)
2725 : :
2726 : : ! === If all k-points and all occupied bands are calculated, output EXX ===
2727 : : ! FIXME here be careful about the check on ks_vbik in case of metals
2728 : : ! if (my_rank==master.and.Sigp%nkptgw==Kmesh%nibz.and.ALL(Sigp%minbnd(:)==1).and.ALL(Sigp%maxbnd(:)>=MAXVAL(nbv(:)))) then
2729 : : ! if (ALL(Sigp%minbnd==1).and. ALL(Sigp%maxbnd>=MAXVAL(MAXVAL(ks_vbik(:,:),DIM=1))) ) then
2730 [ + + + + : 1164 : if (ALL(Sigp%minbnd==1).and. ALL(Sigp%maxbnd>=ks_vbik) ) then ! FIXME here the two arrays use a different indexing.
+ + + + +
+ + - +
+ ]
2731 : :
2732 : 80 : ex_energy = Sr%get_exene(Kmesh,qp_ebands)
2733 : 80 : write(msg,'(a,2(es16.6,a))')' New Exchange energy : ',ex_energy,' Ha ,',ex_energy*Ha_eV,' eV'
2734 : 80 : call wrtout(units, msg)
2735 : : end if
2736 : :
2737 : : ! Report the QP gaps (Fundamental and direct)
2738 : 86 : call qp_ebands%report_gap(header='QP Band Gaps',unit=ab_out)
2739 : :
2740 : : ! Band structure interpolation from QP energies computed on the k-mesh.
2741 [ + + + + : 1146 : if (nint(dtset%einterp(1)) /= 0 .and. all(sigp%minbdgw == sigp%minbnd) .and. all(sigp%maxbdgw == sigp%maxbnd)) then
+ + + + +
+ + + + +
+ - ]
2742 [ + + ]: 3 : call qp_ebands%interpolate_kpath(dtset, cryst, [sigp%minbdgw, sigp%maxbdgw], dtfil%filnam_ds(4), comm)
2743 : : end if
2744 : : end if ! Sigp%nkptgw==Kmesh%nibz
2745 : : !
2746 : : ! Write SCF data in case of self-consistent calculation ===
2747 : : ! Save Sr%en_qp_diago, Sr%eigvec_qp and m_ks_to_qp in the _QPS file.
2748 : : ! Note that in the first iteration qp_rhor contains KS rhor, then the mixed rhor.
2749 [ + + ]: 201 : if (gwcalctyp>=10) then
2750 : : ! Calculate the new m_ks_to_qp
2751 : 71 : call updt_m_ks_to_qp(Sigp,Kmesh,nscf,Sr,Sr%m_ks_to_qp)
2752 : :
2753 [ + + ]: 71 : if (wfd%my_rank == master) then
2754 : : call wrqps(Dtfil%fnameabo_qps,Sigp,Cryst,Kmesh,Psps,Pawtab,QP_Pawrhoij,&
2755 : 55 : Dtset%nspden,nscf,nfftf,ngfftf,Sr,qp_ebands,Sr%m_ks_to_qp,qp_rhor)
2756 : : end if
2757 : :
2758 : : ! Report the MAX variation for each kptgw and spin
2759 : 71 : call wrtout(ab_out,ch10//' Convergence of QP corrections ')
2760 [ + + ]: 144 : do spin=1,Sigp%nsppol
2761 : 73 : write(msg,'(a,i2,a)')' >>>>> For spin ',spin,' <<<<< '
2762 : 73 : call wrtout(ab_out, msg)
2763 [ + + ]: 513 : do ikcalc=1,Sigp%nkptgw
2764 : 369 : ib1 = Sigp%minbnd(ikcalc,spin); ib2 = Sigp%maxbnd(ikcalc,spin)
2765 : 369 : ik_bz = Sigp%kptgw2bz(ikcalc); ik_ibz = Kmesh%tab(ik_bz)
2766 [ + - + + ]: 4143 : ii = imax_loc(ABS(Sr%degw(ib1:ib2,ik_ibz,spin)))
2767 : 369 : max_degw = Sr%degw(ii,ik_ibz,spin)
2768 : 369 : write(msg,('(a,i3,a,2f8.3,a,i3)'))'. kptgw no:',ikcalc,'; Maximum DeltaE = (',max_degw*Ha_eV,') for band index:',ii
2769 : 442 : call wrtout(ab_out, msg)
2770 : : end do
2771 : : end do
2772 : : end if
2773 : :
2774 : : ! ============================================
2775 : : ! ==== Save the GW results in NETCDF file ====
2776 : : ! ============================================
2777 [ + + ]: 201 : if (wfd%my_rank == master) then
2778 [ - + ]: 173 : NCF_CHECK(nctk_open_create(ncid, strcat(dtfil%filnam_ds(4), '_SIGRES.nc'), xmpi_comm_self))
2779 [ + + - + : 346 : NCF_CHECK(nctk_defnwrite_ivars(ncid, ["sigres_version"], [1]))
- - ]
2780 [ - + ]: 173 : NCF_CHECK(cryst%ncwrite(ncid))
2781 [ - + ]: 173 : NCF_CHECK(ks_ebands%ncwrite(ncid))
2782 [ - + ]: 173 : NCF_CHECK(Sr%ncwrite(Sigp, epsm1, Dtset, ncid)) ! WARNING!! If gw1rdm>0 then epsm1 is no longer present!!
2783 : : ! Add qp_rhor. Note that qp_rhor == ks_rhor if wavefunctions are not updated.
2784 : : !ncerr = nctk_write_datar("qp_rhor",path,ngfft,cplex,nfft,nspden,&
2785 : : ! comm_fft,fftn3_distrib,ffti3_local,datar,action)
2786 [ + - ]: 173 : NCF_CHECK(nf90_close(ncid))
2787 : :
2788 : : !if (Sigp%nkptgw==Wfd%nkibz) then
2789 : : ! call write_qpdata(dtset, sr)
2790 : : !end if
2791 : : end if
2792 : : end if ! MRM skipped if GW density matrix update
2793 : : end if ! ucrpa
2794 : :
2795 : : !----------------------------- END OF THE CALCULATION ------------------------
2796 : : !
2797 : : !=====================
2798 : : !==== Close Files ====
2799 : : !=====================
2800 [ + + ]: 206 : if (wfd%my_rank == master) then
2801 : 178 : close(unt_gw); close(unt_gwdiag); close(unt_sig); close(unt_sgr); close(unt_sigc)
2802 [ + + ]: 178 : if (mod10==SIG_GW_AC) close(unt_sgm)
2803 : : end if
2804 : : !
2805 : : !===============================================
2806 : : !==== Free arrays and local data structures ====
2807 : : !===============================================
2808 [ - + ]: 206 : ABI_FREE(ks_vbik)
2809 [ - + ]: 206 : ABI_FREE(qp_vbik)
2810 [ - + ]: 206 : ABI_FREE(ph1d)
2811 [ - + ]: 206 : ABI_FREE(ph1df)
2812 [ - + ]: 206 : ABI_FREE(qp_rhor)
2813 [ - + ]: 206 : ABI_FREE(ks_rhor)
2814 [ - + ]: 206 : ABI_FREE(ks_rhog)
2815 [ - + ]: 206 : ABI_FREE(qp_taur)
2816 [ - + ]: 206 : ABI_FREE(ks_taur)
2817 [ - + ]: 206 : ABI_FREE(ks_vhartr)
2818 [ - + ]: 206 : ABI_FREE(ks_vtrial)
2819 [ - + ]: 206 : ABI_FREE(vpsp)
2820 [ - + ]: 206 : ABI_FREE(ks_vxc)
2821 [ - + ]: 206 : ABI_FREE(xccc3d)
2822 [ - + ]: 206 : ABI_FREE(grchempottn)
2823 [ - + ]: 206 : ABI_FREE(grewtn)
2824 [ - + ]: 206 : ABI_FREE(grvdw)
2825 [ + + ]: 206 : ABI_SFREE(sigcme)
2826 [ + - ]: 206 : ABI_SFREE(kxc)
2827 [ + + ]: 206 : ABI_SFREE(qp_vtrial)
2828 [ - + ]: 206 : ABI_FREE(ks_nhat)
2829 [ - + ]: 206 : ABI_FREE(ks_nhatgr)
2830 [ - + ]: 206 : ABI_FREE(dijexc_core)
2831 [ - + ]: 206 : ABI_FREE(ks_aepaw_rhor)
2832 : 206 : call pawfgr_destroy(Pawfgr)
2833 : :
2834 : : ! Deallocation for PAW.
2835 [ + + ]: 206 : if (Dtset%usepaw==1) then
2836 : 7 : call pawrhoij_free(KS_Pawrhoij)
2837 [ + - + + : 42 : ABI_FREE(KS_Pawrhoij)
- + - + -
+ - + - +
- + - + ]
2838 : 7 : call pawfgrtab_free(Pawfgrtab)
2839 : 7 : call paw_ij_free(KS_paw_ij)
2840 : 7 : call paw_an_free(KS_paw_an)
2841 : 7 : call pawpwff_free(Paw_pwff)
2842 [ - + ]: 7 : if (gwcalctyp>=10) then
2843 : 0 : call pawrhoij_free(QP_pawrhoij)
2844 : 0 : call paw_ij_free(QP_paw_ij)
2845 : 0 : call paw_an_free(QP_paw_an)
2846 : : end if
2847 [ - + ]: 7 : if (Dtset%pawcross==1) then
2848 : 0 : call paw_pwaves_lmn_free(Paw_onsite)
2849 : 0 : call wfdf%free()
2850 : : end if
2851 : : end if
2852 [ + - - + : 206 : ABI_FREE(Paw_onsite)
- - - - -
- - - - -
- + ]
2853 [ + - + + : 241 : ABI_FREE(Pawfgrtab)
- + - + -
+ - + - +
- + - + -
+ - + ]
2854 [ + - + + : 218 : ABI_FREE(Paw_pwff)
- + - + -
+ ]
2855 [ + - + + : 241 : ABI_FREE(KS_paw_ij)
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + ]
2856 [ + - + + : 241 : ABI_FREE(KS_paw_an)
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + -
+ ]
2857 [ + + ]: 206 : if (gwcalctyp>=10) then
2858 [ + - - + : 76 : ABI_FREE(QP_pawrhoij)
- - - - -
- - - - -
- - - + ]
2859 [ + - - + : 76 : ABI_FREE(QP_paw_an)
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - -
+ ]
2860 [ + - - + : 76 : ABI_FREE(QP_paw_ij)
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - + ]
2861 : : end if
2862 : :
2863 : 206 : call wfd%free(); call destroy_mpi_enreg(MPI_enreg_seq)
2864 : 206 : call Kmesh%free(); call Qmesh%free(); call Gsph_Max%free(); call Gsph_x%free(); call Gsph_c%free()
2865 : 206 : call Vcp%free(); call cryst%free(); call Sr%free()
2866 [ + + ]: 206 : if (.not.rdm_update) call epsm1%free()
2867 : 206 : call PPm%free(); call Hdr_sigma%free(); call Hdr_wfk%free(); call ks_ebands%free();call qp_ebands%free(); call KS_me%free()
2868 : 206 : call littlegroup_free(Ltg_k)
2869 [ + - + + : 850 : ABI_FREE(Ltg_k)
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + ]
2870 : 206 : call esymm_free(KS_sym)
2871 [ + - + + : 1453 : ABI_FREE(KS_sym)
- + - + -
+ - + - +
- + - + -
+ - - - -
- + - + -
+ - - - -
- - - + -
- - - - -
- + - - -
- - - -
+ ]
2872 : :
2873 [ + + - + ]: 206 : if (Sigp%symsigma == 1 .and. gwcalctyp>=20) then
2874 : 0 : call esymm_free(QP_sym)
2875 [ # # ]: 0 : ABI_FREE(QP_sym)
2876 : : end if
2877 : :
2878 : 206 : call Sigp%free()
2879 : :
2880 : 206 : call timab(426,2,tsec) ! finalize
2881 : 206 : call timab(401,2,tsec)
2882 : :
2883 : : DBG_EXIT('COLL')
2884 : :
2885 [ - + - + : 1030 : end subroutine sigma
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- - - - -
- - - - -
- - - - -
+ - - - -
- - - - -
- - - - -
- - - - -
- - - - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - - -
- - - - -
- - - - -
- - + - -
- - - - -
- - - - -
- - - - -
- - - - -
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
- - - - -
- - - - -
- - - - +
- - - - -
- - - - -
- - - - -
- - - - -
- - - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
- - - - +
- + - - -
- - + - -
- - - + -
- - - - -
- - - - -
+ - + - +
- + - + -
+ - + - -
- - - + -
+ - - - -
- + - - -
- - + - -
- - - - -
- - - - +
- + - + -
+ - + - +
- + - - -
- - + - +
- - - - -
+ - - - -
- + - - -
- - - - -
- - - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - - -
- - - - -
- - - - -
- - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - - -
- - - - -
- + - - -
- - - - -
- + - + -
+ - + - -
- - - - -
- - - - -
- - - - -
- - + - +
- + - + -
+ - - - -
- - - - -
- - - - -
- + - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - + - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - - -
- - - - -
- - - - -
- - + - +
- + - + -
+ - + - -
- - - + -
- - - - +
- - - - -
+ - + - +
- + - - -
- - - - -
- - - - -
- - - - -
- + - - -
- - - - +
- - - - -
- - - - -
- - - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
- - - - -
- - - - -
- - - - +
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
+ - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - -
- - - - -
- - - - -
- - - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
- - - - -
- - - - -
- - - - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- - - - -
- - - - -
- - - - -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - - - -
- - - - -
- - - - -
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - - -
- - - - +
- + ]
2886 : : !!***
2887 : :
2888 : : !!****f* ABINIT/setup_sigma
2889 : : !! NAME
2890 : : !! setup_sigma
2891 : : !!
2892 : : !! FUNCTION
2893 : : !! Initialize the data type containing parameters for a sigma calculation.
2894 : : !!
2895 : : !! INPUTS
2896 : : !! acell(3)=length scales of primitive translations (bohr)
2897 : : !! wfk_fname=Name of the WFK file.
2898 : : !! Dtset<type(dataset_type)>=all input variables for this dataset
2899 : : !! Dtfil<type(datafiles_type)>=variables related to files
2900 : : !! rprim(3,3)=dimensionless real space primitive translations
2901 : : !! Psps <Pseudopotential_type)>=Info on pseudopotential, only for consistency check of the WFK file
2902 : : !!
2903 : : !! OUTPUT
2904 : : !! Sigp<sigparams_t>=Parameters governing the self-energy calculation.
2905 : : !! Kmesh <kmesh_t>=Structure describing the k-point sampling.
2906 : : !! Qmesh <kmesh_t>=Structure describing the q-point sampling.
2907 : : !! Cryst<crystal_t>=Info on unit cell and symmetries.
2908 : : !! Gsph_Max<gsphere_t>=Info on the G-sphere
2909 : : !! Gsph_c<gsphere_t>=Info on the G-sphere for W and Sigma_c
2910 : : !! Gsph_x<gsphere_t>=Info on the G-sphere for and Sigma_x
2911 : : !! Hdr_wfk<hdr_type>=The header of the WFK file
2912 : : !! Hdr_out<hdr_type>=The header to be used for the results of sigma calculations.
2913 : : !! Vcp<vcoul_t>= Datatype gathering information on the coulombian interaction and the cutoff technique.
2914 : : !! epsm1<epsm1_t>=Datatype storing data used to construct the screening (partially Initialized in OUTPUT)
2915 : : !! ks_ebands<ebands_t>=The KS energies and occupation factors.
2916 : : !! gwc_ngfft(18), gwx_ngfft(18)= FFT meshes for the oscillator strengths used for the correlated and the
2917 : : !! exchange part of the self-energy, respectively.
2918 : : !! comm=MPI communicator.
2919 : : !!
2920 : : !! SOURCE
2921 : :
2922 [ - + - + : 21630 : subroutine setup_sigma(codvsn,wfk_fname,acell,rprim,Dtset,Dtfil,Psps,Pawtab,&
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - - - -
- - - - -
- - - - -
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - - -
- - - - -
- - - - -
- - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + + + +
+ + + + +
+ + + + +
+ + + + +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + + + +
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + + +
+ + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + + +
+ + + + +
+ + + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - -
- - - - -
- - - - -
- - + + -
+ - + - +
- + - + -
+ - + - -
- - - - -
- - + - -
- - - - -
- ]
2923 : : gwx_ngfft,gwc_ngfft,Hdr_wfk,Hdr_out,Cryst,Kmesh,Qmesh,ks_ebands,Gsph_Max,Gsph_x,Gsph_c,Vcp,epsm1,Sigp,comm)
2924 : :
2925 : : !Arguments ------------------------------------
2926 : : !scalars
2927 : : integer,intent(in) :: comm
2928 : : character(len=8),intent(in) :: codvsn
2929 : : character(len=*),intent(in) :: wfk_fname
2930 : : type(Datafiles_type),intent(in) :: Dtfil
2931 : : type(Dataset_type),intent(inout) :: Dtset
2932 : : type(Pseudopotential_type),intent(in) :: Psps
2933 : : type(Pawtab_type),intent(in) :: Pawtab(Psps%ntypat*Dtset%usepaw)
2934 : : type(sigparams_t),intent(out) :: Sigp
2935 : : type(epsm1_t),intent(out) :: epsm1
2936 : : type(ebands_t),intent(out) :: ks_ebands
2937 : : type(kmesh_t),intent(out) :: Kmesh,Qmesh
2938 : : type(crystal_t),intent(out) :: Cryst
2939 : : type(gsphere_t),intent(out) :: Gsph_Max,Gsph_x,Gsph_c
2940 : : type(Hdr_type),intent(out) :: Hdr_wfk,Hdr_out
2941 : : type(vcoul_t),intent(out) :: Vcp
2942 : : !arrays
2943 : : integer,intent(out) :: gwc_ngfft(18),gwx_ngfft(18)
2944 : : real(dp),intent(in) :: acell(3),rprim(3,3)
2945 : :
2946 : : !Local variables-------------------------------
2947 : : !scalars
2948 : : integer,parameter :: pertcase0 = 0, master = 0
2949 : : integer :: bantot,enforce_sym,gwcalctyp,ib,ibtot,icutcoul_eff,ii,ikcalc,ikibz,io,isppol,itypat,jj,method
2950 : : integer :: mod10,mqmem,mband,ng_kss,nsheps,ikcalc2bz,ierr,gap_err,ng, nsppol
2951 : : integer :: gwc_nfftot,gwx_nfftot,nqlwl,test_npwkss,my_rank,nprocs,ik,nk_found,ifo,timrev,usefock_ixc
2952 : : integer :: iqbz,isym,iq_ibz,itim,pinv,ig1,ng_sigx,spin,gw_qprange,ivcoul_init,nvcoul_init,xclevel_ixc
2953 : : real(dp),parameter :: OMEGASIMIN=0.01d0
2954 : : real(dp) :: domegas,domegasi,ucvol,rcut, drude_plasmon_freq, wmax
2955 : : logical :: ltest,remove_inv,changed,found,ex
2956 : : character(len=500) :: msg, iw_mesh_type
2957 : : character(len=fnlen) :: fname,fcore
2958 : 206 : type(wvl_internal_type) :: wvl
2959 : 206 : type(gaps_t) :: ks_gaps
2960 : : !arrays
2961 : : integer :: ng0sh_opt(3),G0(3),q_umklp(3),kpos(6), units(2)
2962 : 206 : integer,allocatable :: npwarr(:),val_indices(:,:)
2963 : 206 : integer,pointer :: gvec_kss(:,:),gsphere_sigx_p(:,:)
2964 : 206 : integer,pointer :: test_gvec_kss(:,:)
2965 : : real(dp) :: gmet(3,3),gprimd(3,3),rmet(3,3),rprimd(3,3),sq(3),q_bz(3),gamma_point(3,1)
2966 : 206 : real(dp),pointer :: energies_p(:,:,:)
2967 : 206 : real(dp),allocatable :: doccde(:),eigen(:),occfact(:),qlwl(:,:)
2968 : 206 : type(Pawrhoij_type),allocatable :: Pawrhoij(:)
2969 [ + + + + : 4532 : type(vcoul_t) :: Vcp_ks
+ + + + +
+ - + ]
2970 : : integer :: nbsum
2971 : : real(dp) :: te_min = -one, te_max = one
2972 : : real(dp) :: ft_max_error(3) = -one
2973 : : real(dp) :: cosft_duality_error = -one
2974 : 206 : real(dp),allocatable :: tau_mesh(:), tau_wgs(:), iw_mesh(:), iw_wgs(:)
2975 : 206 : real(dp),allocatable :: cosft_wt(:,:), cosft_tw(:,:), sinft_wt(:,:)
2976 : : ! *************************************************************************
2977 : :
2978 : : DBG_ENTER('COLL')
2979 [ + + ]: 618 : units = [std_out, ab_out]
2980 : 206 : my_rank = xmpi_comm_rank(comm); nprocs = xmpi_comm_size(comm)
2981 : :
2982 : 206 : nsppol = dtset%nsppol
2983 [ + + + - : 1453 : ABI_CHECK(ALL(Dtset%nband(1:Dtset%nkpt*nsppol) == Dtset%nband(1)), 'Dtset%nband(:) must be constant')
- + ]
2984 : :
2985 : : ! Basic parameters
2986 : 206 : Sigp%ppmodel = Dtset%ppmodel
2987 : 206 : Sigp%gwcalctyp = Dtset%gwcalctyp
2988 : 206 : Sigp%nbnds = Dtset%nband(1)
2989 : 206 : Sigp%symsigma = Dtset%symsigma
2990 : 206 : Sigp%zcut = Dtset%zcut
2991 : 206 : Sigp%mbpt_sciss = Dtset%mbpt_sciss
2992 : :
2993 : 206 : timrev= 2 ! This information is not reported in the header
2994 : : ! 1 => do not use time-reversal symmetry
2995 : : ! 2 => take advantage of time-reversal symmetry
2996 [ + + ]: 206 : if (any(dtset%kptopt == [3, 4])) timrev = 1
2997 : :
2998 : : ! For HF, SEX or COHSEX use Hybertsen-Louie PPM (only $\omega=0$) ===
2999 : : ! Use fake screening for HF.
3000 : : ! FIXME Why, we should not redefine Sigp%ppmodel
3001 : 206 : gwcalctyp = Sigp%gwcalctyp
3002 : 206 : mod10 = MOD(Sigp%gwcalctyp, 10)
3003 [ + + ]: 206 : if (any(mod10 == [5, 6, 7])) Sigp%ppmodel=2
3004 [ + + ]: 168 : if (mod10<5 .and. MOD(Sigp%gwcalctyp,1)/=1) then !
3005 : : ! One shot GW (PPM or contour deformation).
3006 [ - + ]: 129 : if (Dtset%nomegasrd==1) then
3007 : : ! avoid division by zero!
3008 : 0 : Sigp%nomegasrd =1
3009 : 0 : Sigp%maxomega4sd=zero
3010 : 0 : Sigp%deltae =zero
3011 : : else
3012 : 129 : Sigp%nomegasrd = Dtset%nomegasrd
3013 : 129 : Sigp%maxomega4sd = Dtset%omegasrdmax
3014 : 129 : Sigp%deltae = (2*Sigp%maxomega4sd)/(Sigp%nomegasrd-1)
3015 : : endif
3016 : : else
3017 : : ! For AC no need to evaluate derivative by finite differences.
3018 : 77 : Sigp%nomegasrd =1
3019 : 77 : Sigp%maxomega4sd=zero
3020 : 77 : Sigp%deltae =zero
3021 : : end if
3022 : :
3023 : : ! Dimensional primitive translations rprimd (from input), gprimd, metrics and unit cell volume
3024 : 206 : call mkrdim(acell,rprim,rprimd)
3025 : 206 : call metric(gmet,gprimd,-1,rmet,rprimd,ucvol)
3026 : :
3027 : 206 : Sigp%npwwfn = Dtset%npwwfn
3028 : 206 : Sigp%npwx = Dtset%npwsigx
3029 : :
3030 : : ! Read parameters of the WFK, verifify them and retrieve all G-vectors.
3031 [ - + ]: 206 : if (dtset%userie == 456) then
3032 : 0 : call wfk_read_eigenvalues("SC_WFK",energies_p,Hdr_wfk,comm)
3033 : : else
3034 : 206 : call wfk_read_eigenvalues(wfk_fname,energies_p,Hdr_wfk,comm)
3035 : : end if
3036 [ + + ]: 1453 : mband = MAXVAL(Hdr_wfk%nband)
3037 : :
3038 : 206 : remove_inv = .FALSE.
3039 [ + - ]: 206 : if (dtset%userie /= 456) then
3040 : 206 : call hdr_wfk%vs_dtset(dtset)
3041 : : end if
3042 : :
3043 : 206 : test_npwkss = 0
3044 : : call make_gvec_kss(Dtset%nkpt,Dtset%kptns,Hdr_wfk%ecut_eff,Dtset%symmorphi,Dtset%nsym,Dtset%symrel,Dtset%tnons,&
3045 : 206 : gprimd,Dtset%prtvol,test_npwkss,test_gvec_kss,ierr)
3046 [ - + ]: 206 : ABI_CHECK(ierr==0, "Fatal error in make_gvec_kss")
3047 : :
3048 [ - + + - : 618 : ABI_MALLOC(gvec_kss,(3, test_npwkss))
+ - + - -
+ - + ]
3049 [ + - + + : 1104846 : gvec_kss = test_gvec_kss
+ + + + +
+ ]
3050 : 206 : ng_kss = test_npwkss
3051 : :
3052 : 206 : ng = MIN(SIZE(gvec_kss,DIM=2),SIZE(test_gvec_kss,DIM=2))
3053 : 206 : ierr = 0
3054 [ + + ]: 138286 : do ig1=1,ng
3055 [ + + + - : 552526 : if (ANY(gvec_kss(:,ig1)/=test_gvec_kss(:,ig1))) then
- + ]
3056 : 0 : ierr=ierr+1
3057 : 0 : write(std_out,*)" gvec_kss ",ig1,"/",ng,gvec_kss(:,ig1),test_gvec_kss(:,ig1)
3058 : : end if
3059 : : end do
3060 [ - + ]: 206 : ABI_CHECK(ierr == 0, "Mismatch between gvec_kss and test_gvec_kss")
3061 [ - + ]: 206 : ABI_FREE(test_gvec_kss)
3062 : :
3063 : : ! Get important dimensions from the WFK header
3064 : 206 : Sigp%nsppol = Hdr_wfk%nsppol
3065 : 206 : Sigp%nspinor = Hdr_wfk%nspinor
3066 : 206 : Sigp%nsig_ab = Hdr_wfk%nspinor**2 ! TODO Is it useful calculating only diagonal terms?
3067 : :
3068 [ - + ]: 206 : if (Sigp%nbnds > mband) then
3069 : : write(msg,'(2a,2(a,i0))') &
3070 : 0 : 'Number of bands stored WFK file is less than required. ',ch10,&
3071 : 0 : "WFK mband: ", mband, ", self-energy nband: ", sigp%nbnds
3072 : 0 : ABI_ERROR(msg)
3073 : : end if
3074 : :
3075 : : ! Check input
3076 [ + + ]: 206 : if (any(Sigp%ppmodel== [3, 4])) then
3077 [ - + ]: 6 : if (gwcalctyp >= 10) then
3078 : 0 : ABI_ERROR(sjoin('The ppmodel chosen and gwcalctyp: ', itoa(Dtset%gwcalctyp),' are not compatible.'))
3079 : : end if
3080 [ - + ]: 6 : if (Sigp%nspinor==2) then
3081 : 0 : ABI_ERROR(sjoin('The ppmodel chosen and nspinor: ', itoa(Sigp%nspinor), ' are not compatible.'))
3082 : : end if
3083 : : end if
3084 : :
3085 : : ! Create crystal_t data type
3086 [ - + - + : 206 : cryst = Hdr_wfk%get_crystal(gw_timrev=timrev, remove_inv=remove_inv)
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
3087 : 206 : call cryst%print()
3088 : :
3089 [ + + ]: 206 : if (Sigp%npwwfn > ng_kss) then ! cannot use more G"s for the wfs than those stored on file
3090 : 2 : Sigp%npwwfn =ng_kss
3091 : 2 : Dtset%npwwfn =ng_kss
3092 : : write(msg,'(2a,(a,i0,a))')&
3093 : 2 : 'Number of G-vectors for WFS found in the KSS file is less than required',ch10,&
3094 : 4 : 'calculation will proceed with npwwfn = ',Sigp%npwwfn,ch10
3095 : 2 : ABI_WARNING(msg)
3096 : : end if
3097 : :
3098 [ - + ]: 206 : if (Sigp%npwx>ng_kss) then
3099 : : ! Have to recalculate the (large) sphere for Sigma_x.
3100 [ # # # # ]: 0 : pinv=1; if (remove_inv.and.Cryst%timrev==2) pinv=-1
3101 : 0 : gamma_point(:,1) = (/zero,zero,zero/); nullify(gsphere_sigx_p)
3102 : :
3103 : : call merge_and_sort_kg(1,gamma_point,Dtset%ecutsigx,Cryst%nsym,pinv,Cryst%symrel,&
3104 : 0 : Cryst%gprimd,gsphere_sigx_p,Dtset%prtvol)
3105 : :
3106 : 0 : ng_sigx=SIZE(gsphere_sigx_p,DIM=2)
3107 : 0 : Sigp%npwx = ng_sigx
3108 : 0 : Dtset%npwsigx = ng_sigx
3109 : :
3110 : : write(msg,'(2a,(a,i0,a))')&
3111 : 0 : 'Number of G-vectors for Sigma_x found in the KSS file is less than required',ch10,&
3112 : 0 : 'calculation will proceed with npwsigx = ',Sigp%npwx,ch10
3113 : 0 : ABI_WARNING(msg)
3114 : :
3115 : 0 : ltest = (Sigp%npwx >= ng_kss)
3116 [ # # ]: 0 : ABI_CHECK(ltest,"Sigp%npwx<ng_kss!")
3117 : :
3118 : : ! Fill gvec_kss with larger sphere.
3119 [ # # ]: 0 : ABI_FREE(gvec_kss)
3120 [ # # # # : 0 : ABI_MALLOC(gvec_kss,(3,Sigp%npwx))
# # # # #
# # # ]
3121 [ # # # # : 0 : gvec_kss = gsphere_sigx_p
# # # # #
# ]
3122 [ # # ]: 0 : ABI_FREE(gsphere_sigx_p)
3123 : : end if
3124 : :
3125 : : ! Set up of the k-points and tables in the whole BZ
3126 : : ! TODO Recheck symmorphy and inversion
3127 : 206 : call Kmesh%init(Cryst,Hdr_wfk%nkpt,Hdr_wfk%kptns,Dtset%kptopt,wrap_1zone=.FALSE.)
3128 : : !call Kmesh%init(Cryst,Hdr_wfk%nkpt,Hdr_wfk%kptns,Dtset%kptopt,wrap_1zone=.TRUE.)
3129 : :
3130 : : ! Some required information are not filled up inside kmesh_init
3131 : : ! So doing it here, even though it is not clean
3132 [ + + + + ]: 2678 : Kmesh%kptrlatt(:,:) =Dtset%kptrlatt(:,:)
3133 : 206 : Kmesh%nshift =Dtset%nshiftk
3134 [ - + + - : 618 : ABI_MALLOC(Kmesh%shift,(3,Kmesh%nshift))
+ - + - -
+ - + -
+ ]
3135 [ + + + + ]: 1030 : Kmesh%shift(:,:) =Dtset%shiftk(:,1:Dtset%nshiftk)
3136 : :
3137 : 206 : call Kmesh%print(units, header="K-mesh for the wavefunctions", prtvol=Dtset%prtvol)
3138 : :
3139 : : ! Initialize the band structure datatype
3140 : : ! Copy WFK energies and occupations up to Sigp%nbnds==Dtset%nband(:)
3141 [ + + ]: 1453 : bantot = SUM(Dtset%nband(1:Dtset%nkpt*nsppol))
3142 [ - + + - : 618 : ABI_MALLOC(doccde,(bantot))
+ - + - -
+ - + ]
3143 [ - + + - : 412 : ABI_MALLOC(eigen,(bantot))
- + - + ]
3144 [ - + + - : 412 : ABI_MALLOC(occfact,(bantot))
- + - + ]
3145 [ + + + + : 88238 : doccde(:)=zero; eigen(:)=zero; occfact(:)=zero
+ + ]
3146 : :
3147 : 206 : jj=0; ibtot=0
3148 [ + + ]: 416 : do isppol=1,nsppol
3149 [ + + ]: 1663 : do ikibz=1,Dtset%nkpt
3150 [ + + ]: 46447 : do ib=1,Hdr_wfk%nband(ikibz+(isppol-1)*Dtset%nkpt)
3151 : 44990 : ibtot=ibtot+1
3152 [ + + ]: 46237 : if (ib<=Sigp%nbnds) then
3153 : 29344 : jj=jj+1
3154 : 29344 : occfact(jj)=Hdr_wfk%occ(ibtot)
3155 : 29344 : eigen (jj)=energies_p(ib,ikibz,isppol)
3156 : : end if
3157 : : end do
3158 : : end do
3159 : : end do
3160 [ - + ]: 206 : ABI_FREE(energies_p)
3161 : :
3162 : : ! Make sure that Dtset%wtk==Kmesh%wt due to the dirty treatment of
3163 : : ! symmetry operations in the old GW code (symmorphy and inversion)
3164 [ + + + - ]: 1443 : ltest=(ALL(ABS(Dtset%wtk(1:Kmesh%nibz)-Kmesh%wt(1:Kmesh%nibz))<tol6))
3165 [ - + ]: 206 : ABI_CHECK(ltest,'Mismatch between Dtset%wtk and Kmesh%wt')
3166 : :
3167 [ - + + - : 618 : ABI_MALLOC(npwarr,(Dtset%nkpt))
+ - + - -
+ - + ]
3168 [ + + ]: 1443 : npwarr(:)=Sigp%npwwfn
3169 : :
3170 : : call ks_ebands%init(bantot, Dtset%nelect,Dtset%ne_qFD,Dtset%nh_qFD,Dtset%ivalence,&
3171 : : doccde,eigen,Dtset%istwfk,Kmesh%ibz,Dtset%nband,&
3172 : : Kmesh%nibz,npwarr,nsppol,Dtset%nspinor,Dtset%tphysel,Dtset%tsmear,Dtset%occopt,occfact,Kmesh%wt,&
3173 : : dtset%cellcharge(1), dtset%kptopt, dtset%kptrlatt_orig, dtset%nshiftk_orig, dtset%shiftk_orig,&
3174 : 206 : dtset%kptrlatt, dtset%nshiftk, dtset%shiftk)
3175 : :
3176 [ - + ]: 206 : ABI_FREE(doccde)
3177 [ - + ]: 206 : ABI_FREE(eigen)
3178 [ - + ]: 206 : ABI_FREE(npwarr)
3179 : :
3180 : : ! Calculate KS occupation numbers and ks_vbk(nkibz, nsppol)
3181 : : ! ks_vbk gives the (valence|last Fermi band) index for each k and spin.
3182 : : ! spinmagntarget is passed to fermi.F90 to fix the problem with newocc in case of magnetic metals
3183 : 206 : call ks_ebands%update_occ(Dtset%spinmagntarget, prtvol=0)
3184 : :
3185 [ - + - + : 206 : ks_gaps = ks_ebands%get_gaps(gap_err)
- + - + -
+ - + - +
- + ]
3186 [ + + ]: 412 : call ks_gaps%print([std_out])
3187 : 206 : call ks_ebands%report_gap(unit=std_out)
3188 : :
3189 [ - + + - : 824 : ABI_MALLOC(val_indices,(ks_ebands%nkpt, nsppol))
- + + - +
- + - - +
- + - + ]
3190 [ + - - + : 206 : val_indices = ks_ebands%get_valence_idx()
- - ]
3191 : :
3192 : : ! Create Sigma header
3193 : : ! TODO Fix problems with symmorphy and k-points
3194 : 206 : call Hdr_out%init(ks_ebands,codvsn,Dtset,Pawtab,pertcase0,Psps,wvl)
3195 : :
3196 : : ! Get Pawrhoij from the header of the WFK file
3197 [ + + + - : 653 : ABI_MALLOC(Pawrhoij, (Cryst%natom*Dtset%usepaw))
+ - + + -
+ - + - +
+ + ]
3198 [ + + ]: 206 : if (Dtset%usepaw==1) then
3199 : 7 : call pawrhoij_alloc(Pawrhoij, 1, Dtset%nspden, Dtset%nspinor, nsppol, Cryst%typat, pawtab=Pawtab)
3200 : 7 : call pawrhoij_copy(Hdr_wfk%Pawrhoij, Pawrhoij)
3201 : : end if
3202 : :
3203 : 206 : call hdr_out%update(bantot,1.0d20,1.0d20,1.0d20,1.0d20,Cryst%rprimd,occfact,Pawrhoij,Cryst%xred,dtset%amu_orig(:,1))
3204 [ - + ]: 206 : ABI_FREE(occfact)
3205 : 206 : call pawrhoij_free(Pawrhoij)
3206 [ + - + + : 241 : ABI_FREE(Pawrhoij)
- + - + -
+ - + - +
- + - + ]
3207 : :
3208 : : ! ===========================================================
3209 : : ! ==== Setup of k-points and bands for the GW corrections ====
3210 : : ! ===========================================================
3211 : : ! * maxbdgw and minbdgw are the Max and min band index for GW corrections over k-points.
3212 : : ! They are used to dimension the wavefunctions and to calculate the matrix elements.
3213 : : !
3214 [ + + ]: 206 : if (dtset%nkptgw == 0) then
3215 : : !
3216 : : ! Use qp_range to select the interesting k-points and the corresponding bands.
3217 : : !
3218 : : ! 0 --> Compute the QP corrections only for the fundamental and the direct gap.
3219 : : ! +num --> Compute the QP corrections for all the k-points in the irreducible zone and include `num`
3220 : : ! bands above and below the Fermi level.
3221 : : ! -num --> Compute the QP corrections for all the k-points in the irreducible zone.
3222 : : ! Include all occupied states and `num` empty states.
3223 : :
3224 : 30 : call wrtout(std_out, "nkptgw == 0 ==> Automatic selection of k-points and bands for the corrections.")
3225 : :
3226 [ + + + + ]: 30 : if (gap_err /= 0 .and. dtset%gw_qprange == 0) then
3227 : 1 : msg = "Problem while computing fundamental/direct gap (likely metal). Will replace gw_qprange=0 with gw_qprange=1"
3228 : 1 : ABI_WARNING(msg)
3229 : 1 : dtset%gw_qprange = 1
3230 : : end if
3231 : :
3232 : 30 : gw_qprange = dtset%gw_qprange
3233 : :
3234 [ - + ]: 30 : if (dtset%ucrpa > 0) then
3235 : 0 : dtset%nkptgw = Kmesh%nbz
3236 : 0 : Sigp%nkptgw = dtset%nkptgw
3237 [ # # # # : 0 : ABI_MALLOC(Sigp%kptgw, (3, Sigp%nkptgw))
# # # # #
# # # #
# ]
3238 [ # # # # : 0 : ABI_MALLOC(Sigp%minbnd, (Sigp%nkptgw, nsppol))
# # # # #
# # # # #
# # # # ]
3239 [ # # # # : 0 : ABI_MALLOC(Sigp%maxbnd, (Sigp%nkptgw, nsppol))
# # # # #
# # # #
# ]
3240 [ # # # # ]: 0 : Sigp%kptgw(:,:) = Kmesh%bz(:,:)
3241 [ # # # # ]: 0 : Sigp%minbnd = 1
3242 [ # # # # ]: 0 : Sigp%maxbnd = Sigp%nbnds
3243 : :
3244 [ + + ]: 30 : else if (gw_qprange /= 0) then
3245 : : ! Include all the k-points in the IBZ.
3246 : : ! Note that kptgw == ebands%kptns so we can use a single ik index in the loop over k-points
3247 : : ! No need to map kptgw onto ebands%kptns.
3248 : 25 : dtset%nkptgw = Kmesh%nibz
3249 : 25 : Sigp%nkptgw = dtset%nkptgw
3250 [ - + + - : 75 : ABI_MALLOC(Sigp%kptgw, (3, Sigp%nkptgw))
+ - + - -
+ - + -
+ ]
3251 [ - + + - : 100 : ABI_MALLOC(Sigp%minbnd, (Sigp%nkptgw, nsppol))
- + + - +
- + - - +
- + - + ]
3252 [ - + + - : 75 : ABI_MALLOC(Sigp%maxbnd, (Sigp%nkptgw, nsppol))
- + + - -
+ - + -
+ ]
3253 [ + + + + ]: 649 : Sigp%kptgw(:,:) = Kmesh%ibz(:,:)
3254 [ + + + + ]: 206 : Sigp%minbnd = 1
3255 [ + + + + ]: 206 : Sigp%maxbnd = Sigp%nbnds
3256 : :
3257 [ + + ]: 25 : if (gw_qprange > 0) then
3258 : : ! All k-points: Add buffer of bands above and below the Fermi level.
3259 [ + + ]: 2 : do spin=1,nsppol
3260 [ + + ]: 8 : do ik=1,Sigp%nkptgw
3261 : 6 : Sigp%minbnd(ik, spin) = MAX(val_indices(ik,spin) - gw_qprange, 1)
3262 : 7 : Sigp%maxbnd(ik, spin) = MIN(val_indices(ik,spin) + gw_qprange + 1, Sigp%nbnds)
3263 : : end do
3264 : : end do
3265 : :
3266 : : else
3267 : : ! All k-points: include all occupied states and -gw_qprange empty states.
3268 [ + + + + ]: 198 : Sigp%minbnd = 1
3269 [ + + ]: 48 : do spin=1,nsppol
3270 [ + + ]: 198 : do ik=1,Sigp%nkptgw
3271 : 174 : Sigp%maxbnd(ik, spin) = MIN(val_indices(ik,spin) - gw_qprange, Sigp%nbnds)
3272 : : end do
3273 : : end do
3274 : : end if
3275 : :
3276 : : else
3277 : : ! gw_qprange is not specified in the input.
3278 : : ! Include the direct and the fundamental KS gap.
3279 : : ! The main problem here is that kptgw and nkptgw do not depend on the spin and therefore
3280 : : ! we have compute the union of the k-points where the fundamental and the direct KS gaps are located.
3281 : : !
3282 : : ! Find the list of `interesting` kpoints.
3283 [ - + ]: 5 : ABI_CHECK(gap_err == 0, "gw_qprange 0 cannot be used because I cannot find the gap (gap_err !=0)")
3284 : 5 : nk_found = 1; kpos(1) = ks_gaps%fo_kpos(1,1)
3285 : :
3286 [ + + ]: 10 : do spin=1,nsppol
3287 [ + + ]: 25 : do ifo=1,3
3288 : 15 : ik = ks_gaps%fo_kpos(ifo, spin)
3289 : 15 : found = .FALSE.; jj = 0
3290 [ + + ]: 30 : do while (.not. found .and. jj < nk_found)
3291 : 15 : jj = jj + 1; found = (kpos(jj) == ik)
3292 : : end do
3293 [ + + ]: 20 : if (.not. found) then
3294 : 5 : nk_found = nk_found + 1; kpos(nk_found) = ik
3295 : : end if
3296 : : end do
3297 : : end do
3298 : :
3299 : : ! Now we can define the list of k-points and the bands range.
3300 : 5 : dtset%nkptgw = nk_found
3301 : 5 : Sigp%nkptgw = dtset%nkptgw
3302 : :
3303 [ - + + - : 15 : ABI_MALLOC(Sigp%kptgw,(3, Sigp%nkptgw))
+ - - + -
+ - + ]
3304 [ - + + - : 20 : ABI_MALLOC(Sigp%minbnd, (Sigp%nkptgw, nsppol))
- + + - +
- + - - +
- + - + ]
3305 [ - + + - : 15 : ABI_MALLOC(Sigp%maxbnd, (Sigp%nkptgw, nsppol))
- + + - -
+ - + -
+ ]
3306 : :
3307 [ + + ]: 15 : do ii=1,Sigp%nkptgw
3308 : 10 : ik = kpos(ii)
3309 [ + + ]: 40 : Sigp%kptgw(:,ii) = Kmesh%ibz(:,ik)
3310 [ + + ]: 25 : do spin=1,nsppol
3311 : 10 : Sigp%minbnd(ii,spin) = val_indices(ik, spin)
3312 : 20 : Sigp%maxbnd(ii,spin) = val_indices(ik, spin) + 1
3313 : : end do
3314 : : end do
3315 : : end if
3316 : :
3317 : : else
3318 : : ! Treat only the k-points and bands specified in the input file.
3319 : 176 : Sigp%nkptgw = dtset%nkptgw
3320 [ - + + - : 528 : ABI_MALLOC(Sigp%kptgw, (3, Sigp%nkptgw))
+ - + - -
+ - + -
+ ]
3321 [ - + + - : 704 : ABI_MALLOC(Sigp%minbnd, (Sigp%nkptgw, nsppol))
- + + - +
- + - - +
- + - + ]
3322 [ - + + - : 528 : ABI_MALLOC(Sigp%maxbnd, (Sigp%nkptgw, nsppol))
- + + - -
+ - + -
+ ]
3323 : :
3324 [ + + ]: 356 : do spin=1,nsppol
3325 [ + + ]: 666 : Sigp%minbnd(:,spin)= dtset%bdgw(1,:,spin)
3326 [ + + ]: 842 : Sigp%maxbnd(:,spin)= dtset%bdgw(2,:,spin)
3327 : : end do
3328 : :
3329 [ + + ]: 704 : do ii=1,3
3330 [ + + ]: 2138 : do ikcalc=1,Sigp%nkptgw
3331 : 1962 : Sigp%kptgw(ii,ikcalc) = Dtset%kptgw(ii,ikcalc)
3332 : : end do
3333 : : end do
3334 : :
3335 [ + + ]: 356 : do spin=1,nsppol
3336 [ + + ]: 842 : do ikcalc=1,Sigp%nkptgw
3337 [ - + ]: 666 : if (Dtset%bdgw(2,ikcalc,spin) > Sigp%nbnds) then
3338 : : write(msg,'(a,2i0,2(a,i0),2a,i0)')&
3339 : 0 : "For (k,s) ",ikcalc, spin," bdgw= ",Dtset%bdgw(2,ikcalc,spin), " > nbnds=",Sigp%nbnds,ch10,&
3340 : 0 : "Calculation will continue with bdgw =",Sigp%nbnds
3341 : 0 : ABI_COMMENT(msg)
3342 : 0 : Dtset%bdgw(2, ikcalc, spin) = Sigp%nbnds
3343 : : end if
3344 : : end do
3345 : : end do
3346 : :
3347 : : end if
3348 : :
3349 : : ! Make sure that all the degenerate states are included.
3350 : : ! * We will have to average the GW corrections over degenerate states if symsigma=1 is used.
3351 : : ! * KS states belonging to the same irreducible representation should be included in the basis set used for SCGW.
3352 [ + + + + ]: 206 : if (Sigp%symsigma /=0 .or. gwcalctyp >= 10) then
3353 [ + + ]: 303 : do isppol=1,nsppol
3354 [ + + ]: 878 : do ikcalc=1,Sigp%nkptgw
3355 : :
3356 [ + - ]: 672 : if (kmesh%has_IBZ_item(Sigp%kptgw(:,ikcalc), ikibz, G0)) then
3357 : : call ks_ebands%enclose_degbands(ikibz,isppol, &
3358 : 519 : Sigp%minbnd(ikcalc,isppol),Sigp%maxbnd(ikcalc,isppol),changed,dtset%symsigma_de)
3359 : :
3360 [ + + ]: 519 : if (changed) then
3361 : : write(msg,'(2(a,i0),2a,2(1x,i0))')&
3362 : 48 : "Not all the degenerate states at ikcalc= ",ikcalc,", spin= ",isppol, ch10, &
3363 : 96 : "were included in the bdgw set. bdgw has been changed to: ",Sigp%minbnd(ikcalc,isppol),Sigp%maxbnd(ikcalc,isppol)
3364 : 48 : ABI_COMMENT(msg)
3365 : : end if
3366 : : else
3367 : : write(msg,'(3a)')&
3368 : 0 : ' not in the list of k points treated in the preparatory SCF run.',ch10, &
3369 : 0 : ' Change kptgw, or shiftk of previous run.'
3370 [ # # ]: 0 : ABI_ERROR(sjoin('k-point', ktoa(Sigp%kptgw(:,ikcalc)),trim(msg)))
3371 : : end if
3372 : :
3373 : : end do
3374 : : end do
3375 : : end if
3376 : :
3377 [ + + + + ]: 1068 : Sigp%minbdgw = MINVAL(Sigp%minbnd)
3378 [ + + + + ]: 1068 : Sigp%maxbdgw = MAXVAL(Sigp%maxbnd)
3379 : :
3380 : : ! Check if there are duplicated k-point in Sigp%
3381 [ + + ]: 850 : do ii=1,Sigp%nkptgw
3382 [ + + ]: 2292 : do jj=ii+1,Sigp%nkptgw
3383 [ - + ]: 2086 : if (isamek(Sigp%kptgw(:,ii), Sigp%kptgw(:,jj), G0)) then
3384 : : write(msg,'(5a)')&
3385 : 0 : 'kptgw contains duplicated k-points. This is not allowed since ',ch10,&
3386 : 0 : 'the QP corrections for this k-point will be calculated more than once. ',ch10,&
3387 : 0 : 'Check your input file. '
3388 : 0 : ABI_ERROR(msg)
3389 : : end if
3390 : : end do
3391 : : end do
3392 : :
3393 : : !=== Check if the k-points are in the BZ ===
3394 : : ! FB: Honestly the code is not able to treat k-points, which are not in the input list of points in the IBZ.
3395 : : ! This extension should require to change the code in different places.
3396 : : ! Therefore, one should by now prevent the user from calculating sigma for a k-point not in the IBZ.
3397 [ - + + - : 618 : ABI_MALLOC(Sigp%kptgw2bz, (Sigp%nkptgw))
+ - + - -
+ - + -
+ ]
3398 : :
3399 [ + + ]: 850 : do ikcalc=1,Sigp%nkptgw
3400 [ + - ]: 850 : if (kmesh%has_BZ_item(Sigp%kptgw(:,ikcalc), ikcalc2bz, G0)) then
3401 : 644 : Sigp%kptgw2bz(ikcalc) = ikcalc2bz
3402 : : else
3403 : : write(msg,'(3a)')&
3404 : 0 : ' not in the list of k points treated in the preparatory SCF run.',ch10,' Change kptgw, or shiftk of previous run.'
3405 [ # # ]: 0 : ABI_ERROR(sjoin('k-point:', ktoa(Sigp%kptgw(:,ikcalc)),trim(msg)))
3406 : : end if
3407 : : end do
3408 : :
3409 : : ! Warn the user if SCGW run and not all the k-points are included.
3410 [ + + + + ]: 206 : if (gwcalctyp >= 10 .and. Sigp%nkptgw /= Hdr_wfk%nkpt) then
3411 : 3 : write(msg,'(3a,2(a,i0),2a)')ch10,&
3412 : 3 : " COMMENT: In a self-consistent GW run, the QP corrections should be calculated for all the k-points of the KSS file ",ch10,&
3413 : 3 : " but nkptgw= ",Sigp%nkptgw," and WFK nkpt= ",Hdr_wfk%nkpt,ch10,&
3414 : 6 : " Assuming expert user. Execution will continue. "
3415 : 3 : call wrtout(ab_out, msg)
3416 : : end if
3417 : :
3418 : : ! Setup of the table used in the case of SCGW on wavefunctions to reduce the number
3419 : : ! of elements <i,kgw,s|\Sigma|j,kgw,s> that have to be calculated. No use of symmetries, except for Hermiticity.
3420 : 206 : call sigma_tables(Sigp, Kmesh)
3421 : :
3422 : : ! === Read external file and initialize basic dimension of epsm1 ===
3423 : : ! TODO use mqmem as input variable instead of gwmem
3424 : :
3425 : : ! === If required, use a matrix for $\Sigma_c$ which is smaller than that stored on file ===
3426 : : ! * By default the entire matrix is read and used,
3427 : : ! * Define consistently npweps and ecuteps for \Sigma_c according the input
3428 [ + + - + ]: 206 : if (Dtset%npweps>0.or.Dtset%ecuteps>0) then
3429 [ + - ]: 128 : if (Dtset%npweps>0) Dtset%ecuteps=zero
3430 : 128 : nsheps=0
3431 : 128 : call setshells(Dtset%ecuteps,Dtset%npweps,nsheps,Dtset%nsym,gmet,gprimd,Dtset%symrel,'eps',ucvol)
3432 : : end if
3433 : :
3434 [ + + ]: 206 : mqmem=0; if (Dtset%gwmem/10==1) mqmem=1
3435 : :
3436 [ + + + + : 206 : if (dtset%getscr /=0 .or. dtset%irdscr/=0 .or. dtset%getscr_filepath /= ABI_NOFILE) then
+ + ]
3437 : 166 : fname = Dtfil%fnameabi_scr
3438 [ + + + + ]: 40 : else if (Dtset%getsuscep/=0 .or. Dtset%irdsuscep/=0) then
3439 : 5 : fname = Dtfil%fnameabi_sus
3440 : : else
3441 : 35 : fname = Dtfil%fnameabi_scr
3442 : : !FIXME this has to be cleaned, in tgw2_3 Dtset%get* and Dtset%ird* are not defined
3443 : : !ABI_ERROR("getsuscep or irdsuscep are not defined")
3444 : : end if
3445 : : !
3446 : : ! === Setup of q-mesh in the whole BZ ===
3447 : : ! Stop if a nonzero umklapp is needed to reconstruct the BZ. In this case, indeed,
3448 : : ! epsilon^-1(Sq) should be symmetrized in csigme using a different expression (G-G_o is needed)
3449 : : !
3450 [ + + ]: 206 : if (sigp%needs_w()) then
3451 [ + - ]: 171 : if (.not. file_exists(fname)) then
3452 : 171 : fname = nctk_ncify(fname)
3453 : 171 : ABI_COMMENT(sjoin("File not found. Will try netcdf file:", fname))
3454 : : end if
3455 : :
3456 : : ! Initialize epsm1 from fname.
3457 : 171 : call epsm1%from_file(fname, mqmem, Dtset%npweps, comm)
3458 : :
3459 : 171 : Sigp%npwc=epsm1%npwe
3460 [ + + ]: 171 : if (Sigp%npwc>Sigp%npwx) then
3461 : 14 : Sigp%npwc=Sigp%npwx
3462 : 14 : ABI_COMMENT("Found npw_correlation > npw_exchange, Imposing npwc=npwx")
3463 : : ! There is a good reason for doing so, see csigme.F90 and the size of the arrays
3464 : : ! rhotwgp and rhotwgp: we need to define a max size and we opt for Sigp%npwx.
3465 : : end if
3466 : :
3467 [ + + ]: 171 : if (Dtset%nfreqim_conv==0) then
3468 : : ! If no extra frequencies is requested, keep the original grids.
3469 : 170 : epsm1%nomega_i_conv = 0
3470 [ - + ]: 1 : else if (Dtset%nfreqim_conv < 0) then
3471 : : ! If negative number of frequencies is requested, multiply the number of frequencies in the file by the absolute value.
3472 : 0 : epsm1%nomega_i_conv = abs(Dtset%nfreqim_conv) * epsm1%nomega_i
3473 : 0 : Dtset%nfreqim_conv = epsm1%nomega_i_conv
3474 [ + - ]: 1 : else if (Dtset%nfreqim_conv >= epsm1%nomega_i) then
3475 : : ! If the requested number of frequencies is larger than the number in the file, use input value.
3476 : 1 : epsm1%nomega_i_conv = Dtset%nfreqim_conv
3477 : : else if (Dtset%nfreqim_conv < epsm1%nomega_i) then
3478 : : ! If the requested number of frequencies is less than the number in the file, give an error
3479 : 0 : ABI_ERROR(sjoin("Requested number of frequencies for convolution is non-zero and less than nfreqim in the file: ", itoa(Dtset%nfreqim_conv)," < ", itoa(epsm1%nomega_i)))
3480 : : end if
3481 : :
3482 : 171 : epsm1%npwe=Sigp%npwc
3483 : 171 : Dtset%npweps=epsm1%npwe
3484 : 171 : call Qmesh%init(Cryst,epsm1%nqibz,epsm1%qibz,Dtset%kptopt)
3485 : :
3486 : : else
3487 : 35 : epsm1%npwe =1
3488 : 35 : Sigp%npwc =1
3489 : 35 : Dtset%npweps=1
3490 : 35 : call qmesh%find_qmesh(Cryst,Kmesh)
3491 [ - + - + ]: 35 : ABI_MALLOC(epsm1%gvec,(3,1))
3492 [ + + ]: 140 : epsm1%gvec(:,1) = [0, 0, 0]
3493 : 35 : epsm1%nomega = 0
3494 : : end if
3495 : :
3496 : 206 : call Qmesh%print(units, header="Q-mesh for screening function", prtvol=Dtset%prtvol)
3497 : :
3498 [ + + ]: 10432 : do iqbz=1,Qmesh%nbz
3499 : 10226 : call qmesh%get_BZ_item(iqbz, q_bz, iq_ibz, isym, itim, umklp=q_umklp)
3500 : : !print *, "iqbz, q_bz, iq_ibz, isym, itim, umklp"
3501 : : !print *, iqbz, q_bz, iq_ibz, isym, itim, q_umklp
3502 : :
3503 [ + + + - : 41110 : if (ANY(q_umklp/=0)) then
- + ]
3504 [ # # # # : 0 : sq = (3-2*itim)*MATMUL(Cryst%symrec(:,:,isym),Qmesh%ibz(:,iq_ibz))
# # # # #
# # # #
# ]
3505 : 0 : write(std_out,*) sq,Qmesh%bz(:,iqbz)
3506 : : write(msg,'(a,3f6.3,a,3f6.3,2a,9i3,a,i2,2a)')&
3507 : 0 : 'qpoint ',Qmesh%bz(:,iqbz),' is the symmetric of ',Qmesh%ibz(:,iq_ibz),ch10,&
3508 : 0 : 'through operation ',Cryst%symrec(:,:,isym),' and itim ',itim,ch10,&
3509 : 0 : 'however a non-zero umklapp G_o vector is required and this is not yet allowed'
3510 : 0 : ABI_ERROR(msg)
3511 : : end if
3512 : : end do
3513 : : !stop
3514 : : !
3515 : : ! === Find optimal value for G-sphere enlargement due to oscillator matrix elements ===
3516 : : ! * Here I have to be sure that Qmesh%bz is always inside the BZ, not always true size bz is buggy
3517 : : ! * -one is used because we loop over all the possible differences, unlike screening
3518 : :
3519 : 206 : call get_ng0sh(Sigp%nkptgw,Sigp%kptgw,Kmesh%nbz,Kmesh%bz,Qmesh%nbz,Qmesh%bz,-one,ng0sh_opt)
3520 : 206 : call wrtout(std_out, sjoin(' Optimal value for ng0sh ', ltoa(ng0sh_opt)))
3521 [ + + ]: 824 : Sigp%mG0 = ng0sh_opt
3522 : :
3523 : : ! G-sphere for W and Sigma_c is initialized from the SCR file.
3524 : 206 : call Gsph_c%init(Cryst, epsm1%npwe, gvec=epsm1%gvec)
3525 [ - + ]: 206 : call Gsph_x%init(Cryst, Sigp%npwx, gvec=gvec_kss)
3526 : 206 : Sigp%ecuteps = Gsph_c%ecut
3527 : 206 : Dtset%ecuteps = Sigp%ecuteps
3528 : :
3529 : : ! Make biggest G-sphere of Sigp%npwvec vectors.
3530 : 206 : Sigp%npwvec=MAX(Sigp%npwwfn,Sigp%npwx)
3531 [ - + ]: 206 : call Gsph_Max%init(Cryst, Sigp%npwvec, gvec=gvec_kss)
3532 : :
3533 : : !BEGIN DEBUG
3534 : : !Make sure that the two G-spheres are equivalent.
3535 : : !ierr=0
3536 : : !if (sigp%needs_w()) then
3537 : : ! ng = MIN(SIZE(Gsph_c%gvec,DIM=2),SIZE(gvec_kss,DIM=2))
3538 : : ! do ig1=1,ng
3539 : : ! if (ANY(Gsph_c%gvec(:,ig1)/=gvec_kss(:,ig1))) then
3540 : : ! ierr=ierr+1
3541 : : ! write(std_out,*)" Gsph_c, gvec_kss ",ig1,"/",ng,Gsph_c%gvec(:,ig1),gvec_kss(:,ig1)
3542 : : ! end if
3543 : : ! end do
3544 : : ! ABI_CHECK(ierr==0,"Mismatch between Gsph_c and gvec_kss")
3545 : : !end if
3546 : : !ierr=0
3547 : : !ng = MIN(SIZE(Gsph_x%gvec,DIM=2),SIZE(gvec_kss,DIM=2))
3548 : : !do ig1=1,ng
3549 : : ! if (ANY(Gsph_x%gvec(:,ig1)/=gvec_kss(:,ig1))) then
3550 : : ! ierr=ierr+1
3551 : : ! write(std_out,*)" Gsph_x, gvec_kss ",ig1,"/",ng,Gsph_x%gvec(:,ig1),gvec_kss(:,ig1)
3552 : : ! end if
3553 : : !end do
3554 : : !ABI_CHECK(ierr==0,"Mismatch between Gsph_x and gvec_kss")
3555 : : !END DEBUG
3556 : :
3557 [ - + ]: 206 : ABI_FREE(gvec_kss)
3558 : : !
3559 : : ! === Get Fourier components of the Coulomb term for all q-points in the IBZ ===
3560 : : ! * If required, use a cutoff in the interaction
3561 : : ! * Pcv%vc_sqrt contains Vc^{-1/2}
3562 : : ! * Setup also the analytical calculation of the q->0 component
3563 : : ! FIXME recheck ngfftf since I got different charge outside the cutoff region
3564 : :
3565 [ + - ]: 206 : if (Dtset%gw_nqlwl==0) then
3566 : 206 : nqlwl=1
3567 [ - + ]: 206 : ABI_MALLOC(qlwl,(3,nqlwl))
3568 [ + + ]: 824 : qlwl(:,1)= GW_Q0_DEFAULT
3569 : : else
3570 : 0 : nqlwl=Dtset%gw_nqlwl
3571 [ # # # # : 0 : ABI_MALLOC(qlwl,(3,nqlwl))
# # # # #
# # # ]
3572 [ # # # # ]: 0 : qlwl(:,:)=Dtset%gw_qlwl(:,1:nqlwl)
3573 : : end if
3574 : :
3575 : : ! The Coulomb interaction used here might have two terms:
3576 : : ! the first term generates the usual sigma self-energy, but possibly, one should subtract
3577 : : ! from it the Coulomb interaction already present in the Kohn-Sham basis,
3578 : : ! if the usefock associated to ixc is one.
3579 : : ! The latter excludes (in the present implementation) mod(Dtset%gwcalctyp,10)==5
3580 : 206 : nvcoul_init=1
3581 : 206 : call get_xclevel(Dtset%ixc,xclevel_ixc,usefock_ixc)
3582 : :
3583 [ + + ]: 206 : if(usefock_ixc==1)then
3584 : 3 : nvcoul_init=2
3585 [ - + ]: 3 : if (mod(Dtset%gwcalctyp, 10) == 5)then
3586 : 0 : write(msg,'(4a,i3,a,i3,4a,i5)')ch10,&
3587 : 0 : ' The starting wavefunctions were obtained from SCF calculations in the planewave basis set',ch10,&
3588 : 0 : ' with ixc = ',Dtset%ixc,' associated with usefock =',usefock_ixc,ch10,&
3589 : 0 : ' In this case, the present implementation does not allow that the self-energy for sigma corresponds to',ch10,&
3590 : 0 : ' mod(gwcalctyp,10)==5, while your gwcalctyp= ',Dtset%gwcalctyp
3591 : 0 : ABI_ERROR(msg)
3592 : : endif
3593 : : endif
3594 [ + + ]: 415 : do ivcoul_init=1,nvcoul_init
3595 : 209 : rcut = Dtset%gw_rcut
3596 : 209 : icutcoul_eff=Dtset%gw_icutcoul
3597 : 209 : Sigp%sigma_mixing=one
3598 [ + + + + ]: 209 : if( mod(Dtset%gwcalctyp,10)==5 .or. ivcoul_init==2)then
3599 [ + + ]: 38 : if(abs(Dtset%hyb_mixing)>tol8)then
3600 : : ! Warning: the absolute value is needed, because of the singular way used to define the default for this input variable
3601 : 20 : Sigp%sigma_mixing=abs(Dtset%hyb_mixing)
3602 [ + - ]: 18 : else if(abs(Dtset%hyb_mixing_sr)>tol8)then
3603 : 18 : Sigp%sigma_mixing=abs(Dtset%hyb_mixing_sr)
3604 : 18 : icutcoul_eff=5
3605 : : endif
3606 [ + + + + ]: 38 : if(abs(rcut)<tol6 .and. abs(Dtset%hyb_range_fock)>tol8) rcut=one/Dtset%hyb_range_fock
3607 : : endif
3608 : :
3609 [ + + ]: 415 : if (ivcoul_init == 1) then
3610 : :
3611 [ + + ]: 206 : if (Gsph_x%ng > Gsph_c%ng) then
3612 : : call Vcp%init(Gsph_x,Cryst,Qmesh,Kmesh,rcut,icutcoul_eff,Dtset%vcutgeo,&
3613 : 137 : Gsph_x%ng,nqlwl,qlwl,comm)
3614 : : else
3615 : : call Vcp%init(Gsph_c,Cryst,Qmesh,Kmesh,rcut,icutcoul_eff,Dtset%vcutgeo,&
3616 : 69 : Gsph_c%ng,nqlwl,qlwl,comm)
3617 : : end if
3618 : :
3619 : : else
3620 : :
3621 : : ! Use a temporary Vcp_ks to compute the Coulomb interaction already present
3622 : : ! in the Fock part of the Kohn-Sham Hamiltonian
3623 [ + - ]: 3 : if (Gsph_x%ng > Gsph_c%ng) then
3624 : : call Vcp_ks%init(Gsph_x,Cryst,Qmesh,Kmesh,rcut,icutcoul_eff,Dtset%vcutgeo,&
3625 : 3 : Gsph_x%ng,nqlwl,qlwl,comm)
3626 : : else
3627 : : call Vcp_ks%init(Gsph_c,Cryst,Qmesh,Kmesh,rcut,icutcoul_eff,Dtset%vcutgeo,&
3628 : 0 : Gsph_c%ng,nqlwl,qlwl,comm)
3629 : : end if
3630 : :
3631 : : ! Now compute the residual Coulomb interaction.
3632 [ + - + - : 1194 : Vcp%vc_sqrt_resid=sqrt(Vcp%vc_sqrt**2-Sigp%sigma_mixing*Vcp_ks%vc_sqrt**2)
- + - - +
+ + + ]
3633 : 3 : Vcp%i_sz_resid=Vcp%i_sz-Sigp%sigma_mixing*Vcp_ks%i_sz
3634 : :
3635 : : ! The mixing factor has already been accounted for, so set it back to one
3636 : 3 : Sigp%sigma_mixing=one
3637 : 3 : call Vcp_ks%free()
3638 : :
3639 : : !write(std_out,'(a)')' setup_sigma : the residual Coulomb interaction has been computed'
3640 : : endif
3641 : :
3642 : : !#else
3643 : : ! call Vcp%init(Gsph_Max,Cryst,Qmesh,Kmesh,rcut,icutcoul_eff,ivcoul_init,Dtset%vcutgeo,&
3644 : : !& Dtset%ecutsigx,Sigp%npwx,nqlwl,qlwl,ngfftf,comm)
3645 : : !#endif
3646 : :
3647 : : end do
3648 : :
3649 : : #if 1
3650 : : ! Using the random q for the optical limit is one of the reasons
3651 : : ! why sigma breaks the initial energy degeneracies.
3652 [ - + ]: 206 : if (dtset%userra > 100) then
3653 : 0 : call wrtout(units, "I am setting Vcp%i_sz=zero, Vcp%vc_sqrt(1,1)=czero, Vcp%vcqlwl_sqrt(1,1)=czero")
3654 : 0 : Vcp%i_sz=zero
3655 : 0 : Vcp%vc_sqrt(1,1)=czero
3656 : 0 : Vcp%vcqlwl_sqrt(1,1)=czero
3657 : : end if
3658 : : #endif
3659 : :
3660 [ - + ]: 206 : ABI_FREE(qlwl)
3661 : :
3662 : 206 : Sigp%ecuteps = Dtset%ecuteps
3663 : 206 : Sigp%ecutwfn = Dtset%ecutwfn
3664 : 206 : Sigp%ecutsigx = Dtset%ecutsigx
3665 : :
3666 : : ! === Setup of the FFT mesh for the oscillator strengths ===
3667 : : ! * Init gwc_ngfft(7:18) and gwx_ngfft(7:18) with Dtset%ngfft(7:18)
3668 : : ! * Here we redefine gwc_ngfft(1:6) according to the following options:
3669 : : !
3670 : : ! method == 0 --> FFT grid read from fft.in (debugging purpose)
3671 : : ! method == 1 --> Normal FFT mesh
3672 : : ! method == 2 --> Slightly augmented FFT grid to calculate exactly rho_tw_g (see setmesh.F90)
3673 : : ! method == 3 --> Doubled FFT grid, same as the the FFT for the density,
3674 : : !
3675 : : ! enforce_sym == 1 --> Enforce a FFT mesh compatible with all the symmetry operation and FFT library
3676 : : ! enforce_sym == 0 --> Find the smallest FFT grid compatible with the library, do not care about symmetries
3677 : : !
3678 [ + + ]: 3914 : gwc_ngfft(1:18) = Dtset%ngfft(1:18)
3679 [ + + ]: 3914 : gwx_ngfft(1:18) = Dtset%ngfft(1:18)
3680 : :
3681 : 206 : method = 2
3682 [ - + ]: 206 : if (Dtset%fftgw == 00 .or. Dtset%fftgw == 01) method = 0
3683 [ + + ]: 206 : if (Dtset%fftgw == 10 .or. Dtset%fftgw == 11) method = 1
3684 [ + + ]: 206 : if (Dtset%fftgw == 20 .or. Dtset%fftgw == 21) method = 2
3685 [ - + ]: 206 : if (Dtset%fftgw == 30 .or. Dtset%fftgw == 31) method = 3
3686 : 206 : enforce_sym = mod(dtset%fftgw, 10)
3687 : :
3688 : : ! FFT mesh for sigma_x.
3689 : : call setmesh(gmet, Gsph_Max%gvec, gwx_ngfft, Sigp%npwvec, Sigp%npwx, Sigp%npwwfn, &
3690 : 206 : gwx_nfftot, method, Sigp%mG0, Cryst, enforce_sym)
3691 : :
3692 : : ! FFT mesh for sigma_c.
3693 : : call setmesh(gmet, Gsph_Max%gvec, gwc_ngfft, Sigp%npwvec, epsm1%npwe, Sigp%npwwfn,&
3694 : 206 : gwc_nfftot, method, Sigp%mG0, Cryst, enforce_sym, unit=dev_null)
3695 : :
3696 : : ! ======================================================================
3697 : : ! ==== Check for presence of files with core orbitals, for PAW only ====
3698 : : ! ======================================================================
3699 : 206 : Sigp%use_sigxcore=0
3700 [ + + + + ]: 206 : if (Dtset%usepaw==1.and.Dtset%gw_sigxcore==1) then
3701 : 2 : ii = 0
3702 [ + + ]: 5 : do itypat=1,Cryst%ntypat
3703 : 3 : call pawpsp_check_corefile(fcore,ex,Psps%filpsp(itypat))
3704 [ + - ]: 5 : if (ex) then
3705 : 3 : ii = ii+1
3706 : : else
3707 : 0 : write(msg,'(a,i2)') "HF decoupling is required but cannot find file for itypat:", itypat
3708 : 0 : ABI_WARNING(msg)
3709 : : end if
3710 : : end do
3711 : :
3712 : 2 : Sigp%use_sigxcore=1
3713 [ - + ]: 2 : if (ii/=Cryst%ntypat) then
3714 : 0 : ABI_ERROR("Files with core orbitals not found")
3715 : : end if
3716 : : end if ! PAW+HF decoupling
3717 : : !
3718 : : ! ==============================
3719 : : ! ==== Extrapolar technique ====
3720 : : ! ==============================
3721 : 206 : Sigp%gwcomp = Dtset%gwcomp
3722 : 206 : Sigp%gwencomp = Dtset%gwencomp
3723 : :
3724 [ + + ]: 206 : if (Sigp%gwcomp==1) then
3725 : 19 : write(msg,'(6a,e11.4,a)')ch10,&
3726 : 19 : 'Using the extrapolar approximation to accelerate convergence',ch10,&
3727 : 19 : 'with respect to the number of bands included',ch10,&
3728 : 38 : 'with gwencomp: ',Sigp%gwencomp*Ha_eV,' [eV]'
3729 : 19 : call wrtout(std_out, msg)
3730 : : end if
3731 : : !
3732 : : ! ===================================
3733 : : ! ==== Final compatibility tests ====
3734 : : ! ===================================
3735 [ + + + - : 1453 : ltest=(ks_ebands%mband == Sigp%nbnds .and. ALL(ks_ebands%nband == Sigp%nbnds))
+ - - + ]
3736 : 0 : ABI_CHECK(ltest, 'BUG in definition of ks_ebands%nband')
3737 : :
3738 [ + + ]: 206 : if (mod10==SIG_GW_AC) then
3739 : : !if (Sigp%gwcalctyp/=1) ABI_ERROR("Self-consistency with AC not implemented") ! MRM: let's allow it
3740 [ - + ]: 9 : if (Sigp%gwcomp==1) ABI_ERROR("AC with extrapolar technique not implemented")
3741 : : end if
3742 : :
3743 : : ! For analytic continuation define the number of imaginary frequencies for Sigma
3744 : : ! Tests show than more than 12 freqs in the Pade approximant worsen the results!
3745 : 197 : Sigp%nomegasi = 0
3746 : :
3747 : : !TODO this should not be done here but in init_sigma_t
3748 : : if (mod10 == 1) then
3749 : 9 : Sigp%nomegasi = abs(Dtset%nomegasi)
3750 : 9 : iw_mesh_type = "linear"
3751 [ + + ]: 9 : if (dtset%nomegasi < 0) iw_mesh_type = "minimax"
3752 : 9 : Sigp%omegasimax = Dtset%omegasimax
3753 : 9 : Sigp%omegasimin = OMEGASIMIN
3754 [ - + + - : 27 : ABI_MALLOC(Sigp%omegasi, (Sigp%nomegasi))
+ - + - -
+ - + -
+ ]
3755 : :
3756 : 7 : select case (iw_mesh_type)
3757 : : case ("linear")
3758 : : ! Linear mesh along the imaginary axis.
3759 : 7 : domegasi=Sigp%omegasimax/(Sigp%nomegasi-1)
3760 [ + + ]: 187 : do io=1,Sigp%nomegasi
3761 : 187 : Sigp%omegasi(io)=CMPLX(zero,(io-1)*domegasi)
3762 : : end do
3763 : :
3764 : : case ("minimax")
3765 : : ! Minimax mesh along the imaginary axis.
3766 : 2 : nbsum = sigp%nbnds
3767 : : !call wrtout(std_out, "Computing minimax grid")
3768 : :
3769 : : ! Compute min/max transition energy taking into account nsppol if any.
3770 [ + - - + : 6 : te_min = minval(ks_gaps%cb_min - ks_gaps%vb_max)
- - + + ]
3771 [ + + + + : 16 : te_max = maxval(ks_ebands%eig(nbsum,:,:) - ks_ebands%eig(1,:,:))
+ + + - -
+ - - ]
3772 [ - + ]: 2 : if (te_min <= tol6) then
3773 : 0 : te_min = tol6
3774 : 0 : ABI_ERROR("System is metallic or with a very small fundamental gap! Check energies in WFK file!")
3775 : : end if
3776 : :
3777 : : call gx_minimax_grid(sigp%nomegasi, te_min, te_max, & ! in
3778 : : tau_mesh, tau_wgs, iw_mesh, iw_wgs, & ! out args allocated by the routine.
3779 : : cosft_wt, cosft_tw, sinft_wt, &
3780 [ - + - + : 2 : ft_max_error, cosft_duality_error, ierr)
- + - + -
+ - + -
+ ]
3781 [ - + ]: 2 : ABI_CHECK(ierr == 0, "Error in gx_minimax_grid")
3782 : :
3783 [ + - - + : 34 : Sigp%omegasi = j_dpc * iw_mesh
- - + + ]
3784 : :
3785 [ - + ]: 2 : ABI_FREE_NOCOUNT(tau_mesh)
3786 [ - + ]: 2 : ABI_FREE_NOCOUNT(tau_wgs)
3787 [ - + ]: 2 : ABI_FREE_NOCOUNT(iw_mesh)
3788 [ - + ]: 2 : ABI_FREE_NOCOUNT(iw_wgs)
3789 [ - + ]: 2 : ABI_FREE_NOCOUNT(cosft_wt)
3790 [ - + ]: 2 : ABI_FREE_NOCOUNT(cosft_tw)
3791 [ - + ]: 2 : ABI_FREE_NOCOUNT(sinft_wt)
3792 : :
3793 : : case default
3794 [ + + - ]: 9 : ABI_ERROR(sjoin("Invalid iw_mesh_type:", iw_mesh_type))
3795 : : end select
3796 : :
3797 : 9 : write(msg,'(7a,i3,2(2a,f8.3),a)')ch10,&
3798 : 9 : ' Parameters for the analytic continuation of Sigma_c(i omega): ',ch10,&
3799 : 9 : ' Mesh type: = ',trim(iw_mesh_type), ch10, &
3800 : 9 : ' Number of imaginary frequencies = ',Sigp%nomegasi,ch10,&
3801 [ + - - + : 228 : ' Min frequency on imag axis (eV) = ',minval(aimag(sigp%omegasi)) * Ha_eV,ch10,&
- - + + ]
3802 [ + - - + : 237 : ' Max frequency on imag axis (eV) = ',maxval(aimag(sigp%omegasi)) * Ha_eV,ch10
- - + + ]
3803 : 9 : call wrtout(units, msg)
3804 : :
3805 : : ! MRM: do not print for 1-RDM correction
3806 [ + + ]: 9 : if (Sigp%gwcalctyp /= 21) then
3807 : 4 : write(msg,'(4a)')ch10,&
3808 : 4 : ' setup_sigma: calculating Sigma(iw)',&
3809 : 8 : ' at imaginary frequencies (eV) (Fermi Level set to 0) ',ch10
3810 : 4 : call wrtout(units, msg)
3811 [ + + ]: 54 : do io=1,Sigp%nomegasi
3812 : 50 : write(msg,'(2(f10.3,2x))')Sigp%omegasi(io)*Ha_eV
3813 : 54 : call wrtout(units, msg)
3814 : : end do
3815 : 4 : call wrtout(units, "")
3816 : : endif
3817 : :
3818 [ + - - + ]: 9 : ltest=(Sigp%omegasimax>0.1d-4.and.Sigp%nomegasi>0)
3819 : 0 : ABI_CHECK(ltest,'Wrong value of omegasimax or nomegasi')
3820 : : !if (Sigp%gwcalctyp/=1) then !
3821 : : ! !ABI_ERROR("SC-GW with analytic continuation is not coded") ! MRM: let's allow it
3822 : : !end if
3823 : : end if
3824 : :
3825 [ + + - + ]: 206 : if (Sigp%symsigma/=0.and.gwcalctyp>=20) then
3826 : 0 : ABI_WARNING("SC-GW with symmetries is still under development. Use at your own risk!")
3827 : 0 : ABI_ERROR("SC-GW requires symsigma == 0 in input. New default in Abinit9 is symsigma 1!")
3828 : : end if
3829 : :
3830 : : ! Setup parameters for Spectral function.
3831 [ + + ]: 206 : if (Dtset%gw_customnfreqsp/=0) then
3832 : 1 : Sigp%nomegasr = Dtset%gw_customnfreqsp
3833 : 1 : ABI_WARNING('Custom grid for spectral function specified. Assuming experienced user.')
3834 [ + - ]: 1 : if (Dtset%gw_customnfreqsp/=0) then
3835 : 1 : Dtset%nfreqsp = Dtset%gw_customnfreqsp
3836 : 1 : ABI_WARNING('nfreqsp has been set to the same number as gw_customnfreqsp')
3837 : : end if
3838 : : else
3839 : 205 : Sigp%nomegasr =Dtset%nfreqsp
3840 : 205 : Sigp%minomega_r=Dtset%freqspmin
3841 : 205 : Sigp%maxomega_r=Dtset%freqspmax
3842 : :
3843 : : ! TODO: Mesh should be centered on e0
3844 : : if (mod10 == 1 .and. sigp%nomegasr == 0 .and. Sigp%gwcalctyp /= 21) then
3845 : : ! Note that in AC computing quantities on the real-axis is really cheap
3846 : : ! so we can use very dense meshes without affecting performance.
3847 : : ! The default for nfresp and freqspmax is zero.
3848 : : ! Here we compute wr_step and nwrt so that we have e0 +- the expected plasmom frequency
3849 : : drude_plasmon_freq = sqrt(four_pi * ks_ebands%nelect / cryst%ucvol)
3850 : : wmax = dtset%freqspmax; if (abs(wmax) < tol6) wmax = two * drude_plasmon_freq
3851 : : !sigp%nomegasr = nint(wmax / (0.05_dp * eV_Ha))
3852 : : !if (mod(sigp%nomegasr, 2) == 0) sigp%nomegasr = sigp%nomegasr + 1
3853 : : !sigp%maxomega_r = wmax
3854 : : end if
3855 : :
3856 : : end if
3857 : :
3858 : : ! FIXME: after the definition of Sigp%nomegasr (Sigp is intent(out)).
3859 [ + + + + ]: 206 : if (Dtset%symsigma/=0 .and. Sigp%nomegasr/=0) then
3860 [ - + ]: 1 : if (cryst%idx_spatial_inversion() == 0) then
3861 : 0 : write(msg,'(5a)')' setup_sigma : BUG :',ch10,&
3862 : 0 : 'It is not possible to use symsigma /= 0 to calculate the spectral function ',ch10,&
3863 : 0 : 'when the system does not have the spatial inversion. Please use symsigma=0 '
3864 : 0 : ABI_WARNING(msg)
3865 : : end if
3866 : : end if
3867 : :
3868 [ + + ]: 206 : if (Sigp%nomegasr > 0) then
3869 [ + + ]: 5 : if (Dtset%gw_customnfreqsp == 0) then
3870 : : ! Check
3871 [ - + ]: 4 : if (Sigp%minomega_r >= Sigp%maxomega_r) then
3872 : 0 : ABI_ERROR('freqspmin must be smaller than freqspmax!')
3873 : : end if
3874 : 4 : domegas = zero
3875 [ + - ]: 4 : if(Sigp%nomegasr /= 1) domegas = (Sigp%maxomega_r-Sigp%minomega_r)/(Sigp%nomegasr-1)
3876 : :
3877 : : !TODO this should be moved to Sr% and done in init_sigma_t
3878 [ - + + - : 12 : ABI_MALLOC(Sigp%omega_r,(Sigp%nomegasr))
+ - + - -
+ - + -
+ ]
3879 [ + + ]: 804 : do io=1,Sigp%nomegasr
3880 : 804 : Sigp%omega_r(io) = CMPLX(Sigp%minomega_r + domegas*(io-1),zero)
3881 : : end do
3882 : 4 : write(msg,'(4a,i8,3(2a,f8.3),a)')ch10,&
3883 : 4 : ' Parameters for the calculation of the spectral function : ',ch10,&
3884 : 4 : ' Number of points = ',Sigp%nomegasr,ch10,&
3885 : 4 : ' Min frequency [eV] = ',Sigp%minomega_r*Ha_eV,ch10,&
3886 : 4 : ' Max frequency [eV] = ',Sigp%maxomega_r*Ha_eV,ch10,&
3887 : 8 : ' Frequency step [eV] = ',domegas*Ha_eV,ch10
3888 : 4 : call wrtout(std_out, msg)
3889 : : else
3890 [ + - - + : 10 : Sigp%minomega_r = MINVAL(Dtset%gw_freqsp(:))
- - + + ]
3891 [ + - - + : 10 : Sigp%maxomega_r = MAXVAL(Dtset%gw_freqsp(:))
- - + + ]
3892 : : !TODO this should be moved to Sr% and done in init_sigma_t
3893 [ - + + - : 3 : ABI_MALLOC(Sigp%omega_r, (Sigp%nomegasr))
+ - - + -
+ - + ]
3894 [ + + ]: 9 : do io=1,Sigp%nomegasr
3895 : 9 : Sigp%omega_r(io) = CMPLX(Dtset%gw_freqsp(io), zero)
3896 : : end do
3897 : 1 : write(msg,'(4a,i8,2(2a,f8.3),3a)')ch10,&
3898 : 1 : ' Parameters for the calculation of the spectral function : ',ch10,&
3899 : 1 : ' Number of points = ',Sigp%nomegasr,ch10,&
3900 : 1 : ' Min frequency [eV] = ',Sigp%minomega_r*Ha_eV,ch10,&
3901 : 1 : ' Max frequency [eV] = ',Sigp%maxomega_r*Ha_eV,ch10,&
3902 : 2 : ' A custom set of frequencies is used! See the input file for values.',ch10
3903 : 1 : call wrtout(std_out, msg)
3904 : : end if
3905 : : end if
3906 : :
3907 [ - + ]: 206 : ABI_FREE(val_indices)
3908 : 206 : call ks_gaps%free()
3909 : :
3910 : : DBG_EXIT('COLL')
3911 : :
3912 [ - + - + : 824 : end subroutine setup_sigma
- + - + -
+ - + - +
- + - + -
+ - - - -
- - - - -
- - - - -
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + ]
3913 : : !!***
3914 : :
3915 : : !----------------------------------------------------------------------
3916 : :
3917 : : !!****f* ABINIT/sigma_tables
3918 : : !! NAME
3919 : : !! sigma_tables
3920 : : !!
3921 : : !! FUNCTION
3922 : : !! Build symmetry tables used to speedup self-consistent GW calculations.
3923 : : !!
3924 : : !! INPUTS
3925 : : !! Kmesh <kmesh_t>=Structure describing the k-point sampling.
3926 : : !! [esymm(Kmesh%nibz,Sigp%nsppol)]= Bands_Symmetries
3927 : : !!
3928 : : !! SiDE EFFECTS
3929 : : !! Sigp<sigparams_t>=This routine initializes the tables:
3930 : : !! %Sigcij_tab
3931 : : !! %Sigxij_tab
3932 : : !! that are used to select the matrix elements of the self-energy that have to be calculated.
3933 : : !!
3934 : : !! SOURCE
3935 : :
3936 : 412 : subroutine sigma_tables(Sigp, Kmesh, esymm)
3937 : :
3938 : : use m_sigtk, only : sigtk_sigma_tables
3939 : :
3940 : : !Arguments ------------------------------------
3941 : : !scalars
3942 : : type(sigparams_t),target,intent(inout) :: Sigp
3943 : : type(kmesh_t),intent(in) :: Kmesh
3944 : : !arrays
3945 : : type(esymm_t),optional,intent(in) :: esymm(Kmesh%nibz, Sigp%nsppol)
3946 : :
3947 : : !Local variables-------------------------------
3948 : : !scalars
3949 : : integer :: ikcalc,ik_ibz
3950 : : logical :: sigc_is_herm, only_diago
3951 : : !arrays
3952 : 206 : integer,allocatable :: kcalc2ibz(:)
3953 : : ! *************************************************************************
3954 : :
3955 : 206 : only_diago = sigp%gwcalctyp < 20
3956 : 206 : sigc_is_herm = sigp%is_herm()
3957 : :
3958 [ - + + - : 618 : ABI_MALLOC(kcalc2ibz, (sigp%nkptgw))
+ - + - -
+ - + ]
3959 [ + + ]: 850 : do ikcalc=1,sigp%nkptgw
3960 : 644 : ik_ibz = Kmesh%tab(Sigp%kptgw2bz(ikcalc))
3961 : 850 : kcalc2ibz(ikcalc) = ik_ibz
3962 : : end do
3963 : :
3964 [ - + ]: 206 : if (present(esymm)) then
3965 : : call sigtk_sigma_tables(sigp%nkptgw, kmesh%nibz, sigp%nsppol, sigp%minbnd, sigp%maxbnd, kcalc2ibz, &
3966 : 0 : only_diago, sigc_is_herm, sigp%sigxij_tab, sigp%sigcij_tab, esymm=esymm)
3967 : : else
3968 : : call sigtk_sigma_tables(sigp%nkptgw, kmesh%nibz, sigp%nsppol, sigp%minbnd, sigp%maxbnd, kcalc2ibz, &
3969 : 206 : only_diago, sigc_is_herm, sigp%sigxij_tab, sigp%sigcij_tab)
3970 : : end if
3971 : :
3972 [ - + ]: 206 : ABI_FREE(kcalc2ibz)
3973 : :
3974 : 206 : end subroutine sigma_tables
3975 : : !!***
3976 : :
3977 : : !----------------------------------------------------------------------
3978 : :
3979 : : !!****f* ABINIT/sigma_bksmask
3980 : : !! NAME
3981 : : !! sigma_bksmask
3982 : : !!
3983 : : !! FUNCTION
3984 : : !! Compute tables for the distribution and the storage of the wavefunctions in the SIGMA code.
3985 : : !!
3986 : : !! INPUTS
3987 : : !! Dtset<type(dataset_type)>=all input variables for this dataset
3988 : : !! Sigp<sigparams_t>=Parameters governing the self-energy calculation.
3989 : : !! Kmesh <kmesh_t>=Structure describing the k-point sampling.
3990 : : !! nprocs=Total number of MPI processors
3991 : : !! my_rank=Rank of this this processor.
3992 : : !!
3993 : : !! OUTPUT
3994 : : !! my_spins(:)=Pointer to NULL in input. In output: list of spins treated by this node.
3995 : : !! bks_mask(Sigp%nbnds,Kmesh%nibz,Sigp%nsppol)=True if this node will treat this state.
3996 : : !! keep_ur(Sigp%nbnds,Kmesh%nibz,Sigp%nsppol)=True if this node will store this state in real space.
3997 : : !! ierr=Exit status.
3998 : : !!
3999 : : !! SOURCE
4000 : :
4001 : 206 : subroutine sigma_bksmask(Dtset,Sigp,Kmesh,my_rank,nprocs,my_spins,bks_mask,keep_ur,ierr)
4002 : :
4003 : : !Arguments ------------------------------------
4004 : : !scalars
4005 : : integer,intent(in) :: my_rank,nprocs
4006 : : integer,intent(out) :: ierr
4007 : : type(Dataset_type),intent(in) :: Dtset
4008 : : type(sigparams_t),intent(in) :: Sigp
4009 : : type(kmesh_t),intent(in) :: Kmesh
4010 : : !arrays
4011 : : integer,allocatable,intent(out) :: my_spins(:)
4012 : : logical,intent(out) :: bks_mask(Sigp%nbnds,Kmesh%nibz,Sigp%nsppol)
4013 : : logical,intent(out) :: keep_ur(Sigp%nbnds,Kmesh%nibz,Sigp%nsppol)
4014 : :
4015 : : !Local variables-------------------------------
4016 : : !scalars
4017 : : integer :: my_nspins,my_maxb,my_minb,isp,spin,band,nsppol,rank_spin
4018 : : logical :: store_ur
4019 : : !arrays
4020 : 412 : integer :: tmp_spins(Sigp%nsppol),nprocs_spin(Sigp%nsppol)
4021 : : ! *************************************************************************
4022 : :
4023 : 206 : ierr=0; nsppol=Sigp%nsppol
4024 : :
4025 : : ! List of spins for each node, number of processors per each spin
4026 : : ! and the MPI rank in the "spin" communicator.
4027 : 206 : my_nspins=nsppol
4028 [ - + + - : 618 : ABI_MALLOC(my_spins, (nsppol))
+ - + - -
+ - + -
+ ]
4029 [ - + + + : 1042 : my_spins= [(isp, isp=1,nsppol)]
+ - + + +
- - + - -
+ + ]
4030 [ + + ]: 416 : nprocs_spin = nprocs; rank_spin = my_rank
4031 : :
4032 [ + + - + ]: 206 : if (nsppol==2 .and. nprocs>1) then
4033 : : ! Distribute spins (optimal distribution if nprocs is even)
4034 : 0 : nprocs_spin(1) = nprocs/2
4035 : 0 : nprocs_spin(2) = nprocs - nprocs/2
4036 : 0 : my_nspins=1
4037 : 0 : my_spins(1)=1
4038 [ # # ]: 0 : if (my_rank+1>nprocs/2) then
4039 : : ! I will treat spin=2, compute shifted rank.
4040 : 0 : my_spins(1)=2
4041 : 0 : rank_spin = my_rank - nprocs/2
4042 : : end if
4043 : : end if
4044 : :
4045 : 206 : store_ur = (MODULO(Dtset%gwmem,10)==1)
4046 [ + + + + : 61808 : keep_ur=.FALSE.; bks_mask=.FALSE.
+ + + + +
+ + + ]
4047 : :
4048 : 248 : select case (Dtset%gwpara)
4049 : : case (1)
4050 : : ! Parallelization over transitions **without** memory distributions (Except for the spin).
4051 : 42 : my_minb=1; my_maxb=Sigp%nbnds
4052 [ - + ]: 42 : if (dtset%ucrpa>0) then
4053 [ # # # # : 0 : bks_mask(my_minb:my_maxb,:,:)=.TRUE.
# # ]
4054 [ # # # # : 0 : if (store_ur) keep_ur(my_minb:my_maxb,:,:)=.TRUE.
# # # # ]
4055 : : else
4056 [ + + ]: 84 : do isp=1,my_nspins
4057 : 42 : spin = my_spins(isp)
4058 [ + + + + ]: 4934 : bks_mask(my_minb:my_maxb,:,spin)=.TRUE.
4059 [ + - + + : 4976 : if (store_ur) keep_ur(my_minb:my_maxb,:,spin)=.TRUE.
+ + ]
4060 : : end do
4061 : : end if
4062 : :
4063 : : case (2)
4064 : : ! Distribute bands and spin (alternating planes of bands)
4065 [ + + ]: 332 : do isp=1,my_nspins
4066 : 168 : spin = my_spins(isp)
4067 [ + + ]: 5471 : do band=1,Sigp%nbnds
4068 [ + + ]: 5307 : if (xmpi_distrib_with_replicas(band,Sigp%nbnds,rank_spin,nprocs_spin(spin))) then
4069 : : !if (MODULO(band-1,nprocs_spin(spin))==rank_spin) then
4070 [ + + ]: 26579 : bks_mask(band,:,spin)=.TRUE.
4071 [ + + + + ]: 26127 : if (store_ur) keep_ur(band,:,spin)=.TRUE.
4072 : : end if
4073 : : end do
4074 : : end do
4075 : :
4076 : : #if 0
4077 : : ! Each node store the full set of occupied states to speed up Sigma_x.
4078 : : do isp=1,my_nspins
4079 : : spin = my_spins(isp)
4080 : : do ik_ibz=1,Kmesh%nibz
4081 : : ks_iv=ks_vbik(ik_ibz,spin) ! Valence index for this (k,s)
4082 : : bks_mask(1:ks_iv,:,spin)=.TRUE.
4083 : : if (store_ur) keep_ur(1:ks_iv,:,spin)=.TRUE.
4084 : : end do
4085 : : end do
4086 : : #endif
4087 : :
4088 : : case default
4089 : 0 : ABI_WARNING("Wrong value for gwpara")
4090 [ + + - ]: 206 : ierr = 1
4091 : : end select
4092 : :
4093 : : ! Return my_spins with correct size.
4094 [ + + ]: 416 : tmp_spins(1:my_nspins) = my_spins(1:my_nspins)
4095 : :
4096 [ - + ]: 206 : ABI_FREE(my_spins)
4097 [ - + + - : 618 : ABI_MALLOC(my_spins, (my_nspins))
+ - + - -
+ - + ]
4098 [ - + + + ]: 622 : my_spins = tmp_spins(1:my_nspins)
4099 : :
4100 : 206 : end subroutine sigma_bksmask
4101 : : !!***
4102 : :
4103 : : !!****f* ABINIT/paw_qpscgw
4104 : : !! NAME
4105 : : !! paw_qpscgw
4106 : : !!
4107 : : !! FUNCTION
4108 : : !! This routine is called during QP self-consistent GW calculations. It calculates the new QP on-site quantities
4109 : : !! using the QP amplitudes read from the QPS file.
4110 : : !!
4111 : : !! INPUTS
4112 : : !! Wfd<wfdgw_t>=Datatype gathering data on QP amplitudes.
4113 : : !! nscf=Number of QPSCGW iterations done so far (read from the QPS file).
4114 : : !! nfftf=Number of points in the fine FFT grid.
4115 : : !! ngfft(18)=information on the fine FFT grid used for densities and potentials.
4116 : : !! Dtset<dataset_type>=All input variables for this dataset.
4117 : : !! Cryst<crystal_t>=Info on unit cell and symmetries.
4118 : : !! Kmesh<kmesh_t>=Structure describing the k-point sampling.
4119 : : !! Psps<Pseudopotential_type)>=Info on pseudopotential, only for consistency check of the KSS file
4120 : : !! Pawang<pawang_type>=PAW angular mesh and related data.
4121 : : !! Pawrad(ntypat*usepaw)<type(pawrad_type)>=paw radial mesh and related data
4122 : : !! Pawtab(ntypat*usepaw)<type(pawtab_type)>=paw tabulated starting data
4123 : : !! Pawfgrtab(natom)<Pawfgrtab_type>= For PAW, various arrays giving data related to fine grid for a given atom.
4124 : : !! prev_Pawrhoij(Cryst%natom))<Pawrhoij_type>=Previous QP rhoij used for mixing if nscf>0 and rhoqpmix/=one.
4125 : : !! MPI_enreg=Information about MPI parallelization.
4126 : : !! qp_ebands<ebands_t>=QP band structure.
4127 : : !! QP_energies<Energies_type>=Simple datastructure to gather all part of total energy.
4128 : : !! nhatgrdim= 0 if pawgrnhat array is not used ; 1 otherwise
4129 : : !!
4130 : : !! OUTPUT
4131 : : !! QP_pawrhoij(Cryst%natom))<Pawrhoij_type>=on-site densities calculated from the QP amplitudes.
4132 : : !! qp_nhat(nfftf,Dtset%nspden)=Compensation charge density calculated from the QP amplitudes.
4133 : : !! qp_nhatgr(nfftf,Dtset%nspden,3*nhatgrdim)=Derivatives of the QP nhat on fine rectangular grid (and derivatives).
4134 : : !! qp_compch_sph=QP compensation charge integral inside spheres computed over spherical meshes.
4135 : : !! qp_compch_fft=QP compensation charge inside spheres computed over fine fft grid.
4136 : : !! QP_paw_ij(Cryst%natom)<Paw_ij_type>=Non-local D_ij strengths of the QP Hamiltonian.
4137 : : !! QP_paw_an(Cryst%natom)<Paw_an_type>=Various arrays related to the Hamiltonian given
4138 : : !! on ANgular mesh or ANgular moments.
4139 : : !!
4140 : : !! SOURCE
4141 : :
4142 [ # # # # : 0 : subroutine paw_qpscgw(Wfd,nscf,nfftf,ngfftf,Dtset,Cryst,Kmesh,Psps,qp_ebands, &
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
4143 : 0 : Pawang,Pawrad,Pawtab,Pawfgrtab,prev_Pawrhoij, &
4144 : 0 : QP_pawrhoij,QP_paw_ij,QP_paw_an,QP_energies,qp_nhat,nhatgrdim, &
4145 : 0 : qp_nhatgr,qp_compch_sph,qp_compch_fft)
4146 : :
4147 : : !Arguments ------------------------------------
4148 : : !scalars
4149 : : integer,intent(in) :: nfftf,nscf,nhatgrdim
4150 : : real(dp),intent(out) :: qp_compch_fft,qp_compch_sph
4151 : : type(kmesh_t),intent(in) :: Kmesh
4152 : : type(crystal_t),intent(in) :: Cryst
4153 : : type(Dataset_type),intent(in) :: Dtset
4154 : : type(Pseudopotential_type),intent(in) :: Psps
4155 : : type(Pawang_type),intent(in) :: Pawang
4156 : : type(ebands_t),intent(in) :: qp_ebands
4157 : : type(Energies_type),intent(inout) :: QP_energies
4158 : : type(wfdgw_t),intent(inout) :: Wfd
4159 : : !arrays
4160 : : integer,intent(in) :: ngfftf(18)
4161 : : real(dp),intent(out) :: qp_nhat(nfftf,Dtset%nspden)
4162 : : real(dp),intent(out) :: qp_nhatgr(nfftf,Dtset%nspden,3*nhatgrdim)
4163 : : type(Pawfgrtab_type),intent(inout) :: Pawfgrtab(Cryst%natom)
4164 : : type(Pawrad_type),intent(in) :: Pawrad(Psps%ntypat*Psps%usepaw)
4165 : : type(Pawtab_type),intent(in) :: Pawtab(Psps%ntypat*Psps%usepaw)
4166 : : type(Pawrhoij_type),intent(inout) :: prev_Pawrhoij(Cryst%natom)
4167 : : type(Pawrhoij_type),intent(out) :: QP_pawrhoij(Cryst%natom)
4168 : : type(Paw_ij_type),intent(out) :: QP_paw_ij(Cryst%natom)
4169 : : type(Paw_an_type),intent(inout) :: QP_paw_an(Cryst%natom)
4170 : :
4171 : : !Local variables ------------------------------
4172 : : !scalars
4173 : : integer,parameter :: ipert0 = 0, idir0 = 0, optrhoij1 = 1
4174 : : integer :: choice,cplex,cplex_rhoij,has_dijU,has_dijso,iat,ider
4175 : : integer :: izero,nkxc1,nspden_rhoij,nzlmopt, option,usexcnhat
4176 : : character(len=500) :: msg
4177 : : real(dp) :: el_temp
4178 : : !arrays
4179 : : real(dp) :: k0(3)
4180 : : !************************************************************************
4181 : :
4182 : : ABI_UNUSED(Kmesh%nibz)
4183 : : !
4184 : : ! * 0 if Vloc in atomic data is Vbare (Blochl s formulation)
4185 : : ! * 1 if Vloc in atomic data is VH(tnzc) (Kresse s formulation)
4186 : : usexcnhat=MAXVAL(Pawtab(:)%usexcnhat)
4187 : : !
4188 : : ! Calculate new rhoij_qp from updated Cprj_ibz, note use_rhoij_=1.
4189 : : call pawrhoij_inquire_dim(cplex_rhoij=cplex_rhoij,nspden_rhoij=nspden_rhoij,&
4190 : 0 : nspden=Dtset%nspden,spnorb=Dtset%pawspnorb,cpxocc=Dtset%pawcpxocc)
4191 : : call pawrhoij_alloc(QP_pawrhoij,cplex_rhoij,nspden_rhoij,Dtset%nspinor,Dtset%nsppol,Cryst%typat,&
4192 : 0 : pawtab=Pawtab,use_rhoij_=1,use_rhoijres=1)
4193 : :
4194 : : ! FIXME kptop should be passed via Kmesh, in GW time reversal is always assumed.
4195 : 0 : call wfd%pawrhoij(Cryst,qp_ebands,Dtset%kptopt,QP_pawrhoij,Dtset%pawprtvol)
4196 : : !
4197 : : ! Symmetrize QP $\rho_{ij}$.
4198 : 0 : choice=1
4199 : : call pawrhoij_symrhoij(QP_pawrhoij,QP_pawrhoij,choice,Cryst%gprimd,Cryst%indsym,ipert0,&
4200 : : Cryst%natom,Cryst%nsym,Cryst%ntypat,optrhoij1,Pawang,Dtset%pawprtvol,&
4201 : 0 : Pawtab,Cryst%rprimd,Cryst%symafm,Cryst%symrec,Cryst%typat)
4202 : :
4203 : : ! ======================
4204 : : ! ==== Make QP nhat ====
4205 : : ! ======================
4206 : 0 : cplex=1; ider=2*nhatgrdim; izero=0; k0(:)=zero
4207 : :
4208 : : call pawmknhat(qp_compch_fft,cplex,ider,idir0,ipert0,izero,Cryst%gprimd,&
4209 : : Cryst%natom,Cryst%natom,nfftf,ngfftf,nhatgrdim,Dtset%nspden,Cryst%ntypat,Pawang,&
4210 : : Pawfgrtab,qp_nhatgr,qp_nhat,QP_Pawrhoij,QP_Pawrhoij,Pawtab,k0,Cryst%rprimd,&
4211 : 0 : Cryst%ucvol,Dtset%usewvl,Cryst%xred)
4212 : :
4213 : : ! Allocate quantities related to the PAW spheres for the QP Hamiltonian.
4214 : : ! TODO call paw_ij_init in scfcv and respfn, fix small issues
4215 [ # # ]: 0 : has_dijso=Dtset%pawspnorb; has_dijU=merge(0,1,Dtset%usepawu==0)
4216 : :
4217 : 0 : call paw_ij_nullify(QP_paw_ij)
4218 : : call paw_ij_init(QP_paw_ij,cplex,Dtset%nspinor,Dtset%nsppol,&
4219 : : Dtset%nspden,Dtset%pawspnorb,Cryst%natom,Cryst%ntypat,Cryst%typat,Pawtab,&
4220 : : has_dij=1,has_dijhartree=1,has_dijhat=1,has_dijxc=1,has_dijxc_hat=1,has_dijxc_val=1,&
4221 : 0 : has_dijso=has_dijso,has_dijU=has_dijU,has_exexch_pot=1,has_pawu_occ=1)
4222 : :
4223 : 0 : call paw_an_nullify(QP_paw_an); nkxc1=0 ! No kernel
4224 : : call paw_an_init(QP_paw_an,Cryst%natom,Cryst%ntypat,nkxc1,0,Dtset%nspden,&
4225 : 0 : cplex,Dtset%pawxcdev,Cryst%typat,Pawang,Pawtab,has_vxc=1,has_vxcval=1)
4226 : :
4227 : : ! =====================================================
4228 : : ! ==== Optional mixing of the PAW onsite densities ====
4229 : : ! =====================================================
4230 [ # # # # ]: 0 : if (nscf>0 .and. (ABS(Dtset%rhoqpmix-one)>tol12) ) then
4231 : 0 : write(msg,'(a,f6.3)')' sigma: mixing on-site QP rho_ij densities using rhoqpmix= ',Dtset%rhoqpmix
4232 : 0 : call wrtout(std_out, msg)
4233 : : ! qp_rhor = prev_rhor + Dtset%rhoqpmix*(qp_rhor-prev_rhor)
4234 : :
4235 : 0 : call pawrhoij_unpack(QP_Pawrhoij) ! Unpack new QP %rhoijp
4236 : 0 : call pawrhoij_unpack(prev_Pawrhoij) ! Unpack previous QP %rhoijp
4237 : :
4238 [ # # ]: 0 : do iat=1,Cryst%natom
4239 : : QP_pawrhoij(iat)%rhoij_ = prev_Pawrhoij(iat)%rhoij_ &
4240 [ # # # # : 0 : + Dtset%rhoqpmix * (QP_pawrhoij(iat)%rhoij_ - prev_pawrhoij(iat)%rhoij_)
# # # # #
# # # ]
4241 : :
4242 : 0 : prev_pawrhoij(iat)%use_rhoij_=0
4243 [ # # ]: 0 : ABI_FREE(prev_pawrhoij(iat)%rhoij_)
4244 : : end do
4245 : :
4246 : : ! Re-Symmetrize mixed QP $\rho_{ij}$.
4247 : : choice=1
4248 : : call pawrhoij_symrhoij(QP_pawrhoij,QP_pawrhoij,choice,Cryst%gprimd,Cryst%indsym,ipert0,&
4249 : : Cryst%natom,Cryst%nsym,Cryst%ntypat,optrhoij1,Pawang,Dtset%pawprtvol,&
4250 : 0 : Pawtab,Cryst%rprimd,Cryst%symafm,Cryst%symrec,Cryst%typat)
4251 : : end if
4252 : :
4253 [ # # ]: 0 : do iat=1,Cryst%natom
4254 : 0 : QP_pawrhoij(iat)%use_rhoij_=0
4255 [ # # ]: 0 : ABI_FREE(QP_pawrhoij(iat)%rhoij_)
4256 : : end do
4257 : : !
4258 : : ! =================================================================================
4259 : : ! ==== Evaluate on-site energies, potentials, densities using (mixed) QP rhoij ====
4260 : : ! =================================================================================
4261 : : ! * Initialize also "lmselect" (index of non-zero LM-moments of densities).
4262 : :
4263 : 0 : nzlmopt=-1; option=0; qp_compch_sph=greatest_real
4264 : :
4265 : : ! Get electronic temperature from dtset
4266 [ # # # # : 0 : el_temp=merge(dtset%tphysel,dtset%tsmear,dtset%tphysel>tol8.and.dtset%occopt/=3.and.dtset%occopt/=9)
# # ]
4267 : :
4268 : : call pawdenpot(qp_compch_sph,el_temp,Cryst%gprimd,ipert0,Dtset%ixc,Cryst%natom,Cryst%natom,Dtset%nspden,&
4269 : : Cryst%ntypat,Dtset%nucdipmom,nzlmopt,option,QP_paw_an,QP_paw_an,QP_energies%paw,&
4270 : : QP_paw_ij,Pawang,Dtset%pawprtvol,Pawrad,QP_pawrhoij,Dtset%pawspnorb,Pawtab,Dtset%pawxcdev,&
4271 : 0 : Dtset%spnorbscl,Dtset%xclevel,Dtset%xc_denpos,Dtset%xc_taupos,Cryst%xred,Cryst%ucvol,Psps%znuclpsp,Dtset%spinaxis)
4272 : :
4273 : 0 : end subroutine paw_qpscgw
4274 : : !!***
4275 : :
4276 : : !!****f* ABINIT/setup_vcp
4277 : : !! NAME
4278 : : !! setup_vcp
4279 : : !!
4280 : : !! FUNCTION
4281 : : !! Initialize the Vcp and compute the corresponding residue.
4282 : : !!
4283 : : !! INPUTS
4284 : : !! Dtset<type(dataset_type)>=all input variables for this dataset
4285 : : !! Gsph_c<gsphere_t>=Info on the G-sphere for W and Sigma_c
4286 : : !! Gsph_x<gsphere_t>=Info on the G-sphere for and Sigma_x
4287 : : !! Kmesh <kmesh_t>=Structure describing the k-point sampling.
4288 : : !! Qmesh <kmesh_t>=Structure describing the q-point sampling.
4289 : : !! Cryst<crystal_t>=Info on unit cell and symmetries.
4290 : : !! comm=Information about the xmpi_world
4291 : : !!
4292 : : !! OUTPUT
4293 : : !! Vcp_full<vcoul_t>= Datatype gathering information on the coulombian interaction and the cutoff technique.
4294 : : !! Vcp_ks<vcoul_t>= Datatype gathering information on the coulombian interaction and the cutoff technique.
4295 : : !! coef_hyb=real variable containing the amount of GLOBAL hybridization
4296 : :
4297 : 4 : subroutine setup_vcp(Vcp_ks,Vcp_full,Dtset,Gsph_x,Gsph_c,Cryst,Qmesh,Kmesh,coef_hyb,comm)
4298 : :
4299 : : !Arguments ------------------------------------
4300 : : !scalars
4301 : : type(Dataset_type),intent(in) :: Dtset
4302 : : type(gsphere_t),intent(in) :: Gsph_x,Gsph_c
4303 : : type(crystal_t),intent(in) :: Cryst
4304 : : type(kmesh_t),intent(in) :: Kmesh, Qmesh
4305 : : type(vcoul_t),intent(inout) :: Vcp_ks, Vcp_full
4306 : : integer,intent(in) :: comm
4307 : : real(dp),intent(inout) :: coef_hyb
4308 : :
4309 : : !Local variables-------------------------------
4310 : : !scalars
4311 : : integer :: usefock_ixc,nqlwl,xclevel_ixc,icsing_eff
4312 : : real(dp) :: rcut
4313 : : !arrays
4314 : 4 : real(dp),allocatable :: qlwl(:,:)
4315 : : !************************************************************************
4316 : :
4317 : : ! Build Vcp_ks and Vcp_full
4318 [ + - ]: 4 : if (Dtset%gw_nqlwl==0) then
4319 : 4 : nqlwl=1
4320 [ - + ]: 4 : ABI_MALLOC(qlwl,(3,nqlwl))
4321 [ + + ]: 16 : qlwl(:,1)= GW_Q0_DEFAULT
4322 : : else
4323 : 0 : nqlwl=Dtset%gw_nqlwl
4324 [ # # # # : 0 : ABI_MALLOC(qlwl,(3,nqlwl))
# # # # #
# # # ]
4325 [ # # # # ]: 0 : qlwl(:,:)=Dtset%gw_qlwl(:,1:nqlwl)
4326 : : end if
4327 : 4 : rcut=Dtset%gw_rcut
4328 : 4 : icsing_eff=Dtset%gw_icutcoul
4329 : : ! 1st part: Use a Vcp_full to compute the full Coulomb interaction for NOs
4330 [ + - ]: 4 : if (Gsph_x%ng > Gsph_c%ng) then
4331 : : call Vcp_full%init(Gsph_x,Cryst,Qmesh,Kmesh,rcut,icsing_eff,Dtset%vcutgeo,&
4332 : 4 : Gsph_x%ng,nqlwl,qlwl,comm)
4333 : : else
4334 : : call Vcp_full%init(Gsph_c,Cryst,Qmesh,Kmesh,rcut,icsing_eff,Dtset%vcutgeo,&
4335 : 0 : Gsph_c%ng,nqlwl,qlwl,comm)
4336 : : end if
4337 : : ! 2nd part: Use a Vcp_ks to compute the Coulomb interaction already present in the Fock part of the Kohn-Sham Hamiltonian
4338 : 4 : coef_hyb=zero
4339 : 4 : call get_xclevel(Dtset%ixc,xclevel_ixc,usefock_ixc) ! usefock is 0 for 0.0 Fock contrib in KS-GS calc
4340 [ - + ]: 4 : if (usefock_ixc==1)then
4341 [ # # ]: 0 : if (abs(Dtset%hyb_mixing)>tol8) then
4342 : 0 : coef_hyb=abs(Dtset%hyb_mixing)
4343 : : if(abs(coef_hyb+999.0d0)<tol8) then ! HF
4344 : : coef_hyb=1.0d0
4345 : : end if
4346 [ # # ]: 0 : else if(abs(Dtset%hyb_mixing_sr)>tol8)then
4347 : 0 : coef_hyb=abs(Dtset%hyb_mixing_sr)
4348 : 0 : icsing_eff=5
4349 : : end if
4350 [ # # # # ]: 0 : if (abs(rcut)<tol6 .and. abs(Dtset%hyb_range_fock)>tol8) then
4351 : 0 : rcut=one/Dtset%hyb_range_fock
4352 : : end if
4353 : : end if
4354 [ + - ]: 4 : if (Gsph_x%ng > Gsph_c%ng) then
4355 : : call Vcp_ks%init(Gsph_x,Cryst,Qmesh,Kmesh,rcut,icsing_eff,Dtset%vcutgeo,&
4356 : 4 : Gsph_x%ng,nqlwl,qlwl,comm)
4357 : : else
4358 : : call Vcp_ks%init(Gsph_c,Cryst,Qmesh,Kmesh,rcut,icsing_eff,Dtset%vcutgeo,&
4359 : 0 : Gsph_c%ng,nqlwl,qlwl,comm)
4360 : : end if
4361 [ - + ]: 4 : ABI_FREE(qlwl)
4362 : : ! Now compute the "residual" Coulomb interactions
4363 : 4 : ABI_COMMENT("From now on, Vcp_ks%vc_sqrt_resid contains the amount of exact exchange present on the GS.")
4364 [ + - + - : 2216 : Vcp_ks%vc_sqrt_resid=sqrt(coef_hyb*Vcp_ks%vc_sqrt**2)
- + - - +
+ + + ]
4365 : 4 : Vcp_ks%i_sz_resid=coef_hyb*Vcp_ks%i_sz
4366 : :
4367 : 4 : end subroutine setup_vcp
4368 : : !!***
4369 : :
4370 : 0 : end module m_sigma_driver
4371 : : !!***
|
