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 6940 : 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 6940 : 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 131860 : ngfftc(:)=Dtset%ngfft(:)
189 :
190 12435 : SELECT CASE (Dtset%usepaw)
191 :
192 : CASE (0)
193 : ! === Norm-conserving pseudopotentials ===
194 104405 : nfftf=Dtset%nfft ; mgfftf=Dtset%mgfft ; ngfftf(:)=Dtset%ngfft(:)
195 5495 : Pawfgr%usefinegrid=0
196 5495 : ABI_MALLOC(Pawfgr%coatofin,(0))
197 5495 : ABI_MALLOC(Pawfgr%fintocoa,(0))
198 5495 : ecut_eff =Dtset%ecut*Dtset%dilatmx**2
199 5495 : ecutdg_eff=ecut_eff
200 :
201 : CASE (1)
202 : ! == PAW calculation ===
203 1712 : 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 25840 : nfftf=Dtset%nfftdg ; mgfftf=Dtset%mgfftdg ; ngfftf(:)=Dtset%ngfftdg(:)
206 1360 : nfftc_tot =ngfftc(1)*ngfftc(2)*ngfftc(3)
207 1360 : nfftf_tot =ngfftf(1)*ngfftf(2)*ngfftf(3)
208 1360 : Pawfgr%usefinegrid=1
209 4080 : ABI_MALLOC(Pawfgr%coatofin,(nfftc_tot))
210 4080 : ABI_MALLOC(Pawfgr%fintocoa,(nfftf_tot))
211 1360 : 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 1445 : ecutdg_eff=Dtset%pawecutdg*Dtset%dilatmx**2
224 1445 : ecut_eff =Dtset%ecut*Dtset%dilatmx**2
225 :
226 : CASE DEFAULT
227 0 : write(msg,'(a,i4)')' Wrong value of usepaw: ',Dtset%usepaw
228 6940 : ABI_BUG(msg)
229 : END SELECT
230 :
231 : ! Store useful dimensions in Pawfgr
232 131860 : Pawfgr%nfftc=Dtset%nfft ; Pawfgr%mgfftc=Dtset%mgfft ; Pawfgr%ngfftc(:)=Dtset%ngfft(:)
233 131860 : 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 6940 : boxcut=-one
238 6940 : if (Dtset%usepaw==1) then
239 1445 : if (present(gsqcutc_eff)) then
240 13 : write(msg,'(2a)')ch10,' Coarse grid specifications (used for wave-functions):'
241 13 : call wrtout(std_out,msg)
242 13 : call getcut(boxcutc,ecut_eff,gmet,gsqcutc_eff,Dtset%iboxcut,std_out,k0,ngfftc)
243 : end if
244 1445 : if (present(gsqcutf_eff)) then
245 13 : write(msg,'(2a)')ch10,' Fine grid specifications (used for densities):'
246 13 : call wrtout(std_out,msg)
247 13 : call getcut(boxcut,ecutdg_eff,gmet,gsqcutf_eff,Dtset%iboxcut,std_out,k0,ngfftf)
248 : end if
249 5495 : else if (present(gsqcutc_eff)) then
250 486 : call getcut(boxcut,ecut_eff,gmet,gsqcutc_eff,Dtset%iboxcut,std_out,k0,ngfftc)
251 486 : gsqcutf_eff=gsqcutc_eff
252 : end if
253 :
254 : ! Check that boxcut>=2 if intxc=1; otherwise intxc must be set=0.
255 6940 : 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 6940 : 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 8677 : 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 8677 : if (associated(Pawfgr%coatofin)) then
297 8672 : ABI_FREE(Pawfgr%coatofin)
298 : end if
299 8677 : if (associated(Pawfgr%fintocoa)) then
300 8672 : ABI_FREE(Pawfgr%fintocoa)
301 : end if
302 :
303 8677 : Pawfgr%usefinegrid=0
304 :
305 : DBG_EXIT("COLL")
306 :
307 8677 : 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 3093 : 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 3093 : integer,allocatable :: gc(:,:),gf(:,:)
385 : character(len=500) :: msg
386 :
387 : ! *************************************************************************
388 :
389 : DBG_ENTER("COLL")
390 :
391 3093 : n1c=ngfftc(1);n2c=ngfftc(2);n3c=ngfftc(3)
392 3093 : n1f=ngfftf(1);n2f=ngfftf(2);n3f=ngfftf(3)
393 :
394 9279 : ABI_MALLOC(gc,(3,max(n1c,n2c,n3c)))
395 12372 : do ii=1,3
396 9279 : id(ii)=ngfftc(ii)/2+2
397 171074 : do ing=1,ngfftc(ii)
398 167981 : gc(ii,ing)=ing-(ing/id(ii))*ngfftc(ii)-1
399 : end do
400 : end do
401 :
402 9279 : ABI_MALLOC(gf,(3,max(n1f,n2f,n3f)))
403 12372 : do ii=1,3
404 9279 : id(ii)=ngfftf(ii)/2+2
405 275393 : do ing=1,ngfftf(ii)
406 272300 : gf(ii,ing)=ing-(ing/id(ii))*ngfftf(ii)-1
407 : end do
408 : end do
409 :
410 116056449 : coatofin=0;fintocoa=0
411 56115 : do i1=1,n1c
412 846114 : do if1=1,n1f
413 843021 : if(gc(1,i1)==gf(1,if1)) then
414 1045367 : do i2=1,n2c
415 16731304 : do if2=1,n2f
416 16678282 : if(gc(2,i2)==gf(2,if2)) then
417 22387478 : do i3=1,n3c
418 424346756 : do if3=1,n3f
419 423354411 : if(gc(3,i3)==gf(3,if3)) then
420 21395133 : narg1=i1+n1c*(i2-1+n2c*(i3-1))
421 21395133 : narg2=if1+n1f*(if2-1+n2f*(if3-1))
422 21395133 : coatofin(narg1)=narg2
423 21395133 : fintocoa(narg2)=narg1
424 21395133 : 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 21398226 : do ii=1,ubound(coatofin,1)
439 21398226 : 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 3093 : ABI_FREE(gf)
446 3093 : ABI_FREE(gc)
447 :
448 : DBG_EXIT("COLL")
449 :
450 3093 : end subroutine indgrid
451 : !!***
452 :
453 : !----------------------------------------------------------------------
454 :
455 0 : END MODULE m_pawfgr
456 : !!***
|
