Line data Source code
1 : !!****m* ABINIT/m_wvl_descr_psp
2 : !! NAME
3 : !! wvl_descr_psp
4 : !!
5 : !! FUNCTION
6 : !!
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2008-2026 ABINIT group (DC)
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_wvl_descr_psp
23 :
24 : use defs_basis
25 : use m_errors
26 : use m_abicore
27 :
28 : use defs_datatypes, only : pseudopotential_type, pseudopotential_gth_type
29 :
30 : implicit none
31 :
32 : private
33 : !!***
34 :
35 : public :: wvl_descr_psp_set
36 : public :: wvl_descr_psp_fill
37 : public :: wvl_descr_free
38 : public :: wvl_descr_atoms_set
39 : public :: wvl_descr_atoms_set_sym
40 : !!***
41 :
42 : contains
43 : !!***
44 :
45 : !!****f* defs_wvltypes/wvl_descr_psp_set
46 : !! NAME
47 : !! wvl_descr_psp_set
48 : !!
49 : !! FUNCTION
50 : !! Defines the part of the wvl%atoms%-datastructure which depends on psps
51 : !!
52 : !! INPUTS
53 : !! psps <type(pseudopotential_type)>=variables related to pseudopotentials
54 : !! dtset <type(dataset_type)>=all input variables for this dataset
55 : !!
56 : !! OUTPUT
57 : !! nsppol=number of spin components
58 : !! spinat(3,natom)=spin polarization on each atom
59 : !! wvl <type(wvl_internal_type)> = wavelet type
60 : !! | psppar = The covalence radii for each pseudo
61 : !! | pspcod = the format -or code- of psp generation
62 : !! | iasctype = semicore code (see defs_datatype)
63 : !! | nzatom = charge of the nucleus
64 : !! | nelpsp = the ionic pseudo-charge
65 : !! | natsc = number of atoms with semicore
66 : !!
67 : !! SOURCE
68 :
69 0 : subroutine wvl_descr_psp_set(filoccup, nsppol, psps, spinat, wvl)
70 :
71 : use defs_wvltypes
72 : #if defined HAVE_BIGDFT
73 : use BigDFT_API, only: aoig_set,UNINITIALIZED,dict_init,dict_free,dictionary, &
74 : & operator(//), bigdft_mpi, dict_set
75 : use BigDFT_API, only: psp_data_merge_to_dict, psp_dict_fill_all, atomic_info, &
76 : & psp_dict_analyse, atomic_data_set_from_dict, merge_input_file_to_dict
77 : #endif
78 :
79 : !Arguments ------------------------------------
80 : !scalars
81 : integer, intent(in) :: nsppol
82 : type(wvl_internal_type), intent(inout) :: wvl
83 : type(pseudopotential_type), intent(in) :: psps
84 : character(len = *), intent(in) :: filoccup
85 : !arrays
86 : real(dp),intent(in) :: spinat(:,:)
87 :
88 : !Local variables-------------------------------
89 : #if defined HAVE_BIGDFT
90 : integer :: ityp,pspcod
91 : logical :: exists
92 : real(dp) :: radii_cf(3)
93 : character(len=2) :: symbol
94 : character(len=27) :: filename
95 : type(dictionary), pointer :: dict
96 : #endif
97 :
98 : ! *********************************************************************
99 :
100 : #if defined HAVE_BIGDFT
101 :
102 : !We create the atoms_data structure, the part that is dependent from psp.
103 : do ityp=1,size(psps%pspcod)
104 : wvl%atoms%psppar(:,:,ityp)= psps%gth_params%psppar(:,:,ityp)
105 : wvl%atoms%npspcode(ityp) = merge(psps%pspcod(ityp),7,psps%pspcod(ityp)/=17)
106 : wvl%atoms%ixcpsp(ityp) = psps%pspxc(ityp)
107 : wvl%atoms%nzatom(ityp) = int(psps%znucltypat(ityp))
108 : wvl%atoms%nelpsp(ityp) = int(psps%ziontypat(ityp))
109 : end do
110 : wvl%atoms%donlcc = .false.
111 :
112 : call dict_init(dict)
113 : radii_cf = UNINITIALIZED(1._dp)
114 : do ityp = 1, wvl%atoms%astruct%ntypes, 1
115 : call atomic_info(wvl%atoms%nzatom(ityp), wvl%atoms%nelpsp(ityp), &
116 : & symbol = symbol)
117 : write(wvl%atoms%astruct%atomnames(ityp), "(A)") symbol
118 : filename = 'psppar.' // trim(symbol)
119 : pspcod=psps%pspcod(ityp);if (pspcod==17) pspcod=7 ! PAW specificity
120 : call psp_data_merge_to_dict(dict // filename, int(psps%znucltypat(ityp)), &
121 : & int(psps%ziontypat(ityp)), pspcod, psps%pspxc(ityp), &
122 : & psps%gth_params%psppar(0:4,0:6,ityp), radii_cf, &
123 : & UNINITIALIZED(1._dp), UNINITIALIZED(1._dp))
124 : call psp_dict_fill_all(dict, trim(symbol), psps%pspxc(ityp))
125 : end do
126 :
127 : call psp_dict_analyse(dict, wvl%atoms)
128 : inquire(file = filoccup, exist = exists)
129 : if (exists) then
130 : call merge_input_file_to_dict(dict//"Atomic occupation",filoccup,bigdft_mpi)
131 : end if
132 : ! Need to add spinat in the dictionary, later
133 : if (spinat(1,1) == zero .and. .false.) then
134 : call dict_set(dict // "spinat", spinat(1,1))
135 : end if
136 : call atomic_data_set_from_dict(dict, "Atomic occupation", wvl%atoms, nsppol)
137 : call dict_free(dict)
138 :
139 : #else
140 0 : BIGDFT_NOTENABLED_ERROR()
141 : if (.false.) write(std_out,*) nsppol,wvl%h(1),psps%npsp,filoccup,spinat(1,1)
142 : #endif
143 :
144 0 : end subroutine wvl_descr_psp_set
145 : !!***
146 :
147 : !!****f* defs_wvltypes/wvl_descr_psp_fill
148 : !! NAME
149 : !! wvl_descr_psp_fill
150 : !!
151 : !! FUNCTION
152 : !! Read the radii from @pspunit, if any and fill values with default otherwise.
153 : !!
154 : !! INPUTS
155 : !!
156 : !! OUTPUT
157 : !!
158 : !! SOURCE
159 :
160 0 : subroutine wvl_descr_psp_fill(gth_params, ipsp, ixc, nelpsp, nzatom, pspunit)
161 :
162 : #if defined HAVE_BIGDFT
163 : use BigDFT_API, only: atomic_info, UNINITIALIZED, psp_from_data
164 : #endif
165 :
166 : !Arguments ------------------------------------
167 : integer, intent(in) :: ipsp, pspunit, nzatom, nelpsp, ixc
168 : type(pseudopotential_gth_type), intent(inout) :: gth_params
169 : !Local variables-------------------------------
170 : #if defined HAVE_BIGDFT
171 : integer :: ios, ii, nzatom_, nelpsp_, npspcode_, ixc_
172 : real(dp) :: ehomo, radfine
173 : logical :: exists
174 : character(len = 2) :: symbol
175 : character(len=100) :: line
176 : character(len=500) :: message
177 : #endif
178 :
179 : ! ***************************************************************************
180 :
181 : #if defined HAVE_BIGDFT
182 :
183 : ! check if gth_params%psppar have been set
184 : if (any(gth_params%psppar == UNINITIALIZED(1._dp))) then
185 : call atomic_info(nzatom, nelpsp, symbol = symbol)
186 : ixc_ = ixc
187 : if (ixc_>0.and.ixc_< 10) ixc_=1
188 : if (ixc_>0.and.ixc_>=10) ixc_=11
189 : call psp_from_data(symbol, nzatom_, nelpsp_, npspcode_, ixc_, &
190 : & gth_params%psppar(:,:,ipsp), exists)
191 : if(.not. exists) then
192 : write(message,'(a,a,a,a)')ch10,&
193 : & "wvl_descr_psp_fill : bug, chemical element not found in BigDFT table",ch10,&
194 : & "Action: upgrade BigDFT table"
195 : call wrtout(ab_out,message,'COLL')
196 : ABI_BUG(message)
197 : end if
198 : gth_params%set(ipsp) = .true.
199 : end if
200 :
201 : ! Try to read radii from pspunit
202 : if (pspunit /= 0) then
203 : read (pspunit, '(a100)', iostat = ios) line
204 : if (ios /= 0) then
205 : line=''
206 : end if
207 : ! We try to read the values from the pseudo.
208 : read (line, *, iostat = ios) gth_params%radii_cf(ipsp, 1), gth_params%radii_cf(ipsp, 2), &
209 : & gth_params%radii_cf(ipsp, 3)
210 : if (ios /= 0 .or. gth_params%radii_cf(ipsp, 3) < zero) then
211 : read (line, *, iostat = ios) gth_params%radii_cf(ipsp, 1), gth_params%radii_cf(ipsp, 2)
212 : gth_params%radii_cf(ipsp, 3) = UNINITIALIZED(gth_params%radii_cf(ipsp, 3))
213 : end if
214 : if (ios /= 0 .or. gth_params%radii_cf(ipsp, 1) < zero .or. gth_params%radii_cf(ipsp, 2) < zero) then
215 : gth_params%radii_cf(ipsp, 1) = UNINITIALIZED(gth_params%radii_cf(ipsp, 1))
216 : gth_params%radii_cf(ipsp, 2) = UNINITIALIZED(gth_params%radii_cf(ipsp, 2))
217 : write(message, '(a,a,a,a,a,a,a)' ) '-', ch10,&
218 : & '- wvl_descr_psp_fill : COMMENT -',ch10,&
219 : & "- the pseudo-potential does not include geometric information,",ch10,&
220 : & '- values have been computed.'
221 : call wrtout(ab_out,message,'COLL')
222 : call wrtout(std_out, message,'COLL')
223 : end if
224 : end if
225 :
226 : ! Update radii.
227 : if (gth_params%radii_cf(ipsp, 1) == UNINITIALIZED(gth_params%radii_cf(ipsp, 1))) then
228 : call atomic_info(nzatom, nelpsp, ehomo = ehomo)
229 : !assigning the radii by calculating physical parameters
230 : gth_params%radii_cf(ipsp, 1)=1._dp/sqrt(abs(2._dp*ehomo))
231 : end if
232 : if (gth_params%radii_cf(ipsp, 2) == UNINITIALIZED(gth_params%radii_cf(ipsp, 2))) then
233 : radfine = gth_params%psppar(0, 0, ipsp)
234 : do ii = 1, 4, 1
235 : if (gth_params%psppar(ii, 0, ipsp) /= zero) then
236 : radfine = min(radfine, gth_params%psppar(ii, 0, ipsp))
237 : end if
238 : end do
239 : gth_params%radii_cf(ipsp, 2)=radfine
240 : end if
241 : if (gth_params%radii_cf(ipsp, 3) == UNINITIALIZED(gth_params%radii_cf(ipsp, 3))) then
242 : gth_params%radii_cf(ipsp, 3)=gth_params%radii_cf(ipsp, 2)
243 : end if
244 :
245 : ! Set flag.
246 : if (gth_params%radii_cf(ipsp, 1) >= 0.d0 .and. gth_params%radii_cf(ipsp, 2) >= 0.d0) then
247 : gth_params%hasGeometry(ipsp) = .true.
248 : else
249 : gth_params%hasGeometry(ipsp) = .false.
250 : end if
251 :
252 : write(message, '(a,f12.7,a,f12.7,a,f12.7)' )&
253 : & ' radii_cf(1)=', gth_params%radii_cf(ipsp, 1),&
254 : & '; radii_cf(2)=', gth_params%radii_cf(ipsp, 2),&
255 : & '; rad_cov=', gth_params%radii_cf(ipsp, 3)
256 : call wrtout(ab_out,message,'COLL')
257 : call wrtout(std_out, message,'COLL')
258 :
259 : ! Some consistency checks on radii, to be moved earlier, but need to update test refs.
260 : ! gth_params%radii_cf(ipsp, 3) = min(gth_params%radii_cf(ipsp, 3), gth_params%radii_cf(ipsp, 2))
261 :
262 : ! This was one before
263 : ! maxrad=zero
264 : ! do ii=0,2,1
265 : ! if (ii==1) maxrad=zero
266 : ! if (gth_params%psppar(ii,0,ipsp)/=zero) maxrad=max(maxrad,gth_params%psppar(ii,0,ipsp))
267 : ! end do
268 : ! if (maxrad== zero) then
269 : ! gth_params%radii_cf(ipsp,3)=zero
270 : ! else
271 : ! gth_params%radii_cf(ipsp,3)=max( &
272 : !& min(dtset%wvl_crmult*psps%gth_params%radii_cf(ipsp,1), &
273 : !& 15._dp*maxrad)/dtset%wvl_frmult,gth_params%radii_cf(ipsp,2))
274 : ! end if
275 :
276 : #else
277 0 : BIGDFT_NOTENABLED_ERROR()
278 : if (.false.) write(std_out,*) ipsp,pspunit,nzatom,nelpsp,ixc,gth_params%psppar
279 : #endif
280 :
281 0 : end subroutine wvl_descr_psp_fill
282 : !!***
283 :
284 : !!****f* defs_wvltypes/wvl_descr_free
285 : !!
286 : !! NAME
287 : !! wvl_descr_free
288 : !!
289 : !! FUNCTION
290 : !! Free the wvl%atoms% datastructure (deallocate or nullify)
291 : !!
292 : !! INPUTS
293 : !! wvl <type(wvl_internal_type)>=internal variables for wavelets
294 : !!
295 : !! OUTPUT
296 : !! wvl <type(wvl_internal_type)>=internal variables for wavelets
297 : !!
298 : !! SOURCE
299 :
300 0 : subroutine wvl_descr_free(wvl)
301 :
302 : use defs_wvltypes
303 : #if defined HAVE_BIGDFT
304 : use BigDFT_API, only : deallocate_atoms_data
305 : use dynamic_memory
306 : #endif
307 :
308 : !Arguments ------------------------------------
309 : !scalars
310 : type(wvl_internal_type), intent(inout) :: wvl
311 : !arrays
312 :
313 : !Local variables-------------------------------
314 : !scalars
315 :
316 : ! *********************************************************************
317 :
318 : #if defined HAVE_BIGDFT
319 : !These arrays are pointers on memory handled by ABINIT.
320 : nullify(wvl%atoms%astruct%sym%irrzon)
321 : nullify(wvl%atoms%astruct%sym%phnons)
322 : if (associated(wvl%atoms%nlccpar)) then
323 : call f_free_ptr(wvl%atoms%nlccpar)
324 : end if
325 : call deallocate_atoms_data(wvl%atoms)
326 : #endif
327 0 : if(allocated(wvl%npspcode_paw_init_guess)) then
328 0 : ABI_FREE(wvl%npspcode_paw_init_guess)
329 : end if
330 0 : end subroutine wvl_descr_free
331 : !!***
332 :
333 : !!****f* defs_wvltypes/wvl_descr_atoms_set
334 : !!
335 : !! NAME
336 : !! wvl_descr_atoms_set
337 : !!
338 : !! FUNCTION
339 : !! Defines wvl%atoms% data structure
340 : !!
341 : !! INPUTS
342 : !! acell(3)=unit cell length scales (bohr)
343 : !! dtset <type(dataset_type)>=all input variables for this dataset
344 : !!
345 : !! OUTPUT
346 : !! wvl <type(wvl_internal_type)>= wavelet type
347 : !! | nat = number of atoms
348 : !! | ntypes = number of species
349 : !! | alat1 = acell(1)
350 : !! | alat2 = acell(2)
351 : !! | alat3 = acell(3)
352 : !! | iatype = types for atoms
353 : !! | lfrztyp = flag for the movement of atoms.
354 : !! | natpol = integer related to polarisation at the first step
355 : !!
356 : !! SOURCE
357 :
358 0 : subroutine wvl_descr_atoms_set(acell, icoulomb, natom, ntypat, typat, wvl)
359 :
360 : use defs_wvltypes
361 : #if defined HAVE_BIGDFT
362 : use BigDFT_API, only: atoms_data_null,f_routine,f_release_routine,&
363 : & astruct_set_n_atoms,astruct_set_n_types,&
364 : & allocate_atoms_nat,allocate_atoms_ntypes
365 : #endif
366 :
367 : !Arguments ------------------------------------
368 : !scalars
369 : integer, intent(in) :: icoulomb, natom, ntypat
370 : type(wvl_internal_type), intent(inout) :: wvl
371 : !arrays
372 : integer, intent(in) :: typat(natom)
373 : real(dp), intent(in) :: acell(3)
374 :
375 : !Local variables-------------------------------
376 : !scalars
377 : #if defined HAVE_BIGDFT
378 : integer :: itype
379 : #endif
380 :
381 : ! *********************************************************************
382 :
383 : #if defined HAVE_BIGDFT
384 :
385 : call f_routine('wvl_descr_atoms_set')
386 :
387 : wvl%atoms=atoms_data_null()
388 :
389 : !We create the atoms_data structure from this dataset
390 : !to be used later in BigDFT routines.
391 : if (icoulomb == 0) then
392 : wvl%atoms%astruct%geocode = 'P'
393 : else if (icoulomb == 1) then
394 : wvl%atoms%astruct%geocode = 'F'
395 : else if (icoulomb == 2) then
396 : wvl%atoms%astruct%geocode = 'S'
397 : end if
398 : write(wvl%atoms%astruct%units, "(A)") "Bohr"
399 :
400 : call astruct_set_n_atoms(wvl%atoms%astruct, natom)
401 : call astruct_set_n_types(wvl%atoms%astruct, ntypat)
402 :
403 : do itype = 1, ntypat, 1
404 : write(wvl%atoms%astruct%atomnames(itype), "(A,I2)") "At. type", itype
405 : end do
406 : wvl%atoms%astruct%cell_dim(1) = acell(1)
407 : wvl%atoms%astruct%cell_dim(2) = acell(2)
408 : wvl%atoms%astruct%cell_dim(3) = acell(3)
409 : wvl%atoms%astruct%iatype = typat
410 :
411 : wvl%atoms%astruct%sym%symObj = 0
412 :
413 : call allocate_atoms_nat(wvl%atoms)
414 : call allocate_atoms_ntypes(wvl%atoms)
415 :
416 : call f_release_routine()
417 :
418 : #else
419 0 : BIGDFT_NOTENABLED_ERROR()
420 : if (.false.) write(std_out,*) icoulomb,natom,ntypat,wvl%h(1),typat(1),acell(1)
421 : #endif
422 :
423 0 : end subroutine wvl_descr_atoms_set
424 : !!***
425 :
426 : !!****f* defs_wvltypes/wvl_descr_atoms_set_sym
427 : !!
428 : !! NAME
429 : !! wvl_descr_atoms_set_sym
430 : !!
431 : !! FUNCTION
432 : !! Add symmetry information to wvl%atoms data structure.
433 : !!
434 : !! INPUTS
435 : !! acell(3)=unit cell length scales (bohr)
436 : !! dtset <type(dataset_type)>=all input variables for this dataset
437 : !!
438 : !! OUTPUT
439 : !! wvl <type(wvl_internal_type)>= wavelet type
440 : !! | nat = number of atoms
441 : !! | ntypes = number of species
442 : !! | alat1 = acell(1)
443 : !! | alat2 = acell(2)
444 : !! | alat3 = acell(3)
445 : !! | iatype = types for atoms
446 : !! | lfrztyp = flag for the movement of atoms.
447 : !! | natpol = integer related to polarisation at the first step
448 : !!
449 : !! SOURCE
450 :
451 0 : subroutine wvl_descr_atoms_set_sym(wvl, efield, irrzon, nsppol, nsym, phnons, &
452 0 : & symafm, symrel, tnons, tolsym)
453 :
454 : use defs_wvltypes
455 : use m_ab7_symmetry
456 : #if defined HAVE_BIGDFT
457 : use BigDFT_API, only: astruct_set_symmetries
458 : #endif
459 :
460 : !Arguments ------------------------------------
461 : !scalars
462 : integer, intent(in) :: nsppol,nsym
463 : real(dp), intent(in) :: tolsym
464 : type(wvl_internal_type), intent(inout) :: wvl
465 : !arrays
466 : integer, intent(in) :: symafm(3,3,nsym), symrel(3,3,nsym)
467 : integer, target, intent(in) :: irrzon(:,:,:)
468 : real(dp), target, intent(in) :: phnons(:,:,:)
469 : real(dp), intent(in) :: efield(3), tnons(3,nsym)
470 :
471 : !Local variables-------------------------------
472 : !scalars
473 : #if defined HAVE_BIGDFT
474 : integer :: errno
475 : character(len=500) :: message
476 : #endif
477 :
478 : ! *********************************************************************
479 :
480 : #if defined HAVE_BIGDFT
481 :
482 : write(message, '(a,a)' ) ch10,&
483 : & ' wvl_descr_atoms_set_sym: Create symmetries for the wvl%atoms object.'
484 : call wrtout(std_out,message,'COLL')
485 :
486 : wvl%atoms%astruct%sym%symObj = -1
487 : nullify(wvl%atoms%astruct%sym%irrzon)
488 : nullify(wvl%atoms%astruct%sym%phnons)
489 : call astruct_set_symmetries(wvl%atoms%astruct, (nsym <= 1), tolsym, efield, nsppol)
490 : if (nsym > 1) then
491 : call symmetry_set_n_sym(wvl%atoms%astruct%sym%symObj, nsym, symrel, tnons, symafm, errno)
492 : end if
493 : wvl%atoms%astruct%sym%irrzon => irrzon
494 : wvl%atoms%astruct%sym%phnons => phnons
495 :
496 : #else
497 0 : BIGDFT_NOTENABLED_ERROR()
498 : if (.false.) write(std_out,*) nsppol,nsym,tolsym,wvl%h(1),symafm(1,1,1),symrel(1,1,1),&
499 : & irrzon(1,1,1),phnons(1,1,1),efield(1),tnons(1,1)
500 : #endif
501 :
502 0 : end subroutine wvl_descr_atoms_set_sym
503 : !!***
504 :
505 : end module m_wvl_descr_psp
506 : !!***
|
