Line data Source code
1 : !!****f* ABINIT/m_chebfiwf
2 : !! NAME
3 : !! m_chebfiwf
4 : !!
5 : !! FUNCTION
6 : !! This module contains a routine updating the whole wave functions at a given k-point,
7 : !! using the Chebyshev filtering method (2021 implementation using xG abstraction layer)
8 : !! for a given spin-polarization, from a fixed hamiltonian
9 : !! but might also simply compute eigenvectors and eigenvalues at this k point.
10 : !! it will also update the matrix elements of the hamiltonian.
11 : !!
12 : !! COPYRIGHT
13 : !! Copyright (C) 2018-2026 ABINIT group (BS, IML)
14 : !! This file is distributed under the terms of the
15 : !! gnu general public license, see ~abinit/COPYING
16 : !! or http://www.gnu.org/copyleft/gpl.txt .
17 : !! for the initials of contributors, see ~abinit/doc/developers/contributors.txt .
18 : !!
19 : !! SOURCE
20 :
21 : #if defined HAVE_CONFIG_H
22 : #include "config.h"
23 : #endif
24 :
25 : #include "abi_common.h"
26 :
27 : ! nvtx related macro definition
28 : #include "nvtx_macros.h"
29 :
30 : module m_chebfiwf
31 :
32 : use defs_abitypes
33 : use defs_basis
34 : use m_abicore
35 : use m_errors
36 : use m_fstrings
37 : use m_time
38 :
39 : use m_chebfi
40 : use m_chebfi2
41 : use m_invovl
42 :
43 : use m_cgtools, only : dotprod_g
44 : use m_dtset, only : dataset_type
45 :
46 : use m_hamiltonian, only : gs_hamiltonian_type
47 : use m_pawcprj, only : pawcprj_type
48 : use m_nonlop, only : nonlop
49 : use m_prep_kgb, only : prep_getghc, prep_nonlop
50 : use m_pawcprj, only : pawcprj_type, pawcprj_alloc, pawcprj_free
51 : use m_getghc, only : multithreaded_getghc
52 : use m_gemm_nonlop_projectors , only : gemm_nonlop_use_gemm
53 :
54 : use m_xg
55 : use m_xgTransposer
56 :
57 : #if defined(HAVE_GPU_MARKERS)
58 : use m_nvtx_data
59 : #endif
60 :
61 : #if defined(HAVE_GPU)
62 : use m_gpu_toolbox
63 : #endif
64 :
65 : #if defined(HAVE_YAKL)
66 : use gator_mod
67 : #endif
68 :
69 : use, intrinsic :: iso_c_binding, only: c_associated,c_loc,c_ptr,c_f_pointer,c_double,c_size_t
70 :
71 : use m_xmpi
72 : use m_xomp
73 : #ifdef HAVE_OPENMP
74 : use omp_lib
75 : #endif
76 :
77 : implicit none
78 :
79 : private
80 :
81 : integer, parameter :: l_tim_getghc=7
82 : real(dp), parameter :: inv_sqrt2 = 1/sqrt2
83 :
84 : ! For use in getghc_gsc1
85 : integer, save :: l_cpopt
86 : integer, save :: l_icplx
87 : integer, save :: l_nspinor
88 : logical, save :: l_paw
89 : integer, save :: l_prtvol
90 : integer, save :: l_sij_opt
91 : integer, save :: l_paral_kgb
92 : integer, save :: l_useria
93 : integer, save :: l_block_sliced
94 :
95 : type(mpi_type),pointer,save :: l_mpi_enreg
96 : type(gs_hamiltonian_type),pointer,save :: l_gs_hamk
97 :
98 : integer, parameter :: DEBUG_ROWS = 5
99 : integer, parameter :: DEBUG_COLUMNS = 5
100 :
101 : public :: chebfiwf2
102 :
103 : CONTAINS !========================================================================================
104 : !!***
105 :
106 : !!****f* m_chebfiwf/chebfiwf2
107 : !! NAME
108 : !! chebfiwf2
109 : !!
110 : !! FUNCTION
111 : !! This routine updates the whole wave functions set at a given k-point,
112 : !! using the Chebfi method (2021 version using xG abstraction layer)
113 : !!
114 : !! INPUTS
115 : !! dtset= input variables for this dataset
116 : !! mpi_enreg= MPI-parallelisation information
117 : !! nband= number of bands at this k point
118 : !! npw= number of plane waves at this k point
119 : !! nspinor= number of spinorial components of the wavefunctions
120 : !! prtvol= control print volume and debugging
121 : !!
122 : !! OUTPUT
123 : !! eig(nband)= eigenvalues (hartree) for all bands
124 : !! enl_out(nband)= contribution of each band to the nl part of energy
125 : !! resid(nband)= residuals for each band
126 : !!
127 : !! SIDE EFFECTS
128 : !! cg(2,npw*nspinor*nband)= planewave coefficients of wavefunctions
129 : !! gs_hamk <type(gs_hamiltonian_type)>=all data for the hamiltonian at k
130 : !!
131 : !! SOURCE
132 :
133 9024 : subroutine chebfiwf2(cg,dtset,eig,occ,enl_out,gs_hamk,mpi_enreg,&
134 9024 : & nband,npw,nspinor,prtvol,resid)
135 :
136 : implicit none
137 :
138 : ! Arguments ------------------------------------
139 : integer,intent(in) :: nband,npw,prtvol,nspinor
140 : type(mpi_type),target,intent(in) :: mpi_enreg
141 : real(dp),target,intent(inout) :: cg(2,npw*nspinor*nband)
142 : real(dp),target,intent(out) :: resid(nband)
143 : real(dp),intent(out) :: enl_out(nband)
144 : real(dp),target,intent(out) :: eig(nband)
145 : real(dp),target,intent(in) :: occ(nband)
146 : type(dataset_type),intent(in) :: dtset
147 : type(gs_hamiltonian_type),target,intent(inout) :: gs_hamk
148 :
149 : ! Local variables-------------------------------
150 : ! scalars
151 : integer, parameter :: tim_chebfiwf2 = 1750
152 : integer, parameter :: tim_nonlop = 1753
153 : integer :: iband,shift,space,blockdim,total_spacedim,ierr
154 : integer :: me_g0,me_g0_fft
155 : logical :: transfer_cg
156 : integer(kind=c_size_t) :: localMem
157 9024 : type(chebfi_t) :: chebfi
158 : type(xgBlock_t) :: xgx0,xgeigen,xgocc,xgresidu
159 : ! arrays
160 : real(dp) :: tsec(2)
161 : integer(kind=c_size_t) :: chebfiMem(2)
162 9024 : real(dp), allocatable :: gvnlxc(:,:),occ_tmp(:)
163 :
164 : ! Parameters for nonlop call in NC
165 : integer,parameter :: choice=1, paw_opt=0, signs=1
166 : real(dp) :: gsc_dummy(1,1)
167 126976 : type(pawcprj_type) :: cprj_dum(gs_hamk%natom,1)
168 :
169 : ! *********************************************************************
170 :
171 : !################ INITIALIZATION #####################################
172 : !######################################################################
173 :
174 9024 : call timab(tim_chebfiwf2,1,tsec)
175 :
176 : !Set module variables
177 9024 : l_paw = (gs_hamk%usepaw==1)
178 9024 : l_cpopt=-1;l_sij_opt=0;if (l_paw) l_sij_opt=1
179 9024 : l_nspinor = nspinor
180 9024 : l_prtvol = prtvol
181 9024 : l_mpi_enreg => mpi_enreg
182 9024 : l_gs_hamk => gs_hamk
183 9024 : l_paral_kgb = dtset%paral_kgb
184 9024 : l_block_sliced = dtset%invovl_blksliced
185 :
186 : !Variables
187 9024 : blockdim=l_mpi_enreg%nproc_band*l_mpi_enreg%bandpp
188 : !for debug
189 9024 : l_useria=dtset%useria
190 :
191 : !Depends on istwfk
192 9024 : if ( gs_hamk%istwf_k > 1 ) then ! Real only
193 : ! SPACE_CR mean that we have complex numbers but no re*im terms only re*re
194 : ! and im*im so that a vector of complex is consider as a long vector of real
195 : ! therefore the number of data is (2*npw*nspinor)*nband
196 : ! This space is completely equivalent to SPACE_R but will correctly set and
197 : ! get the array data into the xgBlock
198 3536 : space = SPACE_CR
199 3536 : l_icplx = 2
200 : else ! complex
201 5488 : space = SPACE_C
202 5488 : l_icplx = 1
203 : end if
204 :
205 9024 : me_g0 = -1
206 9024 : me_g0_fft = -1
207 9024 : if (space==SPACE_CR) then
208 3536 : me_g0 = 0
209 3536 : me_g0_fft = 0
210 3536 : if (gs_hamk%istwf_k == 2) then
211 442 : if (l_mpi_enreg%me_g0 == 1) me_g0 = 1
212 442 : if (l_mpi_enreg%me_g0_fft == 1) me_g0_fft = 1
213 : end if
214 : end if
215 :
216 : !Memory info
217 9024 : if ( prtvol >= 3 ) then
218 0 : if (l_mpi_enreg%paral_kgb == 1) then
219 0 : total_spacedim = l_icplx*npw*nspinor
220 0 : call xmpi_sum(total_spacedim,l_mpi_enreg%comm_bandspinorfft,ierr)
221 : else
222 0 : total_spacedim = 0
223 : end if
224 : chebfiMem = chebfi_memInfo(nband,l_icplx*npw*nspinor,space,l_mpi_enreg%paral_kgb, &
225 0 : & total_spacedim,l_mpi_enreg%bandpp) !blockdim
226 0 : localMem = (int(2,c_size_t)*npw*nspinor*nband+3*nband)*kind(1.d0) !blockdim
227 0 : write(std_out,'(1x,A,F10.6,1x,A)') "Each MPI process calling chebfi should need around ", &
228 0 : (localMem+sum(chebfiMem))/1e9,"GB of peak memory as follows :"
229 0 : write(std_out,'(4x,A,F10.6,1x,A)') "Permanent memory in chebfiwf : ",real(localMem)/1e9,"GB"
230 0 : write(std_out,'(4x,A,F10.6,1x,A)') "Permanent memory in m_chebfi : ",real(chebfiMem(1))/1e9,"GB"
231 0 : write(std_out,'(4x,A,F10.6,1x,A)') "Temporary memory in m_chebfi : ",real(chebfiMem(2))/1e9,"GB"
232 : end if
233 :
234 9024 : transfer_cg = .false.
235 : #ifdef HAVE_OPENMP_OFFLOAD
236 : !$OMP TARGET ENTER DATA MAP(to:eig,resid,occ) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP)
237 : transfer_cg = .not. xomp_target_is_present(c_loc(cg))
238 : !$OMP TARGET ENTER DATA MAP(to:cg) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP .and. transfer_cg)
239 : #endif
240 :
241 : call xgBlock_map(xgx0,cg,space,npw*nspinor,nband,comm=l_mpi_enreg%comm_bandspinorfft,me_g0=me_g0,&
242 9024 : & gpu_option=dtset%gpu_option)
243 :
244 9024 : call xgBlock_map_1d(xgeigen,eig,SPACE_R,nband,gpu_option=dtset%gpu_option)
245 :
246 9024 : call xgBlock_map_1d(xgresidu,resid,SPACE_R,nband,gpu_option=dtset%gpu_option)
247 :
248 : ! Occupancies in chebyshev are used for convergence criteria only
249 9024 : if (dtset%nbdbuf==-101.and.nspinor==1.and.dtset%nsppol==1) then
250 2448 : ABI_MALLOC(occ_tmp,(nband))
251 7344 : occ_tmp(:) = half*occ(:)
252 816 : call xgBlock_map_1d(xgocc,occ_tmp,SPACE_R,nband,gpu_option=dtset%gpu_option)
253 : else
254 8208 : call xgBlock_map_1d(xgocc,occ,SPACE_R,nband,gpu_option=dtset%gpu_option)
255 : end if
256 :
257 9024 : call timab(tim_chebfiwf2,2,tsec) ! IL TODO this should be deactivated
258 :
259 : ABI_NVTX_START_RANGE(NVTX_CHEBFI2_INIT)
260 : call chebfi_init(chebfi,nband,npw*nspinor,dtset%tolwfr_diago,dtset%ecut, &
261 : & dtset%paral_kgb,l_mpi_enreg%bandpp, &
262 : & dtset%mdeg_filter, dtset%nbdbuf, space,1, &
263 : & l_mpi_enreg%comm_bandspinorfft,me_g0,me_g0_fft,l_paw,&
264 : & l_mpi_enreg%comm_spinorfft,l_mpi_enreg%comm_band,&
265 : & dtset%chebfi_oracle,dtset%oracle_factor,dtset%oracle_min_occ,&
266 : & l_gs_hamk%gpu_option,gpu_kokkos_nthrd=dtset%gpu_kokkos_nthrd,&
267 9024 : & gpu_thread_limit=dtset%gpu_thread_limit)
268 : ABI_NVTX_END_RANGE()
269 :
270 : !################ RUUUUUUUN #####################################
271 : !######################################################################
272 :
273 9024 : call chebfi_run(chebfi,xgx0,getghc_gsc1,getBm1X,xgeigen,xgocc,xgresidu,nspinor)
274 :
275 9024 : if (allocated(occ_tmp)) then
276 816 : ABI_FREE(occ_tmp)
277 : end if
278 :
279 9024 : if ( .not. l_paw ) then
280 1496 : call timab(tim_nonlop,1,tsec)
281 : #ifdef FC_CRAY
282 : ABI_MALLOC(gvnlxc,(1,1))
283 : #else
284 1496 : ABI_MALLOC(gvnlxc,(0,0))
285 : #endif
286 : !end if
287 :
288 : ABI_NVTX_START_RANGE(NVTX_CHEBFI2_NONLOP)
289 : !Call nonlop
290 1496 : if (l_paral_kgb==0) then
291 :
292 : call nonlop(choice,l_cpopt,cprj_dum,enl_out,l_gs_hamk,0,eig,mpi_enreg,nband,1,paw_opt,&
293 408 : & signs,gsc_dummy,l_tim_getghc,cg,gvnlxc)
294 :
295 : else
296 : #ifdef HAVE_OPENMP_OFFLOAD
297 : !$OMP TARGET UPDATE FROM(cg) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP)
298 : #endif
299 2176 : do iband=1,nband/blockdim
300 1088 : shift = (iband-1)*blockdim*npw*nspinor
301 : call prep_nonlop(choice,l_cpopt,cprj_dum, &
302 : & enl_out((iband-1)*blockdim+1:iband*blockdim),l_gs_hamk,0,&
303 : & eig((iband-1)*blockdim+1:iband*blockdim),blockdim,mpi_enreg,1,paw_opt,signs,&
304 : & gsc_dummy,l_tim_getghc,cg(:,shift+1:shift+blockdim*npw*nspinor),gvnlxc(:,:),&
305 2176 : & already_transposed=.false.)
306 : end do
307 : end if
308 : ABI_NVTX_END_RANGE()
309 1496 : ABI_FREE(gvnlxc)
310 1496 : call timab(tim_nonlop,2,tsec)
311 : end if
312 :
313 : !Free chebfi
314 9024 : call chebfi_free(chebfi)
315 :
316 : #ifdef HAVE_OPENMP_OFFLOAD
317 : !$OMP TARGET UPDATE FROM(eig,resid) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP)
318 : !$OMP TARGET EXIT DATA MAP(delete:eig,resid,occ) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP)
319 : !$OMP TARGET EXIT DATA MAP(from:cg) IF(gs_hamk%gpu_option==ABI_GPU_OPENMP .and. transfer_cg)
320 : #endif
321 :
322 9024 : call timab(tim_chebfiwf2,2,tsec)
323 :
324 : DBG_EXIT("COLL")
325 :
326 27072 : end subroutine chebfiwf2
327 : !!***
328 :
329 : !----------------------------------------------------------------------
330 :
331 : !!****f* m_chebfiwf/getghc_gsc1
332 : !! NAME
333 : !! getghc_gsc1
334 : !!
335 : !! FUNCTION
336 : !! This routine computes H|C> and possibly S|C> for a given wave function C.
337 : !! It acts as a driver for getghc, taken into account parallelism, multithreading, etc.
338 : !!
339 : !! SIDE EFFECTS
340 : !! X <type(xgBlock_t)>= memory block containing |C>
341 : !! AX <type(xgBlock_t)>= memory block containing H|C>
342 : !! BX <type(xgBlock_t)>= memory block containing S|C>
343 : !!
344 : !! SOURCE
345 :
346 72586 : subroutine getghc_gsc1(X,AX,BX)
347 :
348 : implicit none
349 :
350 : !Arguments ------------------------------------
351 : type(xgBlock_t), intent(inout) :: X
352 : type(xgBlock_t), intent(inout) :: AX
353 : type(xgBlock_t), intent(inout) :: BX
354 : integer :: blockdim
355 : integer :: spacedim
356 1020684 : type(pawcprj_type) :: cprj_dum(l_gs_hamk%natom,1)
357 :
358 : !Local variables-------------------------------
359 : !scalars
360 : real(dp) :: eval
361 : !arrays
362 72586 : real(dp), pointer :: cg(:,:)
363 72586 : real(dp), pointer :: ghc(:,:)
364 72586 : real(dp), pointer :: gsc(:,:)
365 : real(dp) :: gvnlxc(1,1)
366 :
367 : ! *********************************************************************
368 :
369 : ABI_NVTX_START_RANGE(NVTX_GETGHC)
370 :
371 72586 : call xgBlock_getSize(X,spacedim,blockdim)
372 72586 : call xgBlock_check(X,AX)
373 72586 : call xgBlock_check(X,BX)
374 :
375 72586 : call xgBlock_reverseMap(X,cg,rows=1,cols=spacedim*blockdim)
376 72586 : call xgBlock_reverseMap(AX,ghc,rows=1,cols=spacedim*blockdim)
377 72586 : call xgBlock_reverseMap(BX,gsc,rows=1,cols=spacedim*blockdim)
378 :
379 : call multithreaded_getghc(l_cpopt,cg,cprj_dum,ghc,gsc,&
380 72586 : l_gs_hamk,gvnlxc,eval,l_mpi_enreg,blockdim,l_prtvol,l_sij_opt,l_tim_getghc,0)
381 :
382 : #if defined(HAVE_GPU_CUDA) && defined(HAVE_YAKL)
383 : call gpu_device_synchronize()
384 : #endif
385 :
386 72586 : if ( .not. l_paw ) call xgBlock_copy(X,BX)
387 :
388 : ABI_NVTX_END_RANGE()
389 :
390 145172 : end subroutine getghc_gsc1
391 : !!***
392 :
393 : !----------------------------------------------------------------------
394 :
395 : !!****f* m_chebfiwf/getBm1X
396 : !! NAME
397 : !! getBm1X
398 : !!
399 : !! FUNCTION
400 : !! This routine computes S^-1|C> for a given wave function C.
401 : !! It acts as a driver for apply_invovl.
402 : !!
403 : !! SIDE EFFECTS
404 : !! X <type(xgBlock_t)>= memory block containing |C>
405 : !! Bm1X <type(xgBlock_t)>= memory block containing S^-1|C>
406 : !!
407 : !! SOURCE
408 :
409 51718 : subroutine getBm1X(X,Bm1X)
410 :
411 : implicit none
412 :
413 : !Arguments ------------------------------------
414 : type(xgBlock_t), intent(inout) :: X
415 : type(xgBlock_t), intent(inout) :: Bm1X
416 :
417 : !Local variables-------------------------------
418 : !scalars
419 : integer :: blockdim
420 : integer :: spacedim
421 : !arrays
422 51718 : real(dp), pointer :: ghc_filter(:,:)
423 51718 : real(dp), pointer :: gsm1hc_filter(:,:)
424 51718 : type(pawcprj_type), allocatable :: cwaveprj_next(:,:) !dummy
425 :
426 : ! *********************************************************************
427 :
428 51718 : call xgBlock_getSize(X,spacedim,blockdim)
429 :
430 51718 : if(l_paw) then
431 :
432 51718 : call xgBlock_reverseMap(X,ghc_filter,rows=1,cols=spacedim*blockdim)
433 51718 : call xgBlock_reverseMap(Bm1X,gsm1hc_filter,rows=1,cols=spacedim*blockdim)
434 :
435 : !cwaveprj_next is dummy
436 51718 : if(gemm_nonlop_use_gemm) then
437 1152 : ABI_MALLOC(cwaveprj_next, (1,1))
438 : else
439 1247656 : ABI_MALLOC(cwaveprj_next, (l_gs_hamk%natom,l_nspinor*blockdim))
440 51430 : call pawcprj_alloc(cwaveprj_next,0,l_gs_hamk%dimcprj)
441 : end if
442 :
443 : ABI_NVTX_START_RANGE(NVTX_INVOVL)
444 : call apply_invovl(l_gs_hamk, ghc_filter(:,:), gsm1hc_filter(:,:), cwaveprj_next(:,:), &
445 51718 : spacedim/l_nspinor, blockdim, l_mpi_enreg, l_nspinor, l_block_sliced)
446 : ABI_NVTX_END_RANGE()
447 :
448 51718 : call pawcprj_free(cwaveprj_next)
449 761990 : ABI_FREE(cwaveprj_next)
450 :
451 : else
452 :
453 0 : call xgBlock_copy(X,Bm1X)
454 :
455 : end if
456 :
457 103436 : end subroutine getBm1X
458 : !!***
459 :
460 : end module m_chebfiwf
461 : !!***
|