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