Line data Source code
1 : !!****m* ABINIT/m_wvl_wfs
2 : !! NAME
3 : !! m_wvl_wfs
4 : !!
5 : !! FUNCTION
6 : !!
7 : !! COPYRIGHT
8 : !! Copyright (C) 1998-2026 ABINIT group (DC)
9 : !! This file is distributed under the terms of the
10 : !! GNU General Public License, see ~abinit/COPYING
11 : !! or http://www.gnu.org/copyleft/gpl.txt .
12 : !!
13 : !! SOURCE
14 :
15 : #if defined HAVE_CONFIG_H
16 : #include "config.h"
17 : #endif
18 :
19 : #include "abi_common.h"
20 :
21 : module m_wvl_wfs
22 :
23 : use defs_basis
24 : use m_errors
25 : use m_abicore
26 :
27 : use defs_datatypes, only : pseudopotential_type
28 :
29 : implicit none
30 :
31 : private
32 : !!***
33 :
34 : public :: wvl_wfs_set
35 : public :: derf_ab
36 : public :: wvl_wfs_free
37 : public :: wvl_wfs_lr_copy
38 : !!***
39 :
40 : contains
41 : !!***
42 :
43 : !!****f* ABINIT/wvl_wfs_set
44 : !! NAME
45 : !! wvl_wfs_set
46 : !!
47 : !! FUNCTION
48 : !! Compute the access keys for the wavefunctions when the positions
49 : !! of the atoms are given.
50 : !!
51 : !! For memory occupation optimisation reasons, the wavefunctions are not allocated
52 : !! here. See the initialisation routines wvl_wfsinp_disk(), wvl_wfsinp_scratch()
53 : !! and wvl_wfsinp_reformat() to do it. After allocation, use wvl_wfs_free()
54 : !! to deallocate all stuff (descriptors and arrays).
55 : !!
56 : !! INPUTS
57 : !! dtset <type(dataset_type)>=internal variables used by wavelets, describing
58 : !! | wvl_internal=desciption of the wavelet box.
59 : !! | natom=number of atoms.
60 : !! mpi_enreg=information about MPI parallelization
61 : !! psps <type(pseudopotential_type)>=variables related to pseudopotentials
62 : !! rprimd(3,3)=dimensional primitive translations in real space (bohr)
63 : !! xred(3,natom)=reduced dimensionless atomic coordinates
64 : !!
65 : !! OUTPUT
66 : !! wfs <type(wvl_projector_type)>=wavefunctions information for wavelets.
67 : !! | keys=its access keys for compact storage.
68 : !!
69 : !! SOURCE
70 :
71 0 : subroutine wvl_wfs_set(alphadiis, spinmagntarget, kpt, me, natom, nband, nkpt, nproc, nspinor, &
72 0 : & nsppol, nwfshist, occ, psps, rprimd, wfs, wtk, wvl, wvl_crmult, wvl_frmult, xred)
73 :
74 : use defs_wvltypes
75 :
76 : use m_geometry, only : xred2xcart
77 : #if defined HAVE_BIGDFT
78 : use BigDFT_API, only: createWavefunctionsDescriptors, orbitals_descriptors, &
79 : & orbitals_communicators, allocate_diis_objects, &
80 : & input_variables, check_linear_and_create_Lzd, check_communications, &
81 : & INPUT_IG_OFF, nullify_locreg_descriptors
82 : #endif
83 :
84 : !Arguments ------------------------------------
85 : !scalars
86 : integer, intent(in) :: natom, nkpt, nsppol, nspinor, nband, nwfshist,me,nproc
87 : real(dp), intent(in) :: spinmagntarget, wvl_crmult, wvl_frmult, alphadiis
88 : type(pseudopotential_type),intent(in) :: psps
89 : type(wvl_wf_type),intent(out) :: wfs
90 : type(wvl_internal_type), intent(in) :: wvl
91 : !arrays
92 : real(dp), intent(in) :: kpt(3,nkpt)
93 : real(dp), intent(in) :: wtk(nkpt), occ(:)
94 : real(dp),intent(in) :: rprimd(3,3),xred(3,natom)
95 :
96 : !Local variables-------------------------------
97 : #if defined HAVE_BIGDFT
98 : !scalars
99 : integer :: ii,idata, norb, norbu, norbd
100 : logical :: parallel
101 : character(len=500) :: message
102 : type(input_variables) :: in ! To be removed, waiting for BigDFT upgrade
103 : !arrays
104 : real(dp), allocatable :: kpt_(:,:)
105 : real(dp),allocatable :: xcart(:,:)
106 : #endif
107 :
108 : ! *********************************************************************
109 :
110 : #if defined HAVE_BIGDFT
111 :
112 : parallel = (nproc > 1)
113 :
114 : !Consistency checks, are all pseudo true GTH pseudo with geometric information?
115 : !Skip for PAW case: we do not have GTH parameters
116 : do idata = 1, psps%npsp, 1
117 : if (.not. psps%gth_params%set(idata) .and. psps%usepaw==0) then
118 : write(message, '(a,a,a,a,I0,a,a,a)' ) ch10,&
119 : & ' wvl_wfs_set: consistency checks failed,', ch10, &
120 : & ' no GTH parameters found for type number ', idata, '.', ch10, &
121 : & ' Check your input pseudo files.'
122 : ABI_ERROR(message)
123 : end if
124 : if (.not. psps%gth_params%hasGeometry(idata)) then
125 : write(message, '(a,a,a,a,a,a)' ) ch10,&
126 : & ' wvl_wfs_set: consistency checks failed,', ch10, &
127 : & ' the given GTH parameters has no geometry information.', ch10, &
128 : & ' Upgrade your input pseudo files to GTH with geometric information.'
129 : ABI_ERROR(message)
130 : end if
131 : end do
132 :
133 : !Store xcart for each atom
134 : ABI_MALLOC(xcart,(3, natom))
135 : call xred2xcart(natom, rprimd, xcart, xred)
136 :
137 : !Nullify possibly unset pointers
138 : nullify(wfs%ks%psi)
139 : nullify(wfs%ks%hpsi)
140 : nullify(wfs%ks%psit)
141 :
142 : !Static allocations.
143 : norb = nband / nkpt
144 : norbu = 0
145 : norbd = 0
146 : if (nsppol == 2) then
147 : if (spinmagntarget < -real(90, dp)) then
148 : norbu = min(norb / 2, norb)
149 : else
150 : norbu = min(norb / 2 + int(spinmagntarget), norb)
151 : end if
152 : norbd = norb - norbu
153 : else
154 : norbu = norb
155 : norbd = 0
156 : end if
157 : ABI_MALLOC(kpt_, (3, nkpt))
158 : do ii = 1, nkpt
159 : kpt_(:,ii) = kpt(:,ii) / (/ rprimd(1,1), rprimd(2,2), rprimd(3,3) /) * two_pi
160 : end do
161 :
162 : call orbitals_descriptors(me, nproc,norb,norbu,norbd,nsppol,nspinor, &
163 : & nkpt,kpt_,wtk,wfs%ks%orbs,.false.)
164 : ABI_FREE(kpt_)
165 : !We copy occ_orig to wfs%ks%orbs%occup
166 : wfs%ks%orbs%occup(1:norb * nkpt) = occ(1:norb * nkpt)
167 : !We allocate the eigen values storage.
168 : ABI_MALLOC(wfs%ks%orbs%eval,(wfs%ks%orbs%norb * wfs%ks%orbs%nkpts))
169 :
170 : write(message, '(a,a)' ) ch10,&
171 : & ' wvl_wfs_set: Create access keys for wavefunctions.'
172 : call wrtout(std_out,message,'COLL')
173 :
174 : call nullify_locreg_descriptors(wfs%ks%lzd%Glr)
175 : wfs%ks%lzd%Glr = wvl%Glr
176 : call createWavefunctionsDescriptors(me, wvl%h(1), wvl%h(2), wvl%h(3), &
177 : & wvl%atoms, xcart, psps%gth_params%radii_cf, &
178 : & wvl_crmult, wvl_frmult, wfs%ks%lzd%Glr)
179 : !The memory is not allocated there for memory occupation optimisation reasons.
180 :
181 : call orbitals_communicators(me,nproc,wfs%ks%lzd%Glr,wfs%ks%orbs,wfs%ks%comms)
182 :
183 : write(message, '(a,2I8)' ) &
184 : & ' | all orbitals have coarse segments, elements:', &
185 : & wfs%ks%lzd%Glr%wfd%nseg_c, wfs%ks%lzd%Glr%wfd%nvctr_c
186 : call wrtout(std_out,message,'COLL')
187 : write(message, '(a,2I8)' ) &
188 : & ' | all orbitals have fine segments, elements:', &
189 : & wfs%ks%lzd%Glr%wfd%nseg_f, 7 * wfs%ks%lzd%Glr%wfd%nvctr_f
190 : call wrtout(std_out,message,'COLL')
191 :
192 : !allocate arrays necessary for DIIS convergence acceleration
193 : call allocate_diis_objects(nwfshist,alphadiis,&
194 : & sum(wfs%ks%comms%ncntt(0:nproc-1)), wfs%ks%orbs%nkptsp, wfs%ks%orbs%nspinor, &
195 : & wfs%ks%diis)
196 :
197 : ABI_MALLOC(wfs%ks%confdatarr, (wfs%ks%orbs%norbp))
198 : call default_confinement_data(wfs%ks%confdatarr,wfs%ks%orbs%norbp)
199 :
200 : call check_linear_and_create_Lzd(me,nproc,INPUT_IG_OFF,wfs%ks%lzd,&
201 : & wvl%atoms,wfs%ks%orbs,nsppol,xcart)
202 : wfs%ks%lzd%hgrids = wvl%h
203 :
204 : !check the communication distribution
205 : call check_communications(me,nproc,wfs%ks%orbs,wfs%ks%Lzd,wfs%ks%comms)
206 :
207 : !Deallocations
208 : ABI_FREE(xcart)
209 :
210 : !DEBUG
211 : write(std_out,*) 'wvl_wfs_set: TODO, update BigDFT sic_input_variables_default()'
212 : !ENDDEBUG
213 : call sic_input_variables_default(in)
214 :
215 : wfs%ks%SIC = in%SIC
216 : wfs%ks%exctxpar = "OP2P"
217 : wfs%ks%c_obj = 0
218 : wfs%ks%orthpar%directDiag = .true.
219 : wfs%ks%orthpar%norbpInguess = 5
220 : wfs%ks%orthpar%bsLow = 300
221 : wfs%ks%orthpar%bsUp = 800
222 : wfs%ks%orthpar%methOrtho = 0
223 : wfs%ks%orthpar%iguessTol = 1.d-4
224 :
225 : #else
226 0 : BIGDFT_NOTENABLED_ERROR()
227 : if (.false.) write(std_out,*) natom,nkpt,nsppol,nspinor,nband,nwfshist,me,nproc,&
228 : & spinmagntarget,wvl_crmult,wvl_frmult,alphadiis,psps%npsp,wfs%ks,wvl%h(1),&
229 : & kpt(1,1),wtk(1),occ(1),rprimd(1,1),xred(1,1)
230 : #endif
231 :
232 0 : end subroutine wvl_wfs_set
233 : !!***
234 :
235 : !!****f* ABINIT/derfcf
236 : !! NAME
237 : !! derfcf
238 : !!
239 : !! FUNCTION
240 : !! Some wrappers for BigDFT which uses different names for the same routines.
241 : !!
242 : !! INPUTS
243 : !!
244 : !! OUTPUT
245 : !!
246 : !! SIDE EFFECTS
247 : !!
248 : !! SOURCE
249 :
250 : subroutine derfcf(derfc_yy,yy)
251 :
252 : use m_special_funcs, only : abi_derfc
253 : !Arguments ------------------------------------
254 : !scalars
255 : real(dp),intent(in) :: yy
256 : real(dp),intent(out) :: derfc_yy
257 : !Local variables-------------------------------
258 :
259 : ! *********************************************************************
260 :
261 : derfc_yy = abi_derfc(yy)
262 :
263 : end subroutine derfcf
264 : !!***
265 :
266 : !!****f* ABINIT/derf_ab
267 : !! NAME
268 : !! derf_ab
269 : !!
270 : !! FUNCTION
271 : !! Some wrappers for BigDFT which uses different names for the same routines.
272 : !!
273 : !! INPUTS
274 : !!
275 : !! OUTPUT
276 : !!
277 : !! SIDE EFFECTS
278 : !!
279 : !! SOURCE
280 :
281 0 : subroutine derf_ab(derf_yy,yy)
282 :
283 : use m_special_funcs, only : abi_derf
284 :
285 : !Arguments ------------------------------------
286 : !scalars
287 : real(dp),intent(in) :: yy
288 : real(dp),intent(out) :: derf_yy
289 :
290 : !Local variables-------------------------------
291 :
292 : ! *********************************************************************
293 :
294 0 : derf_yy = abi_derf(yy)
295 :
296 0 : end subroutine derf_ab
297 : !!***
298 :
299 :
300 : !!****f* ABINIT/wvl_wfs_free
301 : !!
302 : !! NAME
303 : !! wvl_wfs_free
304 : !!
305 : !! FUNCTION
306 : !! Freeing routine.
307 : !!
308 : !! INPUTS
309 : !!
310 : !! OUTPUT
311 : !!
312 : !! SIDE EFFECTS
313 : !! wfs <type(wvl_wf_type)>=wavefunctions information in a wavelet basis.
314 : !!
315 : !! SOURCE
316 :
317 :
318 0 : subroutine wvl_wfs_free(wfs)
319 :
320 : use defs_wvltypes
321 : #if defined HAVE_BIGDFT
322 : use BigDFT_API, only: deallocate_Lzd_except_Glr, deallocate_lr, &
323 : & deallocate_orbs, deallocate_comms
324 : use dynamic_memory
325 : #endif
326 :
327 : !Arguments ------------------------------------
328 : !scalars
329 : type(wvl_wf_type),intent(inout) :: wfs
330 :
331 : !Local variables -------------------------
332 :
333 : ! *********************************************************************
334 :
335 : #if defined HAVE_BIGDFT
336 : call deallocate_Lzd_except_Glr(wfs%ks%lzd)
337 : call deallocate_lr(wfs%ks%lzd%Glr)
338 : call deallocate_orbs(wfs%ks%orbs)
339 : call deallocate_comms(wfs%ks%comms)
340 : if (associated(wfs%ks%orbs%eval)) then
341 : ABI_FREE(wfs%ks%orbs%eval)
342 : end if
343 : ABI_FREE(wfs%ks%confdatarr)
344 :
345 : if (associated(wfs%ks%psi)) then
346 : call f_free_ptr(wfs%ks%psi)
347 : end if
348 : if (associated(wfs%ks%hpsi)) then
349 : call f_free_ptr(wfs%ks%hpsi)
350 : end if
351 : if (associated(wfs%ks%psit)) then
352 : call f_free_ptr(wfs%ks%psit)
353 : end if
354 :
355 : #else
356 0 : BIGDFT_NOTENABLED_ERROR()
357 : if (.false.) write(std_out,*) wfs%ks
358 : #endif
359 :
360 0 : end subroutine wvl_wfs_free
361 : !!***
362 :
363 :
364 : !!****f* defs_wvltypes/wvl_wfs_lr_copy
365 : !!
366 : !! NAME
367 : !! wvl_wfs_lr_copy
368 : !!
369 : !! FUNCTION
370 : !! Copy the wvl%Glr datastructure geometry part to wfs%Glr.
371 : !!
372 : !! INPUTS
373 : !! wvl <type(wvl_internal_type)> = input localisation region
374 : !!
375 : !! OUTPUT
376 : !! wfs <type(wvl_wf_type)> = output localistaion region
377 : !!
378 : !! SOURCE
379 :
380 0 : subroutine wvl_wfs_lr_copy(wfs, wvl)
381 :
382 : use defs_wvltypes
383 :
384 : !Arguments ------------------------------------
385 : !scalars
386 : type(wvl_internal_type), intent(in) :: wvl
387 : type(wvl_wf_type), intent(inout) :: wfs
388 : !arrays
389 :
390 : !Local variables-------------------------------
391 :
392 : ! *********************************************************************
393 :
394 : #if defined HAVE_BIGDFT
395 : !Use global localization region for the moment.
396 : wfs%ks%lzd%Glr%geocode = wvl%Glr%geocode
397 : wfs%ks%lzd%Glr%hybrid_on = wvl%Glr%hybrid_on
398 : wfs%ks%lzd%Glr%ns1 = wvl%Glr%ns1
399 : wfs%ks%lzd%Glr%ns2 = wvl%Glr%ns2
400 : wfs%ks%lzd%Glr%ns3 = wvl%Glr%ns3
401 : wfs%ks%lzd%Glr%nsi1 = wvl%Glr%nsi1
402 : wfs%ks%lzd%Glr%nsi2 = wvl%Glr%nsi2
403 : wfs%ks%lzd%Glr%nsi3 = wvl%Glr%nsi3
404 : wfs%ks%lzd%Glr%d%n1 = wvl%Glr%d%n1
405 : wfs%ks%lzd%Glr%d%n2 = wvl%Glr%d%n2
406 : wfs%ks%lzd%Glr%d%n3 = wvl%Glr%d%n3
407 : wfs%ks%lzd%Glr%d%nfl1 = wvl%Glr%d%nfl1
408 : wfs%ks%lzd%Glr%d%nfu1 = wvl%Glr%d%nfu1
409 : wfs%ks%lzd%Glr%d%nfl2 = wvl%Glr%d%nfl2
410 : wfs%ks%lzd%Glr%d%nfu2 = wvl%Glr%d%nfu2
411 : wfs%ks%lzd%Glr%d%nfl3 = wvl%Glr%d%nfl3
412 : wfs%ks%lzd%Glr%d%nfu3 = wvl%Glr%d%nfu3
413 : wfs%ks%lzd%Glr%d%n1i = wvl%Glr%d%n1i
414 : wfs%ks%lzd%Glr%d%n2i = wvl%Glr%d%n2i
415 : wfs%ks%lzd%Glr%d%n3i = wvl%Glr%d%n3i
416 : wfs%ks%lzd%Glr%outofzone = wvl%Glr%outofzone
417 :
418 : #else
419 0 : BIGDFT_NOTENABLED_ERROR()
420 : if (.false.) write(std_out,*) wvl%h(1),wfs%ks
421 : #endif
422 :
423 0 : end subroutine wvl_wfs_lr_copy
424 : !!***
425 :
426 : end module m_wvl_wfs
427 : !!***
|
