Branch data Line data Source code
1 : : !!****m* ABINIT/m_pawfgr
2 : : !! NAME
3 : : !! m_pawfgr
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains the definition of the pawfgr_type structured datatype,
7 : : !! as well as related functions and methods.
8 : : !! pawfgr_type variables define Fine rectangular GRid parameters and related data.
9 : : !!
10 : : !! COPYRIGHT
11 : : !! Copyright (C) 2013-2026 ABINIT group (MT, FJ)
12 : : !! This file is distributed under the terms of the
13 : : !! GNU General Public License, see ~abinit/COPYING
14 : : !! or http://www.gnu.org/copyleft/gpl.txt .
15 : : !!
16 : : !! INPUTS
17 : : !!
18 : : !! OUTPUT
19 : : !!
20 : : !! NOTES
21 : : !! * Routines tagged with "@type_name" are strongly connected to the definition of the data type.
22 : : !! Strongly connected means that the proper functioning of the implementation relies on the
23 : : !! assumption that the tagged procedure is consistent with the type declaration.
24 : : !! Every time a developer changes the structure "type_name" adding new entries, he/she has to make sure
25 : : !! that all the strongly connected routines are changed accordingly to accommodate the modification of the data type
26 : : !! Typical examples of strongly connected routines are creation, destruction or reset methods.
27 : : !!
28 : : !! SOURCE
29 : :
30 : : #if defined HAVE_CONFIG_H
31 : : #include "config.h"
32 : : #endif
33 : :
34 : : #include "abi_common.h"
35 : :
36 : : MODULE m_pawfgr
37 : :
38 : : use defs_basis
39 : : use m_errors
40 : : use m_abicore
41 : : use m_xmpi
42 : : use m_dtset
43 : :
44 : : use m_kg, only : getcut
45 : :
46 : : implicit none
47 : :
48 : : private
49 : :
50 : : !public procedures.
51 : : public :: pawfgr_init
52 : : public :: pawfgr_destroy
53 : : public :: pawfgr_nullify
54 : : public :: indgrid
55 : : !!***
56 : :
57 : : !----------------------------------------------------------------------
58 : :
59 : :
60 : : !!****t* m_pawfgr/pawfgr_type
61 : : !! NAME
62 : : !! pawfgr_type
63 : : !!
64 : : !! FUNCTION
65 : : !! For PAW, Fine GRid parameters and related data
66 : : !!
67 : : !! SOURCE
68 : :
69 : : type,public :: pawfgr_type
70 : :
71 : : ! WARNING : if you modify this datatype, please check whether there might be creation/destruction/copy routines,
72 : : ! declared in another part of ABINIT, that might need to take into account your modification.
73 : :
74 : : !Integer scalars
75 : :
76 : : integer :: mgfft, nfft
77 : : ! Values of mffft and nfft for the fine grid:
78 : : ! mgfft= max(ngfft(i)) [max. size of 1D FFT grid]
79 : : ! nfft=ngfft1*ngfft2*ngfft3 [number of pts in the FFT box]
80 : :
81 : : integer :: mgfftc, nfftc
82 : : ! Values of mffft and nfft for the COARSE grid:
83 : : ! mgfftc= max(ngfftc(i)) [max. size of 1D FFT grid]
84 : : ! nfftc=ngfftc1*ngfftc2*ngfftc3 [number of pts in the FFT box]
85 : :
86 : : integer :: usefinegrid
87 : : ! Flag: =1 if a double-grid is used to convert spherical data
88 : : ! to Fourier grid. =0 otherwise
89 : :
90 : : !Integer arrays
91 : :
92 : : ! MG TODO: Replace with allocatable
93 : : integer, pointer :: coatofin(:)
94 : : ! coatofin(nfftc)
95 : : ! Index of the points of the coarse grid on the fine grid
96 : :
97 : : integer, pointer :: fintocoa(:)
98 : : ! fintocoa(nfft)
99 : : ! Index of the points of the fine grid on the coarse grid
100 : : ! (=0 if the point of the fine grid does not belong to the coarse grid)
101 : :
102 : : integer :: ngfft(18)
103 : : ! ngfft(1:18)=integer array with FFT box dimensions and other
104 : : ! information on FFTs, for the fine rectangular grid
105 : :
106 : : integer :: ngfftc(18)
107 : : ! ngfft(1:18)=integer array with FFT box dimensions and other
108 : : ! information on FFTs, for the COARSE rectangular grid
109 : :
110 : : end type pawfgr_type
111 : : !!***
112 : :
113 : : CONTAINS
114 : :
115 : : !===========================================================
116 : : !!***
117 : :
118 : : !----------------------------------------------------------------------
119 : :
120 : : !!****f* m_pawfgr/pawfgr_init
121 : : !! NAME
122 : : !! pawfgr_init
123 : : !!
124 : : !! FUNCTION
125 : : !! Initialize a pawfgr_type datatype, reporting also info on the mesh
126 : : !! according to the method used (norm-conserving PSP or PAW)
127 : : !!
128 : : !! INPUTS
129 : : !! k0(3)=input k vector for k+G sphere
130 : : !! Dtset <type(dataset_type)>=all input variables for this dataset
131 : : !! %dilatmx
132 : : !! %usepaw
133 : : !! %usewvl
134 : : !! %natom
135 : : !! %ngfft
136 : : !! %ngfftdg
137 : : !! %nfft
138 : : !! %mgfft
139 : : !! %mgfftdg
140 : : !! %dilatmx
141 : : !! %pawecutdg
142 : : !! %ecut
143 : : !! gmet(3,3)=reciprocal space metric (bohr^-2)
144 : : !!
145 : : !! OUTPUT
146 : : !! ecut_eff=effective energy cutoff (hartree) for coarse planewave basis sphere
147 : : !! ecutdg_eff=effective energy cutoff (hartree) for dense planewave basis sphere
148 : : !! gsqcutc_eff=(PAW) Fourier cutoff on G^2 for "large sphere" of radius double for the coarse FFT grid
149 : : ! gsqcutf_eff=Fourier cutoff on G^2 for "large sphere" of radius double for the dense FFT grid
150 : : !! nfftf=(effective) number of FFT grid points (for this proc), for dense FFT mesh
151 : : !! mgfftf=maximum size of 1D FFTs, for dense FFT mesh
152 : : !! ngfftc(18),ngfftf(18)=contain all needed information about 3D FFT, for coarse and dense FFT mesh, resp.
153 : : !! see ~abinit/doc/variables/vargs.htm#ngfft
154 : : !! Pawfgr<pawfgr_type>=For PAW, Fine rectangular GRid parameters and related data
155 : : !!
156 : : !! SOURCE
157 : :
158 : 6989 : subroutine pawfgr_init(Pawfgr,Dtset,mgfftf,nfftf,ecut_eff,ecutdg_eff,ngfftc,ngfftf,&
159 : : & gsqcutc_eff,gsqcutf_eff,gmet,k0) ! optional
160 : :
161 : : !Arguments ------------------------------------
162 : : !scalars
163 : : integer,intent(out) :: nfftf,mgfftf
164 : : real(dp),intent(out) :: ecut_eff,ecutdg_eff
165 : : real(dp),intent(out),optional :: gsqcutf_eff,gsqcutc_eff
166 : : type(dataset_type),intent(in) :: Dtset
167 : : type(Pawfgr_type),intent(out) :: Pawfgr
168 : : !arrays
169 : : real(dp),intent(in),optional :: gmet(3,3)
170 : : integer,intent(out) :: ngfftc(18),ngfftf(18)
171 : : real(dp),intent(in),optional :: k0(3)
172 : :
173 : : !Local variables-------------------------------
174 : : integer :: ii,nfftc_tot,nfftf_tot
175 : : real(dp) :: boxcut,boxcutc
176 : : character(len=500) :: msg
177 : :
178 : : !************************************************************************
179 : :
180 : : DBG_ENTER("COLL")
181 : :
182 : : !@Pawfgr_type
183 [ + + - + ]: 6989 : if ((present(gsqcutc_eff).or.present(gsqcutf_eff)).and.&
184 : : ((.not.present(gmet)).or.(.not.present(k0)))) then
185 : 0 : ABI_BUG('To compute gsqcut[c,f]_eff, both k0 and gmet must be present as argument !')
186 : : end if
187 : :
188 [ + + ]: 132791 : ngfftc(:)=Dtset%ngfft(:)
189 : :
190 : 12502 : SELECT CASE (Dtset%usepaw)
191 : :
192 : : CASE (0)
193 : : ! === Norm-conserving pseudopotentials ===
194 [ + + ]: 104747 : nfftf=Dtset%nfft ; mgfftf=Dtset%mgfft ; ngfftf(:)=Dtset%ngfft(:)
195 : 5513 : Pawfgr%usefinegrid=0
196 [ - + ]: 5513 : ABI_MALLOC(Pawfgr%coatofin,(0))
197 [ - + ]: 5513 : ABI_MALLOC(Pawfgr%fintocoa,(0))
198 : 5513 : ecut_eff =Dtset%ecut*Dtset%dilatmx**2
199 : 5513 : ecutdg_eff=ecut_eff
200 : :
201 : : CASE (1)
202 : : ! == PAW calculation ===
203 [ + + + + : 1743 : if (any(Dtset%ngfftdg(1:3)/=Dtset%ngfft(1:3)) .and. Dtset%usewvl==0) then
+ + + - ]
204 : : ! Use fine FFT grid generated according to pawecutdg.
205 [ + + ]: 26429 : nfftf=Dtset%nfftdg ; mgfftf=Dtset%mgfftdg ; ngfftf(:)=Dtset%ngfftdg(:)
206 : 1391 : nfftc_tot =ngfftc(1)*ngfftc(2)*ngfftc(3)
207 : 1391 : nfftf_tot =ngfftf(1)*ngfftf(2)*ngfftf(3)
208 : 1391 : Pawfgr%usefinegrid=1
209 [ - + + - : 4173 : ABI_MALLOC(Pawfgr%coatofin,(nfftc_tot))
+ - + - -
+ - + ]
210 [ - + + - : 4173 : ABI_MALLOC(Pawfgr%fintocoa,(nfftf_tot))
+ - + - -
+ - + ]
211 : 1391 : call indgrid(Pawfgr%coatofin,Pawfgr%fintocoa,nfftc_tot,nfftf_tot,ngfftc,ngfftf)
212 : :
213 : : else
214 : : ! Do not use fine FFT mesh. Simple transfer that can be done in parallel with only local info.
215 [ + + ]: 1615 : nfftf=Dtset%nfft ; mgfftf=Dtset%mgfft ; ngfftf(:)=Dtset%ngfft(:)
216 : 85 : Pawfgr%usefinegrid=0
217 [ - + + - : 255 : ABI_MALLOC(Pawfgr%coatofin,(Dtset%nfft))
+ - + - -
+ - + ]
218 [ - + + - : 170 : ABI_MALLOC(Pawfgr%fintocoa,(Dtset%nfft))
- + - + ]
219 [ + + ]: 1004773 : do ii=1,Dtset%nfft
220 : 1004773 : Pawfgr%coatofin(ii)=ii ; Pawfgr%fintocoa(ii)=ii
221 : : end do
222 : : end if
223 : 1476 : ecutdg_eff=Dtset%pawecutdg*Dtset%dilatmx**2
224 : 1476 : ecut_eff =Dtset%ecut*Dtset%dilatmx**2
225 : :
226 : : CASE DEFAULT
227 : 0 : write(msg,'(a,i4)')' Wrong value of usepaw: ',Dtset%usepaw
228 [ + + - ]: 6989 : ABI_BUG(msg)
229 : : END SELECT
230 : :
231 : : ! Store useful dimensions in Pawfgr
232 [ + + ]: 132791 : Pawfgr%nfftc=Dtset%nfft ; Pawfgr%mgfftc=Dtset%mgfft ; Pawfgr%ngfftc(:)=Dtset%ngfft(:)
233 [ + + ]: 132791 : Pawfgr%nfft=nfftf ; Pawfgr%mgfft=mgfftf ; Pawfgr%ngfft (:)=ngfftf(:)
234 : :
235 : : ! Get boxcut for given gmet, ngfft, and ecut (center at k0) ===
236 : : ! boxcut=ratio of basis sphere diameter to fft box side
237 : 6989 : boxcut=-one
238 [ + + ]: 6989 : if (Dtset%usepaw==1) then
239 [ + + ]: 1476 : if (present(gsqcutc_eff)) then
240 : 16 : write(msg,'(2a)')ch10,' Coarse grid specifications (used for wave-functions):'
241 : 16 : call wrtout(std_out,msg)
242 : 16 : call getcut(boxcutc,ecut_eff,gmet,gsqcutc_eff,Dtset%iboxcut,std_out,k0,ngfftc)
243 : : end if
244 [ + + ]: 1476 : if (present(gsqcutf_eff)) then
245 : 16 : write(msg,'(2a)')ch10,' Fine grid specifications (used for densities):'
246 : 16 : call wrtout(std_out,msg)
247 : 16 : call getcut(boxcut,ecutdg_eff,gmet,gsqcutf_eff,Dtset%iboxcut,std_out,k0,ngfftf)
248 : : end if
249 [ + + ]: 5513 : else if (present(gsqcutc_eff)) then
250 : 494 : call getcut(boxcut,ecut_eff,gmet,gsqcutc_eff,Dtset%iboxcut,std_out,k0,ngfftc)
251 : 494 : gsqcutf_eff=gsqcutc_eff
252 : : end if
253 : :
254 : : ! Check that boxcut>=2 if intxc=1; otherwise intxc must be set=0.
255 [ + + + + : 6989 : if (boxcut>=zero .and. boxcut<two .and. Dtset%intxc==1) then
- + ]
256 : : write(msg,'(a,es12.4,5a)')&
257 : 0 : ' boxcut=',boxcut,' is < 2.0 => intxc must be 0;',ch10,&
258 : 0 : ' Need larger ngfft to use intxc=1.',ch10,&
259 : 0 : ' Action: you could increase ngfft, or decrease ecut, or put intxc=0.'
260 : 0 : ABI_ERROR(msg)
261 : : end if
262 : :
263 : : DBG_EXIT("COLL")
264 : :
265 : 6989 : end subroutine pawfgr_init
266 : : !!***
267 : :
268 : : !----------------------------------------------------------------------
269 : :
270 : : !!****f* m_pawfgr/pawfgr_destroy
271 : : !! NAME
272 : : !! pawfgr_destroy
273 : : !!
274 : : !! FUNCTION
275 : : !! Deallocate pointers and nullify flags in a pawfgr structure
276 : : !!
277 : : !! SIDE EFFECTS
278 : : !! pawfgr<type(pawfgr_type)>= Fine GRid parameters and related data
279 : : !!
280 : : !! SOURCE
281 : :
282 : 8726 : subroutine pawfgr_destroy(Pawfgr)
283 : :
284 : : !Arguments ------------------------------------
285 : : !arrays
286 : : type(Pawfgr_type),intent(inout) :: Pawfgr
287 : :
288 : : !Local variables-------------------------------
289 : :
290 : : ! *************************************************************************
291 : :
292 : : DBG_ENTER("COLL")
293 : :
294 : : !@Pawfgr_type
295 : :
296 [ + + ]: 8726 : if (associated(Pawfgr%coatofin)) then
297 : 8721 : ABI_FREE(Pawfgr%coatofin)
298 : : end if
299 [ + + ]: 8726 : if (associated(Pawfgr%fintocoa)) then
300 : 8721 : ABI_FREE(Pawfgr%fintocoa)
301 : : end if
302 : :
303 : 8726 : Pawfgr%usefinegrid=0
304 : :
305 : : DBG_EXIT("COLL")
306 : :
307 : 8726 : end subroutine pawfgr_destroy
308 : : !!***
309 : :
310 : : !----------------------------------------------------------------------
311 : :
312 : : !!****f* m_paw_ij/pawfgr_nullify
313 : : !! NAME
314 : : !! pawfgr_nullify
315 : : !!
316 : : !! FUNCTION
317 : : !! Nullify pointers and flags in a pawfgr structure
318 : : !!
319 : : !! SIDE EFFECTS
320 : : !! Pawfgr<type(pawfgr_type)>=Fine GRid parameters and related data. Nullified in output
321 : : !!
322 : : !! SOURCE
323 : :
324 : 6 : subroutine pawfgr_nullify(Pawfgr)
325 : :
326 : : !Arguments ------------------------------------
327 : : !arrays
328 : : type(Pawfgr_type),intent(inout) :: Pawfgr
329 : :
330 : : !Local variables-------------------------------
331 : :
332 : : ! *************************************************************************
333 : :
334 : : !@Pawfgr_type
335 : :
336 : 6 : nullify(Pawfgr%coatofin)
337 : 6 : nullify(Pawfgr%fintocoa)
338 : :
339 : 6 : Pawfgr%usefinegrid=0
340 : :
341 : 6 : end subroutine pawfgr_nullify
342 : : !!***
343 : :
344 : : !----------------------------------------------------------------------
345 : :
346 : : !!****f* m_pawfgr/indgrid
347 : : !!
348 : : !! NAME
349 : : !! indgrid
350 : : !!
351 : : !! FUNCTION
352 : : !! Calculate the correspondance between the coarse grid and the fine grid
353 : : !!
354 : : !! INPUTS
355 : : !! nfftc=total number of FFt grid=n1*n2*n3 for the coarse grid
356 : : !! nfftf=total number of FFt grid=n1*n2*n3 for the fine grid
357 : : !! ngfftc(18)=contain all needed information about 3D FFT, for the coarse grid,
358 : : !! see ~abinit/doc/variables/vargs.htm#ngfft
359 : : !! ngfftf(18)=contain all needed information about 3D FFT, for the fine grid,
360 : : !! see ~abinit/doc/variables/vargs.htm#ngfft
361 : : !!
362 : : !! OUTPUT
363 : : !! coatofin(nfftc)= index of the points of the coarse grid on the fine grid
364 : : !! fintocoa(nfftf)=index of the points of the fine grid on the
365 : : !! coarse grid (=0 if the point of the fine grid does not belong to
366 : : !! the coarse grid).
367 : : !!
368 : : !! SOURCE
369 : :
370 : 3124 : subroutine indgrid(coatofin,fintocoa,nfftc,nfftf,ngfftc,ngfftf)
371 : :
372 : : !Arguments ------------------------------------
373 : : !scalars
374 : : integer,intent(in) :: nfftc,nfftf
375 : : !arrays
376 : : integer,intent(in) :: ngfftc(18),ngfftf(18)
377 : : integer,intent(out) :: coatofin(nfftc),fintocoa(nfftf)
378 : :
379 : : !Local variables-------------------------------
380 : : !scalars
381 : : integer :: i1,i2,i3,if1,if2,if3,ii,ing,n1c,n1f,n2c,n2f,n3c,n3f,narg1,narg2
382 : : !arrays
383 : : integer :: id(3)
384 : 3124 : integer,allocatable :: gc(:,:),gf(:,:)
385 : : character(len=500) :: msg
386 : :
387 : : ! *************************************************************************
388 : :
389 : : DBG_ENTER("COLL")
390 : :
391 : 3124 : n1c=ngfftc(1);n2c=ngfftc(2);n3c=ngfftc(3)
392 : 3124 : n1f=ngfftf(1);n2f=ngfftf(2);n3f=ngfftf(3)
393 : :
394 [ - + + - : 9372 : ABI_MALLOC(gc,(3,max(n1c,n2c,n3c)))
+ - + - -
+ + - ]
395 [ + + ]: 12496 : do ii=1,3
396 : 9372 : id(ii)=ngfftc(ii)/2+2
397 [ + + ]: 174174 : do ing=1,ngfftc(ii)
398 : 171050 : gc(ii,ing)=ing-(ing/id(ii))*ngfftc(ii)-1
399 : : end do
400 : : end do
401 : :
402 [ - + + - : 9372 : ABI_MALLOC(gf,(3,max(n1f,n2f,n3f)))
+ - + - -
+ + - ]
403 [ + + ]: 12496 : do ii=1,3
404 : 9372 : id(ii)=ngfftf(ii)/2+2
405 [ + + ]: 279789 : do ing=1,ngfftf(ii)
406 : 276665 : gf(ii,ing)=ing-(ing/id(ii))*ngfftf(ii)-1
407 : : end do
408 : : end do
409 : :
410 [ + + + + ]: 127773855 : coatofin=0;fintocoa=0
411 [ + + ]: 57138 : do i1=1,n1c
412 [ + - ]: 881009 : do if1=1,n1f
413 [ + + ]: 877885 : if(gc(1,i1)==gf(1,if1)) then
414 [ + + ]: 1095831 : do i2=1,n2c
415 [ + - ]: 18935880 : do if2=1,n2f
416 [ + + ]: 18881866 : if(gc(2,i2)==gf(2,if2)) then
417 [ + + ]: 25590102 : do i3=1,n3c
418 [ + - ]: 576915652 : do if3=1,n3f
419 [ + + ]: 575873835 : if(gc(3,i3)==gf(3,if3)) then
420 : 24548285 : narg1=i1+n1c*(i2-1+n2c*(i3-1))
421 : 24548285 : narg2=if1+n1f*(if2-1+n2f*(if3-1))
422 : 24548285 : coatofin(narg1)=narg2
423 : 24548285 : fintocoa(narg2)=narg1
424 : 24548285 : exit
425 : : end if
426 : : end do
427 : : end do
428 : : exit ! To avoid N_fine * N_coarse scaling
429 : : end if
430 : : end do
431 : : end do
432 : : exit ! To avoid N_fine * N_coarse scaling
433 : : end if
434 : : end do
435 : : end do
436 : :
437 : : !Check coatofin to make sure there are no zeros!
438 [ + + ]: 24551409 : do ii=1,ubound(coatofin,1)
439 [ - + ]: 24551409 : if (coatofin(ii)==0) then
440 : 0 : msg = 'A zero was found in coatofin. Check that the fine FFT mesh is finer in each dimension than the coarse FFT mesh.'
441 : 0 : ABI_ERROR(msg)
442 : : end if
443 : : end do
444 : :
445 [ - + ]: 3124 : ABI_FREE(gf)
446 [ - + ]: 3124 : ABI_FREE(gc)
447 : :
448 : : DBG_EXIT("COLL")
449 : :
450 : 3124 : end subroutine indgrid
451 : : !!***
452 : :
453 : : !----------------------------------------------------------------------
454 : :
455 : 0 : END MODULE m_pawfgr
456 : : !!***
|
